- .com
- Türkçe, Delphi ve SQL konusundaki deneyimler, örnek kodlar, eleştiri ve düşünceler...
Delphi ile "Login olmak" (Kullanıcı giriş denetimi)
- 20 Mayıs 2010 Perşembe
- Uğur Parlayan
Yazılara uzun bir süre ara verdikten sonra aşağıdaki gibi bir örnekle geri dönmek sanırım hepimiz için güzel bir başlangıç olacak... Yazdığımız programlarda kullanıcının programa girişini kontrol altına almak, yetkileri ve arabirimi kullanıcıya göre giriş esnasında şekillendirmek herzaman bizler için bir sıkıntı olmuştur. Bu yazıda bu sorunu nasıl aşabileceğimize dair hazırladığım özel bir bileşeni tanıtacağım; TupLoginDialog...
TupLogindialog Ne İşe Yarar
Bu bileşen, programcının tercihine bağlı kalarak açılış anında veya bir butonun tetiklemesiyle devreye girip kullanıcıdan kullanıcı adı ve şifresini bir forma girmesini, girdiği bilgileri kullanarak o kullanıcının veritabanından kontrol edilmesini, varsa programa girmesine izin vermesini, yoksa kullanıcıyı uyarmasını, belli bir miktar hatalı girişten sonra programı kapatmasını sağlayan nevişahsına münhasır özel bir bileşenimizdir.
Tasarım anında görsel olmayan bir nesne olarak kullanılır. Sizden, ana formunuza bu bileşeni eklediğinizde aşağıdaki alanları doldurmanızı ister. Temel parametreleri girdiğinizde çalıştırılmaya hazırdır. Ayrıca sonuca göre 2 farklı olay da tetikleyebilmektedir. 1. Olayda, kullanıcı adı ve şifresi doğrulanan bir kullanıcı veritabanında bulunduysa OnGirisKabulEdildi olayını tetikler. Eğer belirttiğiniz miktarda hatalı bir giriş denemesi yapıldıysa limit dolduğunda OnHataLimiti olayını tetikler. Bu olaylar size giriş düğmesine basıldığında programınızda kullanıcı ile ilgili diğer işlemleri yapmanıza, belli miktarda hatalı giriş yapıldığında ise programınızı kapatmadan önce yapmanız gereken diğer işlemleri gerçekleştirmenize veya ilgili kullanıcının hesabını kilitlemenize olanak verir.
TupLoginDialog Bileşeninin Kaynak Kodu
Aşağıda, size bu bileşenin kaynak kodunu veriyorum. Bu bileşen ile ilgili teknik detayları ayrı ayrı da anlatabilirdim fakat konu bütünlüğünün bozulmaması için gereken açıklamaları kodun içine serpiştirdim, neyi neden ve nerede yaptığımı böylece daha iyi anlatabileceğimi düşünüyorum...
{******************************************************************************}
{* *}
{* Programlayan: Uğur Parlayan (ugurparlayan@gmail.com) *}
{* Tarih: 17.05.2010 *}
{* *}
{* Kullanım: Ayrım gözetmeksizn külliyatıyla ÜCRETSİZDİR *}
{* Yazarın gönlü olsun diye kaynak belirtirseniz sevinirim... *}
{* *}
{* Uygulamanıza Kullanıcı adı ve şifre ile giriş yapılabilmesine imkân verir *}
{* *}
{* URL: http://www.kavramca.com/index.php?k=40 *}
{* *}
{******************************************************************************}
unit upLoginDialog;
interface
uses
SysUtils, Classes, StdCtrls, Mask, DBCtrls, DB, ExtCtrls, Controls, Buttons,
Variants, Messages, Windows, Forms, Dialogs, ADODB, Grids, DBGrids, Graphics,
AppEvnts;
const
WM_AFTER_SHOW = WM_USER + 300;
WM_AFTER_CREATE = WM_USER + 301;
type
TupLoginDialog = class(TCommonDialog)
private
FUygulamaOlayi : TApplicationEvents;
{Pencerenin iç nesneleri}
FPencere : TForm;
FCMB_Kullanici : TComboBox;
FEdit_Sifre : TEdit;
FBTN_Giris : TButton;
FBTN_Kapat : TButton;
FLBL_Kullanici : TLabel;
FLBL_Sifre : TLabel;
FBTN_Hatirlatici : TButton;
{Diğer zımbırtılar}
FConnection : TAdoConnection;
FGirisKabulEdildi : TNotifyEvent; {Girişte tetiklenen olay.}
FHataLimiti : TNotifyEvent;
FOtomatikBaslat : Boolean; {Program çalışınca devreye girecek mi}
FGirebilir : Boolean; {Giriş izni verildi mi}
FKullaniciListele : Boolean;
FKullanici_Tablosu : string;
FHatirlatmaGoster : Boolean;
FAlan_Soru : string;
FAlan_Cevap : string;
FAlan_Key : string;
FAlan_Kullanici : string;
FAlan_Sifre : string;
FAlan_Pasif : string;
FAlan_SonTarih : string;
FAlan_Yetkiler : string;
FAlan_Hesap : string;
FMetin_Baslik : string;
FMetin_Kullanici : string;
FMetin_Sifre : string;
FMetin_Login : string;
FMetin_Kapat : string;
FMetin_Hatirlat : string;
FValue_Kullanci : string;
FValue_Sifre : string;
FValue_Hesap : string;
FValue_Key : string;
FValue_Yetkiler : string;
FValue_Pasif : Boolean;
FHataSayaciKullan : Boolean;
FHataSayaci : Integer;
function GetSQL : string;
function GetBilesenDurumu: string;
function GetValue_Kullanci: string;
function GetValue_Sifre: string;
procedure SetConnection(const Value: TAdoConnection);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
{Ana programa sistem mesajı gönderir...}
procedure OnMsg(var Msg:tagMsg;var Handled:Boolean);
procedure Klik_Tus(Sender: TObject; var Key: Char);
procedure Klik_Giris(Sender: TObject);
procedure Klik_Kapat(Sender: TObject);
procedure Klik_Hatirlat(Sender: TObject);
procedure Sifirla;{Pencere açılmadan önce sonuçları sıfırlar...}
procedure Sonuclar;
procedure Olustur;{Penceremizi oluşturur...}
property OnClose;
property OnShow;
protected
procedure DoGirisKabulEdildi; virtual;
procedure DoHataLimiti; virtual;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure Calistir;{Dialog penceresini istenilen esnada gösterir}
published
property Connection : TAdoConnection read FConnection
write SetConnection;
{SQL cümlemizi parametrelere göre üretir.}
property SQL : string read GetSQL;
{Bileşen için gereken kritik değişkenler hakkında dış ortama bilgi verir.}
property BilesenDurumu : string read GetBilesenDurumu;
{Kaç kere hata yapılabileceğini bu değişken karar verir}
property HataSayaci : Integer read FHataSayaci
write FHataSayaci
Default 10;
{Eğer istersek kullanıcının hatalarını saymayabiliriz...}
property HataSayaciKullan : Boolean read FHataSayaciKullan
write FHataSayaciKullan
Default False;
{Şifresini unutan kullanıcıya soru sorabiliriz}
property HatirlatmaGoster : Boolean read FHatirlatmaGoster
write FHatirlatmaGoster
Default False;
{Ana form çalışır çalışmaz devreye girmesini sağlayabiliriz.}
property OtomatikBaslat : Boolean read FOtomatikBaslat
write FOtomatikBaslat
Default False;
{Kullanıcı adlarını eğer istersek listeleyebiliriz, ŞART DEĞİL !!!}
property Kullanici_Listele : Boolean read FKullaniciListele
write FKullaniciListele
Default False;
{Temel Parametre: Kullanıcıların veritabanındaki tablo adı}
property Kullanici_Tablosu : string read FKullanici_Tablosu
write FKullanici_Tablosu;
{Temel Parametre: USERNAME alanı}
property Alan_Kullanici : string read FAlan_Kullanici
write FAlan_Kullanici;
{Temel Parametre: PASSWORD alanı}
property Alan_Sifre : string read FAlan_Sifre
write FAlan_Sifre;
{Şart değil: Sorunun tutulduğu tablo alanı}
property Alan_Soru : string read FAlan_Soru
write FAlan_Soru;
{Şart değil: Cevabın tutlduğu tablo alanı}
property Alan_Cevap : string read FAlan_Cevap
write FAlan_Cevap;
{Temel Parametre: Her kullanıcı için bir referans numarası vardır}
{Bu alan işte o referansı kullanmanızı sağlar (PRIMARY KEY)}
property Alan_Key : string read FAlan_Key
write FAlan_Key;
{Şart değil: Pasifleştirilmiş kullanıcıları sonuçlardan dışlar...}
property Alan_Pasif : string read FAlan_Pasif
write FAlan_Pasif;
{Şart değil: Eğer kullanıcının belli bir tarihten sonra giriş }
{yapmasını istemiyorsanız bunu kullanabilirsiniz...}
property Alan_SonTarih : string read FAlan_SonTarih
write FAlan_SonTarih;
{Şart değil: Giriş yaptıktan sonra yetkileri denetlemenizi sağlar}
property Alan_Yetkiler : string read FAlan_Yetkiler
write FAlan_Yetkiler;
{Şart değil: ACCOUNT alanı...}
property Alan_Hesap : string read FAlan_Hesap
write FAlan_Hesap;
{Görsel: Pencerenin başlığı}
property Metin_Baslik : string read FMetin_Baslik
write FMetin_Baslik;
{Görsel: Giriş düğmesinin başlığı}
property Metin_Login : string read FMetin_Login
write FMetin_Login;
{Görsel: Kapat düğmesinin başlığı}
property Metin_Kapat : string read FMetin_Kapat
write FMetin_Kapat;
{Görsel: Kullanıcı adı text alanının başlığı}
property Metin_Kullanici : string read FMetin_Kullanici
write FMetin_Kullanici;
{Görsel: Şifre text alanının başlığı}
property Metin_Sifre : string read FMetin_Sifre
write FMetin_Sifre;
{Görsel: "Şifremi Unuttum" düğmesinin başlığı}
property Metin_Hatirlat : string read FMetin_Hatirlat
write FMetin_Hatirlat;
{SONUÇ: Kullanıcı adı}
property Value_Kullanici : string read GetValue_Kullanci
write FValue_Kullanci;
{SONUÇ: Şifresi}
property Value_Sifre : string read GetValue_Sifre
write FValue_Sifre;
{SONUÇ: PRIMARY KEY}
property Value_Key : string read FValue_Key;
{SONUÇ: Bu kullanıcının yetkileri}
property Value_Yetkiler : string read FValue_Yetkiler;
{SONUÇ: ACCOUNT adı...}
property Value_Hesap : string read FValue_Hesap;
{SONUÇ: Aktif / Pasif kullanıcı olup olmadığı...}
property Value_Pasif : Boolean read FValue_Pasif;
{SONUÇ: Kullanıcının mevcut olup olmadığının kararı...}
property Girebilir : Boolean read FGirebilir
Default False;
{OLAY: Giriş düğmesi olayı}
property GirisKabulEdildi : TNotifyEvent read FGirisKabulEdildi
write FGirisKabulEdildi;
{OlAY: Hata sayacı olayı}
property HataLimiti : TNotifyEvent read FHataLimiti
write FHataLimiti;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('UgurPack2007', [TupLoginDialog]);
end;
{ TupLoginDialog }
constructor TupLoginDialog.Create(AOwner: TComponent);
begin
inherited;
{ Varsayılanları ayarlıyoruz... }
if (FMetin_Baslik = '') then FMetin_Baslik := 'Kullanıcı Girişi';
if (FMetin_Kapat = '') then FMetin_Kapat := 'Kapat';
if (FMetin_Login = '') then FMetin_Login := 'Giriş';
if (FMetin_Kullanici = '') then FMetin_Kullanici := 'Kullanıcı Adı :';
if (FMetin_Sifre = '') then FMetin_Sifre := 'Şifre :';
if (FMetin_Hatirlat = '') then FMetin_Hatirlat := 'Şifremi Unuttum';
FHataSayaci := 10; {Kullansak da kullanmasak da bu varsayılan miktardır...}
{ Uygulama olayı tanımlıyoruz, Başlangıçta devreye girebilsin diye... }
FUygulamaOlayi := TApplicationEvents.Create(Self);
FUygulamaOlayi.OnMessage := OnMsg;
PostMessage(TForm(Owner).Handle, WM_AFTER_CREATE, 0, 0);
end;
destructor TupLoginDialog.Destroy;
begin
FUygulamaOlayi.Destroy;
inherited;
end;
procedure TupLoginDialog.DoGirisKabulEdildi;
begin
{ Giriş düğmesine bsama olayını burada atama yapıyoruz }
if Assigned(FGirisKabulEdildi) then FGirisKabulEdildi(SELF);
end;
procedure TupLoginDialog.DoHataLimiti;
begin
{ Hata miktarının tetiklenmesi olayını burada atama yapıyoruz }
if Assigned(FHataLimiti) then FHataLimiti(SELF);
end;
procedure TupLoginDialog.FormClose(Sender: TObject; var Action: TCloseAction);
begin
{ Form kapatıldığında onu yoketmeyip sadece gizliyoruz. }
Action := caHide;
{ caFREE kullansaydık nesneyi yoketmiş olurduk ki bu da hata üretir... }
if (FGirebilir = False) then begin
MessageBox(TForm(Owner).Handle, 'Program Kapatılacaktır.',
PWideChar(Application.Title), MB_OK + MB_ICONERROR);
PostMessage(TForm(Owner).Handle, WM_CLOSE, 0, 0);
{ Şifreyi giremediyse ana programı da kapat...}
end;
end;
procedure TupLoginDialog.FormShow(Sender: TObject);
var
FADS: TAdoDataSet;
SQL: String;
I: Integer;
Sonuc: String;
Ek: String;
begin
{ Formu çalıştırdığımızda bu kısım devreye giriyor }
{ Nesnelerimiz mevcutsa önce imleci kullanıcı adı text alanına }
{ konumlandırıyor, sonra da eğer kullanıcı listesi göstereceksek değerleri }
{ okuyup ilgili bileşene yazıyor... }
if Assigned(FPencere) and Assigned(FCMB_Kullanici) then begin
FCMB_Kullanici.SetFocus;
if (FAlan_Kullanici>'')
and (FKullanici_Tablosu>'')
and (FKullaniciListele = True)
then begin
SQL := '';
SQL := FORMAT('SELECT DISTINCT [%s] FROM dbo.[%s]',
[FAlan_Kullanici, FKullanici_Tablosu]);
if (FAlan_Pasif>'') or (FAlan_SonTarih>'') then begin
SQL := FORMAT('%s WHERE', [SQL]);
if (FAlan_Pasif > '') then SQL := FORMAT('%s ISNULL([%s],0) =
0', [SQL, Alan_Pasif]);
if (FAlan_Pasif>'') and (FAlan_SonTarih>'') then SQL :=
FORMAT('%s AND',[SQL]);
if (FAlan_SonTarih>'') then SQL := FORMAT('%s ISNULL([%s],0) <=
GETDATE()', [SQL, Alan_SonTarih]);
end;
if (SQL > '') then begin
FADS := TADODataSet.Create(Application);
with FADS do begin
Close;
Connection := FConnection;
CommandType := cmdText;
CommandText := SQL;
Open;
First;
end;
if (FADS.IsEmpty = False) then begin
for I := 0 to FADS.RecordCount - 1 do begin
Sonuc := Sonuc +
FORMAT('"%s",',[FADS.FieldByName(FAlan_Kullanici).AsString]);
FADS.Next;
end;
with FCMB_Kullanici.Items do begin
QuoteChar := '"';
Delimiter := ',';
DelimitedText := Sonuc;
end;
end;
FADS.Close;
FADS.Destroy;
end;
end else begin
FCMB_Kullanici.Style := csSimple;
end;
end;
end;
function TupLoginDialog.GetSQL: string;
var
SQL_Cumlesi: String;
begin
{ Kullanıcı adı, şifre, tablo, varsa pasif ve varsa son tarihle birlikte }
{ bu bilgilerini kullanarak bir SQL cümlesi üretiyor}
SQL_Cumlesi := '';
SQL_Cumlesi := FORMAT('SELECT TOP 1 [%s]',[FAlan_Key]);
if (FAlan_Hesap>'') then SQL_Cumlesi := FORMAT('%s, [%s]',[SQL_Cumlesi,
FAlan_Hesap]);
if (FAlan_Yetkiler>'') then SQL_Cumlesi := FORMAT('%s, [%s]',[SQL_Cumlesi,
FAlan_Yetkiler]);
SQL_Cumlesi := FORMAT('%s FROM dbo.[%s] WHERE [%s]=''%s'' AND [%s]=''%s''',
[ SQL_Cumlesi
, FKullanici_Tablosu
, Alan_Kullanici
, GetValue_Kullanci
, Alan_Sifre
, GetValue_Sifre
]);
if (Alan_Pasif > '') then SQL_Cumlesi := FORMAT('%s AND ISNULL([%s],0) =
0', [SQL_Cumlesi, Alan_Pasif]);
if (FAlan_SonTarih>'') then SQL_Cumlesi := FORMAT('%s AND ISNULL([%s],0) <=
GETDATE()', [SQL_Cumlesi, Alan_SonTarih]);
Result := SQL_Cumlesi;
end;
function TupLoginDialog.GetBilesenDurumu: string;
var
Sonuc: String;
begin
{ Bu bileşen için gerekli olan kritik değişkenler hakkında dış ortama bilgi
verir. }
Sonuc := '';
if NOT Assigned(FConnection) then Sonuc := Sonuc + 'Bağlantı nesnesi eksik.
';
if Assigned(FConnection) then begin
if (FConnection.Connected = False) then Sonuc := Sonuc + 'Bağlantı
nesnesi KAPALI ! ';
end;
if (FAlan_Key = '') then Sonuc := Sonuc + 'Anahtar alan
belirtilmemiş. ';
if (FAlan_Kullanici = '') then Sonuc := Sonuc + 'Kullanıcı adı alanı
belirtilmemiş. ';
if (FAlan_Sifre = '') then Sonuc := Sonuc + 'Şifre alanı
belirtilmemiş. ';
if (FKullanici_Tablosu = '') then Sonuc := Sonuc + 'Kullanıcı tablosu
belirtilmemiş. ';
if (Sonuc = '') then Sonuc := 'Temel parametreler mükemmel';
Result := Sonuc;
end;
function TupLoginDialog.GetValue_Kullanci: string;
begin
{ girişten sonra dış ortama kullanıcı adını veriyor... }
if Assigned(FCMB_Kullanici)
then Result := FCMB_Kullanici.Text
else Result := FValue_Kullanci;
end;
function TupLoginDialog.GetValue_Sifre: string;
begin
{ girişten sonra dış ortama şifreyi veriyor... }
{ Tabii ki dış ortamdan kastım sadece "ana form"... }
if (Assigned(FEdit_Sifre) = True)
then Result := FEdit_Sifre.Text
else Result := FValue_Sifre;
end;
procedure TupLoginDialog.Calistir;
begin
{ Siz, ana formda "Kullanıcı Girişi" diye bir butondan bunu çağırırsanız }
{ önce oluşturulmamışsa giriş formunu üretir, sonra sonuçları sıfırlar }
{ en sonunda da giriş formunu gösterir... }
if NOT Assigned(FPencere)
then Olustur;
Sifirla;
FPencere.ShowModal;
end;
procedure TupLoginDialog.Klik_Kapat(Sender: TObject);
begin
{ Kapat düğmesine bastığımızda bu işlem gerçekleşir... }
Fpencere.Close;
end;
procedure TupLoginDialog.Klik_Giris(Sender: TObject);
begin
{ Giriş düğmesine bastığımızda burası devreye girer; Kısaca şu işleri yapar }
{ Kullanıcının kullanıcı adı ve parametresini veritabanından sorgular }
{ Sonuçta bu kişi girebiliyorsa ana forma geçiş yapar}
{ giremiyorsa uygun bir dille uyarır... }
{ Hatta hata sayacı da burada sayılır ve kontrol edilir...}
Sonuclar;
if (FGirebilir = True) then Begin
GirisKabulEdildi(SELF);
FPencere.Close;
End else Begin
if (FHataSayaciKullan = True) then Begin
FHataSayaci := FHataSayaci - 1;
if (FHataSayaci <= 0) then begin
FGirebilir := False;
if Assigned(FHataLimiti) then HataLimiti(SELF);
FPencere.Close;
//Exit;
end else begin
MessageBox(TForm(Owner).Handle,PWideChar('Hatalı giriş yaptınız.
'+IntToSTR(FHataSayaci)+' defa daha hatalı giriş yaparsanız program
kapanacaktır. '#13#10'Lütfen sistem yöneticinize
danışınız...'),'HATA',MB_OK+MB_ICONERROR);
end;
End else Begin
MessageBox(TForm(Owner).Handle,'Kullanıcı adı ve/ya Şifreniz yok
ve/ya yanlış.'#13#10'Lütfen sistem yöneticinize
danışınız...','HATA',MB_OK+MB_ICONERROR);
end;
end;
end;
procedure TupLoginDialog.Klik_Hatirlat(Sender: TObject);
var
Soru : String;
Cevap: String;
Yanit: String;
Sifre: String;
FADS : TAdoDataSet;
begin
{ Eğer kullanıcımız, sevgili şifresini unuttuysa ona bir soru sormamız }
{ gerekir. Verdiği cevap ile veritabanındaki yanıt aynı ise ona şifresini }
{ gösteririz, yanlış bir yanıt verdiyse hata mesajı üretiriz...}
{ Tüm bunları yapabilmek için kullanıcı adının yazılmış olması gerekir... }
if (FHatirlatmaGoster = True) and (FAlan_Soru > '') and (FAlan_Cevap > '')
then begin
if (FCMB_Kullanici.Text > '') then begin
FADS := TADODataSet.Create(Application);
with FADS do begin
Close;
Connection := FConnection;
CommandType := cmdText;
CommandText := FORMAT('SELECT TOP 1 * FROM dbo.[%s] WHERE [%s]
= ''%s''', [FKullanici_Tablosu, FAlan_Kullanici, FCMB_Kullanici.Text]);
Open;
Soru := FieldByName(FAlan_Soru).AsString;
Cevap:= FieldByName(FAlan_Cevap).AsString;
Sifre:= FieldByName(FAlan_Sifre).AsString;
Close;
end;
FADS.Free;
Yanit := InputBox('Lütfen soruyu cevaplayın', Soru, '');
if lowercase(Yanit) = lowercase(Cevap) then ShowMessage(Sifre)
else MessageBox(TForm(Owner).Handle,'Yanlış
yanıt.','HATA',MB_OK+MB_ICONWARNING);
end else begin
MessageBox(TForm(Owner).Handle,'Lütfen Kullanıcı Adınızı
yazınız.','HATA',MB_OK+MB_ICONWARNING);
end;
end;
end;
procedure TupLoginDialog.Olustur;
const
sbt_Aralik = 4; { Penceredeki düğmeler arasındaki boşluk (Pixel
cinsinden...)}
sbt_Padding = 10;
sbt_ButonGenislik = 75;
sbt_ButonYukseklik = 25;
begin
{Dialog penceresini tüm unsurlarıyla birlikte üretir.}
if NOT Assigned (FPencere) then
FPencere := TForm.Create(Application.Owner);
with FPencere do begin
Position := poMainFormCenter;
KeyPreview := True;
Caption := Metin_Baslik;
ShowHint := True;
Width := 350;
Height := 130;
BorderStyle := bsDialog;
FormStyle := fsStayOnTop;
OnClose := FormClose;
OnShow := FormShow;
//OnPaint := PencereBoyutlandir;
//OnKeyDown := FormKeyDown; {Özel bir tuşa basılırsa...}
{ OnResize := PencereBoyutlandir; Bunu kullanmıyoruz, }
{ Çünkü nesne henüz "üretim" aşamasında olduğu için OnResize }
{ olayı anında devreye giriyor ve hata üretiyor. Bunu önlemek için }
{ bu kısma bir değer atamıyoruz. Belki OnPaint olayına tanımlanabilir. }
{ Show; Bunu özellikle çalıştırmadık... }
end;
if NOT Assigned (FLBL_Kullanici) then
FLBL_Kullanici := TLabel.Create(FPencere);
with FLBL_Kullanici do begin
Parent := FPencere;
Left := sbt_Padding;
Top := sbt_Padding + sbt_Aralik;
Height := 17;
Caption := Metin_Kullanici;
AutoSize := True; {Kendi genişliğini kendisi ayarlasın...}
Show;
end;
if NOT Assigned (FCMB_Kullanici) then
FCMB_Kullanici := TComboBox.Create(FPencere);
with FCMB_Kullanici do begin
Parent := FPencere;
Height := 20;
Top := sbt_Padding;
Left := FLBL_Kullanici.Left + FLBL_Kullanici.Width +
sbt_Aralik;
Width := FPencere.ClientWidth
- Left
- sbt_Padding;
if (FValue_Kullanci>'') then Text := FValue_Kullanci
else Text := '';
OnKeyPress := Klik_Tus;
Anchors := [akLeft,akTop,akRight]; { Pencere boyu değiştiğinde
uyum sağlasın }
Text := FValue_Kullanci;
Show;
end;
if NOT Assigned (FLBL_Sifre) then
FLBL_Sifre := TLabel.Create(FPencere);
with FLBL_Sifre do begin
Parent := FPencere;
Left := sbt_Padding;
Top := FCMB_Kullanici.Top +
FCMB_Kullanici.Height+sbt_Aralik+2;
Height := 17;
Caption := Metin_Sifre;
AutoSize := True; {Kendi genişliğini kendisi ayarlasın...}
Show;
end;
if NOT Assigned (FEdit_Sifre) then
FEdit_Sifre := TEdit.Create(FPencere);
with FEdit_Sifre do begin
Parent := FPencere;
Height := 20;
{şifremizi yazarken tepemizdekiler ne yazdığımız görmesin...}
PasswordChar := '?';
Top := FCMB_Kullanici.Top + FCMB_Kullanici.Height +
sbt_Aralik;
Left := FLBL_Kullanici.Left + FLBL_Kullanici.Width +
sbt_Aralik;
Width := FPencere.ClientWidth
- Left
- sbt_Padding;
if (FValue_Kullanci > '') then Text := FValue_Kullanci
else Text := '';
OnKeyPress := Klik_Tus;
Anchors := [akLeft,akTop,akRight]; { Pencere boyu değiştiğinde
uyum sağlasın }
Text := FValue_Sifre;
Show;
end;
if NOT Assigned (FBTN_Giris) then
FBTN_Giris := TButton.Create(FPencere);
with FBTN_Giris do begin
Caption := FMetin_Login;
Anchors := [akRight,akTop];
Parent := FPencere;
Width :=
TForm(Owner).Canvas.TextWidth(FMetin_Login)+(sbt_Padding*2); // 40
Height := sbt_ButonYukseklik;
Top := FEdit_Sifre.Top + FEdit_Sifre.Height + sbt_Aralik +
sbt_Padding;
Left := FPencere.ClientWidth - sbt_Padding - width;
OnClick := Klik_Giris;
Show;
end;
if NOT Assigned (FBTN_Kapat) then
FBTN_Kapat := TButton.Create(FPencere);
with FBTN_Kapat do begin
Caption := FMetin_Kapat;
Anchors := [akRight,akTop];
Parent := FPencere;
Width :=
TForm(Owner).Canvas.TextWidth(FMetin_Kapat)+(sbt_Padding*2);
Height := sbt_ButonYukseklik;
Top := FEdit_Sifre.Top + FEdit_Sifre.Height + sbt_Aralik +
sbt_Padding;
Left := FBTN_Giris.Left - sbt_Aralik - width;
OnClick := Klik_Kapat;
Show;
end;
if NOT Assigned(FBTN_Hatirlatici) then
FBTN_Hatirlatici:= TButton.Create(FPencere);
with FBTN_Hatirlatici do begin
Caption := FMetin_Hatirlat;
Anchors := [akLeft,akTop];
Parent := FPencere;
Width :=
TForm(Owner).Canvas.TextWidth(FMetin_Hatirlat)+sbt_Padding;
Height := sbt_ButonYukseklik;
Top := FEdit_Sifre.Top + FEdit_Sifre.Height + sbt_Aralik +
sbt_Padding;
Left := sbt_Padding;
OnClick := Klik_Hatirlat;
if (FHatirlatmaGoster = True) then Show else Hide;
end;
end;
procedure TupLoginDialog.OnMsg(var Msg: tagMsg; var Handled: Boolean);
begin
{ Ana forma burası aracılığıyla mesaj gönderiyoruz... }
case Msg.message of
WM_AFTER_SHOW:
begin
if (GetBilesenDurumu = 'Temel parametreler mükemmel') then begin
if not Assigned(FPencere) then Olustur;
Calistir;
end else begin
MessageBox(TForm(Owner).Handle,'Parametreler eksik veya yanlış
olabilir. Lütfen kontrol ediniz..','HATA',MB_OK+MB_ICONSTOP);
end;
end;
WM_AFTER_CREATE:
begin
if NOT (csDesigning in ComponentState) then
if (FOtomatikBaslat = True)
then PostMessage(TForm(Owner).Handle, WM_AFTER_SHOW, 0, 0);
end;
end;
end;
procedure TupLoginDialog.SetConnection(const Value: TAdoConnection);
begin
{ Malesef ADO (dbGO) bileşenlerini destekleyebiliyoruz. }
FConnection := Value;
end;
procedure TupLoginDialog.Sifirla;
begin
{ Anladınız siz bunu... }
FValue_Key := '';
FValue_Hesap := '';
FValue_Yetkiler:= '';
FValue_Kullanci:= '';
FValue_Sifre := '';
FValue_Pasif := FALSE;
end;
procedure TupLoginDialog.Sonuclar;
var
FADS: TAdoDataSet;
begin
{ Eğer temel parametrelerimizde herhangi bir pürüz yoksa sonuç alabiliriz...}
try
if (GetBilesenDurumu = 'Temel parametreler mükemmel') then begin
if NOT (csDesigning in ComponentState) then begin
FADS := TADODataSet.Create(Application);
with FADS do begin
Close;
Connection := FConnection;
CommandType := cmdText;
CommandText := GetSQL;
Open;
FGirebilir := NOT FADS.IsEmpty;
{ Sorgu sonucu BOŞ DEĞİL ve Sadece 1 KAYIT VAR İSE ! }
if (FGirebilir = True) AND (FADS.RecordCount = 1) then begin
if (FAlan_Key > '')
then FValue_Key := FieldByName(FAlan_Key).AsString;
if (FAlan_Hesap > '')
then FValue_Hesap := FieldByName(FAlan_Hesap).AsString;
if (FAlan_Yetkiler > '')
then FValue_Yetkiler:= FieldByName(FAlan_Yetkiler).AsString;
if (FAlan_Pasif > '' )
then FValue_Pasif := FieldByName(FAlan_Pasif).AsBoolean
end else begin
Sifirla;
end;
Close;
end;
FADS.Free;
end;
end;
except
// Hata verdirtmiyoruz...
end;
end;
procedure TupLoginDialog.Klik_Tus(Sender: TObject; var Key: Char);
begin
{ Klavyeden ESC'ye basıldığında KAPAT düğmesine basar}
{ ENDER'e basıldığında ise sonraki nesneye geçer... }
if (Key = #27) then Klik_Kapat(Sender) else
if (Key = #13) then begin
if (Sender = FCMB_Kullanici) then begin
if FCMB_Kullanici.Text>'' then begin
FEdit_Sifre.SetFocus
end;
end else
if (Sender = FEdit_Sifre) then begin
if (FEdit_Sifre.Text>'') then begin
FBTN_Giris.SetFocus;
FBTN_Giris.Click;
end;
end;
end;
end;
end.
Lookup'a Farklı Bir Yaklaşım (TupLookupDialog)
- 07 Ağustos 2009 Cuma
- Uğur Parlayan
Bu işe ilk başladığım zamanlarda üzerinde çok kafa yorduğum ama uzun bir süre çözemediğim yıldırıcı bir konu vardı, Lookuplar. Bildiğiniz gibi TDBLookupComboBox 1 tablodan tek bir kaydı seçmek için kullanılan, başka bir tabloya referans vermemizi sağlayan pratik bileşenlerden birisidir. Pratiktir pratik olmasına da veri miktarı arttığı zaman programın yavaş çalışmasına bir o kadar da sebep olurlar... Hele bir de ağ ortamında kullanıldığını düşünün, zahmetinden kullanılmaz bir programa sahip olursunuz... "Bu yazımda" Lookupların yaptığı işi daha hızlı yapan başka bir teknikten (ama ulu orta her yerde anlatılmayan özel bir) kod örneği vereceğim. umarım kıymetini bilir ve gereken ilgiyi gösterirsiniz...
TupLookupDialog Ne İşe Yarar
Bu bileşen, başka bir bileşenin çağırmasıyla devreye giren, etkinleştiğinde ise sizin belirttiğiniz tablodan ve o tablodaki primary key ve listelenen 2. bir alan aracılığıyla seçim yapmanızı sağlayan özel bir Pencere açar, bu pencerede aşağıda da göreceğiniz gibi bir arama alanı, çeşitli düğmeler ve bir liste bulunmaktadır. Lookuplar, bu pencerenin çok rafine, çok az işleve sahip olan bir kısmını kullanırlar, dolayısıyla hareket alanı ve rahatlığı sınırlıdır. Ayrıca Lookupların referans aldığı tabloların bellekte sürekli açık kalması gerektiği gibi bir sıkıntı da vardır. Bizim bileşenimizin böyle bir derdi yok. Sadece çağırıldığında devreye girer, size seçim yapmanız için listeyi getirir ve tamama bastığınızda veriyi istediğiniz değişkene devredip intihar eder. Böylece hem bellek israfından kurtulur hem de yükleme sırasındaki dakikalarca bekleme zahmetini de yaşamamış oluruz. 
TupLookupDialog'un Kaynak Kodu
Aşağıda, size bu bileşenin kaynak kodunu veriyorum. Bu bileşen ile ilgili teknik detayları ayrı ayrı da anlatabilirdim fakat konu bütünlüğünün bozulmaması için gereken açıklamaları kodun içine serpiştirdim, neyi neden ve nerede yaptığımı böylece daha iyi anlatabileceğimi düşünüyorum... Bu arada bu kodun Veritabanı bilinçli sürümü de vardır ama bu size özel beleş sürüm olduğu için artık gerisini kendiniz yaparsınız :)
unit upLookupDialog;
interface
uses
SysUtils, Classes, StdCtrls, Mask, DBCtrls, DB, ExtCtrls, Controls, Buttons,
Variants, Messages, Graphics, Windows, Forms, Dialogs, ADODB, Grids, DBGrids;
type
TSQLTurleri = (MsSQL, MySQL); { SQL Cümlemizi bu standartlara göre "hesaplayacağız"... }
TupLookupDialog = class(TCommonDialog)
private
{Dialog penceresindeki özel nesnelerimiz...}
FPencere : TForm; { Dialog penceremizin formu }
FLabel : TLabel; { "Aranan" adlı bir text }
FAranan : TEdit; { Neyi arayacağımızı buna yazacağız }
FBul : TButton; { Bul düğmemiz }
FTemizle : TButton; { Temizle düğmemiz }
FTazele : TButton; { Tazele düğmemiz }
FOtomatikAra : TCheckBox; { İşaret kutucuğumuz, işaretlediğimizde yazarken bulacak}
FAdoDataSet : TAdoDataSet; { }
FDataSource : TDataSource; { }
FGrid : TDBGrid; { Verilerin listeleneceği yer }
FNavigator : TDBNavigator; { İleri/geri/ilk/son gibi düğmeler}
FOnizleme : TDBText; { Hangi verinin o an seçili olduğunu bundan göreceğiz}
FTamam : TButton; { SEÇ düğmemiz }
FNulle : TButton; { BOŞALT düğmemiz (NULL yapmak için)}
FVazgec : TButton; { Vazgeç düğmemiz... }
{Bileşenin kendine özgü diğer kısımları}
FConnection : TAdoConnection;
FTablo : String;
FFieldKey : String;
FFieldValue : String;
FKosul : String;
FValueData : String;
FValueKey : Variant; { İlla bir tamsayı olacak değil, string de olabilir}
FSQL : String;
FLimit : Integer;
FPencereBasligi : String;
FFieldValueAlias: String;
FYazarkenBul : Boolean;
FMetniBul : Boolean;
FSQLTuru : TSQLTurleri;
procedure SetConnection(const Value: TAdoConnection);
procedure Derle;
function GetSQLSorgu: string;
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
function GetDurum: String;
protected
procedure FormOlustur;
procedure TamamKlik(Sender: TObject);
procedure NulleKlik(Sender: TObject);
procedure VazgecKlik(Sender: TObject);
procedure BulKlik(Sender: TObject);
procedure TemizleKlik(Sender: TObject);
procedure TazeleKlik(Sender: TObject);
procedure PencereBoyutlandir(Sender: TObject);
procedure TusaBas(Sender: TObject; var Key: Char);
procedure AramaYap(Sender: TObject);
procedure OtomatikBuldur(Sender: TObject);
function MsQuoter(const Value: String): String;
function MyQuoter(const Value: String): String;
function SqlQuoter(const Value: String): String;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
function Execute: Boolean; override;
{Dışarıdan bir referans verilirse formu açmadan tak diye sonucu çekmemizi sağlar}
function KeyOku(Value: Variant): String;
published
{Bağlantı nesnesi}
property Connection : TAdoConnection read FConnection write SetConnection;
{Kaynak Tablo}
property Tablo : string read FTablo write FTablo;
{Primary Key alanı}
property FieldKey : string read FFieldKey write FFieldKey;
{Listelenecek / Seçim / Arama yapılacak Alan}
property FieldValue : string read FFieldValue write FFieldValue;
property FieldValueAlias : string read FFieldValueAlias write FFieldValueAlias;
{WHERE koşulu alt cümleciği}
property Kosul : string read FKosul write FKosul;
{Toplam kaç kayıt gözükecek ?}
property Limit : integer read FLimit write FLimit default 0;
{Sonuç = Primary Key Value}
property ValueKey : variant read FValueKey;
{Sonuç = Seçim...}
property ValueData : string read FValueData write FValueData;
{Çalıştırılacak SQL Cümleciği... (MSSQL/T-SQL ve MySQL)}
property SQLSorgu : string read GetSQLSorgu;
{Lookup Penceresinin Başlığı...}
property PencereBasligi : string read FPencereBasligi write FPencereBasligi;
{Arama alanında bir harfe basılırken anında filtreyi devreye almayı sağlar...}
property YazarkenBul : Boolean read FYazarkenBul write FYazarkenBul default False;
{Form, açıldığı anda dışarıdan verilen metni kendi listesinden bulmaya yarar}
property MetniBul : Boolean read FMetniBul write FMetniBul default False;
{SQL'imiz hangi teknolojiyi kullanıyor?}
{Bu sorunun cevabı ürettiğimiz SQL cümlesini şekillendirecek.}
property SQLTuru : TSQLTurleri read FSQLTuru write FSQLTuru default MsSQL;
{Bileşenin hangi aşamada ne tür bir eksiğinin olduğunu anlamamızı sağlayacak.}
property Durum : String read GetDurum;
end;
procedure Register;
implementation
var
ExecuteSonucu: Boolean;
procedure Register;
begin
RegisterComponents('UgurPack2007', [TupLookupDialog]);
end;
{ TupLookupDialog }
procedure TupLookupDialog.AramaYap(Sender: TObject);
begin
{Klavyede bir tuşa basıldığında anında filtreyi uygular... Tabi Editteyken...}
if (Sender is TEdit) then begin
if (TEdit(Sender).Text>'')
and (FYazarkenBul = True) {Yazarken arama etkinleştirilmişse...}
then BulKlik(Sender);
{else TemizleKlik(Sender);(* ne gerek varki... *)}
end;
end;
procedure TupLookupDialog.BulKlik(Sender: TObject);
begin
{Bul düğmesine basıldığında listelenen alan içerisinde}
{aranan metni filtreler ve filtreyi açar...}
if Assigned(FAdoDataSet) then begin
with FAdoDataSet do begin
try
if (FFieldValueAlias > '')
then begin
case FSQLTuru of
MsSQL: Filter := MsQuoter(FFieldValueAlias) + ' LIKE ''%'+FAranan.Text+'%''';
MySQL: Filter := MyQuoter(FFieldValueAlias) + ' LIKE ''%'+FAranan.Text+'%''';
end;
end else begin
case FSQLTuru of
MsSQL: Filter := MsQuoter(FFieldValue) + ' LIKE ''%'+FAranan.Text+'%''';
MySQL: Filter := MyQuoter(FFieldValue) + ' LIKE ''%'+FAranan.Text+'%''';
end;
end;
Filtered := True;
except
nil;
end;
end;
end;
end;
constructor TupLookupDialog.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{Sadece bileşeni mantıken oluşturur, henüz ortada gözle görülen bir zımbırtı yok...}
end;
procedure TupLookupDialog.Derle;
var
AraKosul : string;
AraLimit : string;
Alias : string;
Siralayici : string;
begin
{MsSQL (T-SQL) veya MySQL uyumlu "optimize edilmiş" bir SQL cümlesi oluşturur}
{Bu kod birden fazla yerde kullanıldığı için ayrı bir prosedür olarak tasarlandı...}
FSQL := '';
if Assigned(FConnection) then begin
if (FTablo > '')
and(FFieldKey > '')
and(FFieldValue > '') then begin
case SQLTuru of
MsSQL:
Begin
{-FSQL-}
if (FKosul > '')
then AraKosul := FORMAT('WHERE %s',[FKosul])
else begin
AraKosul := '';
end;
if (FLimit > 0)
then AraLimit := FORMAT('TOP %d', [FLimit])
else AraLimit := '';
if (FFieldValueAlias>'') then begin
Alias := FORMAT(' AS [%s] ', [FFieldValueAlias]);
Siralayici := FFieldValueAlias;
end else begin
Alias := '';
Siralayici := FFieldValue;
end;
FSQL := FORMAT('SELECT %s [%s], %s %s FROM dbo.[%s] %s ORDER BY [%s]',
[AraLimit,FFieldKey,FFieldValue,Alias,FTablo,AraKosul,Siralayici]);
end;
MySQL:
Begin
{-FSQL-}
if (FKosul > '')
then AraKosul := FORMAT('WHERE %s',[FKosul])
else begin
AraKosul := '';
end;
if (FLimit > 0)
then AraLimit := FORMAT(' LIMIT %d', [FLimit])
else AraLimit := '';
if (FFieldValueAlias>'') then begin
Alias := FORMAT(' AS `%s` ', [FFieldValueAlias]);
Siralayici := FFieldValueAlias;
end else begin
Alias := '';
Siralayici := FFieldValue;
end;
FSQL := FORMAT('SELECT [%s], %s %s FROM `%s` %s ORDER BY [%s] %s',
[FFieldKey,FFieldValue,Alias,FTablo,AraKosul,Siralayici,AraLimit]);
End;
end; {case !}
end; {if}
end; {if assigned}
end;
destructor TupLookupDialog.Destroy;
begin
{Tıpkı atalarından aldığı bir huy gibi her şeyi yok eder...}
inherited Destroy;
end;
function TupLookupDialog.Execute: Boolean;
begin
{Dış ortamın talebiyle devreye girer, formu oluşturup seçim yapılmasını bekler.}
{Akabinde seçim yapıldıysa seçilenleri dışa aktarır ve pencerenin kapanmasını sağlar...}
Result := False;
Derle;
if (FSQL>'') then begin
try
FormOlustur;
FPencere.ShowModal;
finally
FPencere.Free;
Result := ExecuteSonucu;
end;
end;
end;
procedure TupLookupDialog.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
{Aşağı yön tuşuna basıldıysa Gride fokuslanır...}
if Key = VK_DOWN then FGrid.SetFocus;
end;
procedure TupLookupDialog.FormOlustur;
const
sbt_Aralik = 4; { Penceredeki düğmeler arasındaki boşluk (Pixel cinsinden...)}
sbt_Padding = 10;
begin
try
{Dialog penceresini tüm unsurlarıyla birlikte üretir.}
FPencere := TForm.Create(Application.Owner);
with FPencere do begin
Position := poMainFormCenter;
KeyPreview := True;
Caption := FPencereBasligi;
ShowHint := True;
Width := 550;
Height := 400;
with Constraints do begin
MinWidth := 350;
MinHeight := 200;
end;
BorderStyle := bsSizeable;
OnPaint := PencereBoyutlandir;
OnKeyDown := FormKeyDown; {Özel bir tuşa basılırsa...}
{OnResize := PencereBoyutlandir; Bunu kullanmıyoruz,}
{Çünkü nesne henüz "üretim" aşamasında olduğu için OnResize}
{olayı anında devreye giriyor ve hata üretiyor. Bunu önlemek için}
{bu kısma bir değer atamıyoruz. Belki OnPaint olayına tanımlanabilir.}
{Show; Bunu özellikle çalıştırmadık...}
end;
FLabel := TLabel.Create(FPencere);
with FLabel do begin
Parent := FPencere;
Left := sbt_Padding;
Top := sbt_Padding + 2;
Height := 17;
Caption := 'Aranan : ';
AutoSize := True; {Kendi genişliğini kendisi ayarlasın...}
Show;
end;
FAranan := TEdit.Create(FPencere);
with FAranan do begin
Parent := FPencere;
BevelKind := bkTile;
BorderStyle := bsNone;
Height := 20;
Top := sbt_Padding;
Left := FLabel.Left + FLabel.Width + sbt_Aralik;
Width := FPencere.ClientWidth
- Left
- sbt_Padding
- 140 { sağdaki 3 butonun eni }
- (sbt_Aralik * 3);
if (FValueData>'')
then Text := FValueData
else Text := '';
OnKeyPress := TusaBas;
OnChange := AramaYap;
Anchors := [akLeft,akTop,akRight]; { Pencere boyu değiştiğinde uyum sağlasın }
Hint := 'Enter = Yazılanı bulur, ESC = 1.de satırı siler 2.de "Vazgeç"e basar.';
Show;
end;
FBul := TButton.Create(FPencere);
with FBul do begin
Caption := '&Bul';
Anchors := [akRight,akTop];
Parent := FPencere;
Default := False;
Width := 40;
Height := FAranan.Height;
Top := FAranan.Top;
Left := FPencere.ClientWidth - sbt_Padding - (140) - (sbt_Aralik * 2);
Hint := 'Sol tarafa yazdığınız metni bulur...';
OnClick := BulKlik;
OnKeyPress := TusaBas;
Show;
end;
FTemizle := TButton.Create(FPencere);
with FTemizle do begin
Caption := 'Te&mizle';
Anchors := [akRight,akTop];
Parent := FPencere;
Width := 50;
Height := FAranan.Height;
Top := FAranan.Top;
Left := FPencere.ClientWidth - sbt_Padding - (100) - (sbt_Aralik );
Hint := 'Sol tarafı temizler ve listeyi açar';
OnClick := TemizleKlik;
OnKeyPress := TusaBas;
Show;
end;
FTazele := TButton.Create(FPencere);
with FTazele do begin
Caption := 'Ta&zele';
Anchors := [akRight,akTop];
Parent := FPencere;
Top := FAranan.Top;
Width := 50;
Height := FAranan.Height;
Left := FPencere.ClientWidth - sbt_Padding - (50);
OnClick := TazeleKlik;
Hint := 'Aşağıdaki listenin en son halini sorgular';
OnKeyPress := TusaBas;
Show;
end;
FOtomatikAra := TCheckBox.Create(FPencere);
with FOtomatikAra do begin
Parent := FPencere;
Top := 33;
Left := FAranan.Left;
Caption := 'Yazarken süz...';
OnClick := OtomatikBuldur;
Checked := FMetniBul;
Show;
end;
FAdoDataSet := TAdoDataSet.Create(FPencere);
with FAdoDataSet do begin
Connection := FConnection;
CommandType := cmdText;
CommandText := FSQL;
end;
FDataSource := TDataSource.Create(FAdoDataSet);
with FDataSource do begin
DataSet := FAdoDataSet;
AutoEdit := False;
end;
FGrid := TDBGrid.Create(FPencere);
with FGrid do begin
Parent := FPencere;
Left := sbt_Padding;
Top := FAranan.Top + FAranan.Height + sbt_Aralik + FOtomatikAra.Height;
Width := FPencere.ClientWidth - Left - sbt_Padding;
Height := FPencere.ClientHeight - Top - (sbt_Padding * 2) - FOtomatikAra.Height;
Anchors := [akLeft,akTop,akRight,akBottom];
Options := [dgTitles,dgRowLines,dgAlwaysShowSelection
,dgConfirmDelete,dgCancelOnExit];
DataSource := FDataSource;
OnDblClick := TamamKlik;
OnKeyPress := TusaBas;
Columns.Add;
Show;
end;
FNavigator := TDBNavigator.Create(FPencere);
with FNavigator do begin
Parent := FPencere;
Anchors := [akLeft,akBottom];
VisibleButtons := [nbFirst,nbPrior,nbNext,nbLast];
Left := sbt_Padding;
Top := FGrid.Top + FGrid.Height + sbt_Padding;
Width := 125;
Height := 20;
Flat := True;
DataSource := FDataSource;
end;
FOnizleme := TDBText.Create(FPencere);
with FOnizleme do begin
Parent := FPencere;
Anchors := [akBottom,akLeft,akRight];
Top := FGrid.Top + FGrid.Height + sbt_Padding;
Left := sbt_Padding + FNavigator.Width + sbt_Aralik;
Height := 20;
Width := FPencere.ClientWidth - Left - sbt_Padding - (55 * 3) - (4 * 3);
AutoSize := False; {Kendi genişliğini kendisi ayarla"MA"sın...}
DataSource := FDataSource;
Color := clAppWorkSpace;
if (FFieldValueAlias>'')
then DataField := FFieldValueAlias
else DataField := FFieldValue;
TLabel(FOnizleme).Layout := tlCenter;
Hint := 'Eğer "SEÇ"e basarsanız bunu seçeceksiniz.';
Show;
end;
try
FAdoDataSet.Open;
{Daha hızlı çalışması için tüm nesneleri}
{oluşturduktan sonra çekiyoruz verilerimizi...}
except
NULL;
end;
if (FMetniBul = True) then BulKlik(FBul);
with FGrid.Columns.Items[0] do begin
Field := FAdoDataSet.Fields.Fields[1];
Title.Caption := 'Listeden bir satır seçin ve "SEÇ" veya "Enter" tuşuna basın. '
+ 'İptal için "ESC"yi kullanabilirsiniz. ';
Title.Color := clInfoBk;
Title.Font.Color := clInfoText;
Width := FGrid.ClientWidth;
end;
FTamam := TButton.Create(FPencere);
with FTamam do begin
Caption := '&SEÇ';
Anchors := [akRight,akBottom];
Parent := FPencere;
Width := 55;
Left := FPencere.ClientWidth - sbt_Padding - (Width * 3) - (sbt_Aralik * 2);
Top := FGrid.Top + FGrid.Height + sbt_Padding;
Height := 20;
Hint := 'Soldaki metinde de gösterilen veriyi seçersiniz...';
OnClick := TamamKlik;
Show;
end;
FNulle := TButton.Create(FPencere);
with FNulle do begin
Caption := 'B&oşalt';
Anchors := [akRight,akBottom];
Parent := FPencere;
Width := 55;
Left := FPencere.ClientWidth - sbt_Padding - (Width * 2) - (sbt_Aralik);
Top := FGrid.Top + FGrid.Height + sbt_Padding;
Height := 20;
Hint := '"BOŞ" seçilir, önceden seçilmiş bir değer varsa yok olur...';
OnClick := NulleKlik;
Show;
end;
FVazgec := TButton.Create(FPencere);
with FVazgec do begin
Caption := '&Vazgeç';
Anchors := [akRight,akBottom];
Parent := FPencere;
Width := 55;
Left := FPencere.ClientWidth - sbt_Padding - Width;
Top := FGrid.Top + FGrid.Height + sbt_Padding;
Height := 20;
Hint := 'Hiç bir seçim yapmadan pencereyi kapatır.';
OnClick := VazgecKlik;
Show;
end;
except
nil;
end;
end;
function TupLookupDialog.GetDurum: String;
var
Sonuc: String;
begin
{ Bu bileşen için gerekli olan kritik değişkenler hakkında dış ortama bilgi verir. }
Sonuc := '';
if not Assigned(FConnection) then Sonuc := Sonuc + 'Bağlantı nesnesi eksik. ';
if FTablo = '' then Sonuc := Sonuc + 'Tablo adı belirtilmemiş. ';
if FFieldKey = '' then Sonuc := Sonuc + 'Anahtar alan adı belirtilmemiş. ';
if FFieldValue = '' then Sonuc := Sonuc + 'Listelenecek alan adı belirtilmemiş. ';
if FPencereBasligi = '' then Sonuc := Sonuc + 'Pencere başlığı belirtilmemiş. ';
if FSQL = '' then Sonuc := Sonuc + 'SQL üretilemedi. ';
if Sonuc = '' then Sonuc := 'Herşey mükemmel.';
Result := Sonuc;
end;
function TupLookupDialog.GetSQLSorgu: string;
begin
{SQL Cümlesini dışarısının okuması için önce derler sonra dışa verir...}
Derle;
Result := FSQL;
end;
function TupLookupDialog.KeyOku(Value: Variant): String;
var
DS: TAdoDataSet;
SQL: String;
Alyas: String;
begin
{Bu fonksiyon eski kaynak kodda yoktu, sonradan böyle bir güzellik de eklemiş olduk...}
{Bu zımbırtının temelde yaptığı iş verilen keye göre ilgili liste alanının değerini çekiyor.}
Result := '';
if not VarIsNull(Value)
and Assigned(FConnection) then begin
{Burası önemli, çünkü gelen key değeri bir string ise tırnak içine}
{almamız gerekir, yoksa SQL cümlemiz hata üretir...}
if VarIsStr(Value) then Value := ''+Value+'';
try
if (FFieldValueAlias>'') then begin
Alyas := FORMAT(' %s as '+SqlQuoter('%s'),[FFieldValue, FFieldValueAlias]);
end else begin
Alyas := FFieldValue;
end;
case FSQLTuru of
MsSQL: SQL := FORMAT('SELECT TOP 1 %s FROM %s WHERE %s = %s',
[Alyas, FTablo, FFieldKey, Value]);
MySQL: SQL := FORMAT('SELECT %s FROM %s WHERE %s = %s LIMIT 1, 1',
[Alyas, FTablo, FFieldKey, Value]);
end;
try
DS := TAdoDataSet.Create(Application.Owner);
with DS do begin
Connection := FConnection;
CommandType := cmdText;
CommandText := SQL;
Open;
end;
except
NULL;
end;
if not DS.IsEmpty then begin
if (FFieldValueAlias>'')
then Result := DS.FieldByName(FFieldValueAlias).AsString
else Result := DS.FieldByName(FFieldValue).AsString;
end;
finally
DS.Free;
DS := nil;
end;
end;
end;
function TupLookupDialog.MsQuoter(const Value: String): String;
begin
{T-SQL'e uyumlu bir paranteze alma işlemidir.}
{Alan Adları boşluk içeriyorsa [] parantezine alınır...}
Result := FORMAT('[%s]', [Value]);
end;
function TupLookupDialog.MyQuoter(const Value: String): String;
begin
{My SQL'e uyumlu bir tırnak içine alma işlemidir.}
{Alan Adları boşluk içeriyorsa `` içine alınır...}
Result := FORMAT('`%s`', [Value]);
end;
procedure TupLookupDialog.PencereBoyutlandir(Sender: TObject);
begin
{Gönderen mevcutsa ve FGrid varsa gridin içindeki kolonun enini gride sığdırır...}
if Assigned(Sender) then begin
if Assigned(FGrid) then begin
if (FGrid.Columns.Count>0) then
FGrid.Columns[0].Width := FGrid.ClientWidth;
end;
end;
end;
procedure TupLookupDialog.SetConnection(const Value: TAdoConnection);
begin
{TAdoConnection nesnesini dışarıdan alır ve bize bağlar...}
FConnection := Value;
end;
function TupLookupDialog.SqlQuoter(const Value: String): String;
begin
case FSQLTuru of
MsSQL: Result := MsQuoter(Value);
MySQL: Result := MyQuoter(Value);
end;
end;
procedure TupLookupDialog.TamamKlik(Sender: TObject);
begin
{Dışarısı için verileri hazırlar ve pencereyi kapatır...}
if (Assigned(FPencere)) then begin
FValueKey := FAdoDataSet.FieldByName(FFieldKey).AsVariant;
if (FFieldValueAlias > '')
then FValueData := FAdoDataSet.FieldByName(FFieldValueAlias).AsString
else FValueData := FAdoDataSet.FieldByName(FFieldValue).AsString;
ExecuteSonucu := True;
FPencere.Close; {Bu olmazsa kapanmaz!}
end;
end;
procedure TupLookupDialog.NulleKlik(Sender: TObject);
begin
{Eğer seçilmiş bir değeri boşaltmak istiyorsak bu kod devreye girecek...}
if (Assigned(FPencere)) then begin
FValueKey := NULL;
if (FFieldValueAlias > '')
then FValueData := ''
else FValueData := '';
ExecuteSonucu := True;
FPencere.Close; {Bu olmazsa kapanmaz!}
end;
end;
procedure TupLookupDialog.OtomatikBuldur(Sender: TObject);
begin
{ Metin kutusuna bir şey yazarken aynı anda arama yapılmasını da sağlar }
FYazarkenBul := FOtomatikAra.Checked;
BulKlik(Sender);
end;
procedure TupLookupDialog.TazeleKlik(Sender: TObject);
begin
{ Listemizdeki verilerin son halini veritabanından çeker }
if Assigned(FAdoDataSet) then begin
case FSQLTuru of
MsSQL: begin
FAdoDataSet.Requery;
end; {MsSQL}
MySQL: begin
FAdoDataSet.Close;
FAdoDataSet.Open;
end; {MySQL}
end; {case}
end;
end;
procedure TupLookupDialog.TemizleKlik(Sender: TObject);
begin
{ Filtreyi kapatıp tüm verileri listelenmesini sağlar... }
if Assigned(FAdoDataSet) then FAdoDataSet.Filtered := False;
end;
procedure TupLookupDialog.TusaBas(Sender: TObject; var Key: Char);
begin
{ 1) Edit'te iken ESC'ye basılırsa;}
{ a) Doluysa sadece temizle}
{ b) Boşsa, sıfırla ve pencereyi kapat}
{ 2) Enter tuşuna basıldıysa verileri dışarı aktar ve pencereyi kapat}
FYazarkenBul := FOtomatikAra.Checked;
if (Key = #27) then begin
if (Sender is TEdit)
then begin
if (TEdit(Sender).Text='')
then VazgecKlik(Sender)
else begin
TEdit(Sender).Text := '';
TemizleKlik(Sender)
end;
end
else VazgecKlik(Sender);
end else
if (Key = #13) then begin
if (Sender is TEdit) then begin
if (FYazarkenBul = True)
then begin
TamamKlik(Sender);
end else begin
if (TEdit(Sender).Text>'') then begin
BulKlik(Sender);
if (FAdoDataSet.RecordCount = 1)
then TamamKlik(Sender)
else FGrid.SetFocus;
end;
end;
end else
if (Sender is TDBGrid) then begin
TamamKlik(Sender);
end;
end;
end;
procedure TupLookupDialog.VazgecKlik(Sender: TObject);
begin
{Pencere varsa vazgeç düğmesinin işlevlerine boş değer ataması yapıp kapatıyoruz...}
if (Assigned(FPencere)) then begin
FValueKey := Variant(0);
FValueData := '';
ExecuteSonucu := False;
FPencere.Close; {Bu olmazsa kapanmaz!}
end;
end;
end.
Butonlu Edit Nesnesi (TupEditButon)
- 06 Ağustos 2009 Perşembe
- Uğur Parlayan
Son zamanlarda kendimi programlamaya verdim ve Delphicilerin faydalanacağına emin olduğum bir nesnenin kaynak kodlarını burada yayınlamaktan mutluluk duyuyorum. "Gerekli miydi?" derseniz, "nerede kullanacağınıza bağlı" derim. Lafı döndürmeye gerek yok, doğrudan konuya girelim;
TupEditButon ne işe yarar
Bu bileşen, tek satırlık bir metin kutusudur (TEdit), fakat diğer metin kutularından farklı olarak bir de dahili bir buton içerir. Çok yoğun formlarda böyle şeyler genelde aranılan bileşenlerdir, gerek yer sıkıntısı yaşanmaması adına, gerekse görüntü kirliliği oluşturmaması açısından ve biraz da simetri hastası delphiciler bu tür bileşenleri daha çok tercih eder. Üstelik kullanıcılar da bu tür özellikleri daha çabuk kapar ve kısa sürede kullanımına alışırlar. Son olarak bu tür bir bileşeni çeşitlendirerek kendine özgü bileşen paketleri de üretebilme kolaylığınız vardır çünkü gayet sade ve gayet işlevsel bir kaynak koda sahiptir. Eğer aşağıdaki kaynak kodu doğru şekilde işlerseniz daha farklı bir çok yetenek kazandırabilirsiniz.
Hatırlatma açısından değinmekte fayda var, kod aralarına yeni paragraflar ekleyerek kodun bütünlüğünü, kolay anlaşılabilirliğini parçalamak istemedim, o nedenle gerekli açıklamaları kaynak kodun içinden okuyabilirsniz, ayrıca bu kaynak kodu Delphi 2007'de halâ kullanmaktayım (Tabi çok daha gelişmiş başka bir sürümünü :)
{******************************************************************************}
{* *}
{* Programlayan: Uğur Parlayan (ugurparlayan@gmail.com) *}
{* Tarih: 06.08.2009 *}
{* *}
{* Kullanım: Ayrım gözetmeksizn külliyatıyla ÜCRETSİZDİR *}
{* Yazarın gönlü olsun diye kaynak belirtirseniz sevinirim... *}
{* *}
{* URL: http://www.kavramca.com/index.php?k=31 *}
{* *}
{******************************************************************************}
unit upEditButon;
interface
uses
SysUtils, Classes, StdCtrls, Mask, DBCtrls, DB, ExtCtrls, Controls,
Buttons, Messages, Graphics, Windows, Forms, Dialogs;
type
TupEditButon = class(TEdit)
private
FButon: TButton;
function GetMinHeight: Integer;
procedure SetEditRect;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
function GetOnButonClick: TNotifyEvent;
procedure SetOnButonClick(const Value: TNotifyEvent);
protected
procedure CreateWnd; override;
procedure KeyPress(var Key: Char); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure CreateParams(var Params: TCreateParams); override;
property Button: TButton read FButon;
published
{OnButonClick: Bu özellik butonumuza basılıp basılmadığını yönetecek...}
Property OnButonClick: TNotifyEvent read GetOnButonClick write SetOnButonClick;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Ugur', [TupEditButon]);
end;
{ TupEditButon }
constructor TupEditButon.Create(AOwner: TComponent);
var
En: integer;
begin
{Ana nesneyi oluşturduk}
inherited Create(AOwner);
{Butonu üretiyoruz}
En := 20;
FButon := TButton.Create (Self);
with FButon do begin
Parent := Self;
Caption := '...';
{ Buton.Brush.Bitmap.Canvas.TextWidth(FButon.Caption); }
{ Yukarıdaki satır nesne henüz oluşum aşamasında olduğu için hata veriyor }
{ O nedenle "EN" değişkenine sabit bir değer verildi... }
Height := 16;
Width := En;
Left := Self.Width - En - 1;
Text := ''; {Buraya bir başlangıç değeri verilebilir...}
Visible := True;
end;
ControlStyle := ControlStyle - [csSetCaption];
end;
procedure TupEditButon.CreateParams(var Params: TCreateParams);
begin
{Bu prosedür bu bileşene bağlı alt bileşenlere parametre göndermekte kullanılır...}
inherited CreateParams(Params);
Params.Style := Params.Style or ES_MULTILINE or WS_CLIPCHILDREN;
end;
procedure TupEditButon.CreateWnd;
begin
{Yazı alanının belli bir bölgede sınırlanmasına yardım eder...}
inherited CreateWnd;
SetEditRect;
end;
destructor TupEditButon.Destroy;
begin
{Nesne yok edilirken bağlı diğer nesneler de yokedilir.}
FButon := nil;
inherited Destroy;
end;
function TupEditButon.GetMinHeight: Integer;
var
DC: HDC;
SaveFont: HFont;
I: Integer;
SysMetrics, Metrics: TTextMetric;
begin
{Metin alanının kaç pizel yükseklikte olduğunu hesaplar.}
DC := GetDC(0);
GetTextMetrics(DC, SysMetrics);
SaveFont := SelectObject(DC, Font.Handle);
GetTextMetrics(DC, Metrics);
SelectObject(DC, SaveFont);
ReleaseDC(0, DC);
I := SysMetrics.tmHeight;
if I > Metrics.tmHeight then I := Metrics.tmHeight;
Result := Metrics.tmHeight + I div 4 + GetSystemMetrics(SM_CYBORDER) * 4 + 2;
end;
function TupEditButon.GetOnButonClick: TNotifyEvent;
begin
{Olay tetiklendiğinde bizim butona yönlendirilecek...}
Result := FButon.OnClick;
end;
procedure TupEditButon.KeyPress(var Key: Char);
begin
inherited;
{Enter'e basılınca alt satıra geçmesin, bi düdük çalsın...}
if Key = #13 then begin
Key := #0;
MessageBeep(0);
end;
{entere basılmamışsa tuşu devreye al...}
if not(Key in [#0,#13]) then inherited KeyPress(Key);
end;
procedure TupEditButon.SetEditRect;
var
Kutu: TRect;
begin
{yazı alanının belli bir sınır içine alınmasını sağlar...}
{$IFNDEF TMSDOTNET}
SendMessage(Handle, EM_GETRECT, 0, LongInt(@Kutu));
{$ENDIF}
{$IFDEF TMSDOTNET}
Perform(EM_GETRECT, 0, Kutu);
{$ENDIF}
Kutu.Bottom := ClientHeight + 1;{windowsun paint zımbırtısının bir buguymuş}
Kutu.Right := ClientWidth - FButon.Width - 1;
Kutu.Top := 0;
Kutu.Left := 0;
{$IFNDEF TMSDOTNET}
SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Kutu));
SendMessage(Handle, EM_GETRECT, 0, LongInt(@Kutu)); {dibagçün...}
{$ENDIF}
{$IFDEF TMSDOTNET}
Perform(EM_SETRECTNP, 0, Kutu);
Perform(EM_GETRECT, 0, Kutu);
{$ENDIF}
end;
procedure TupEditButon.SetOnButonClick(const Value: TNotifyEvent);
begin
{Editteki butona basılazak...}
FButon.OnClick := Value;
end;
procedure TupEditButon.WMSize(var Message: TWMSize);
var
Boy: Integer;
begin
inherited;
Boy := GetMinHeight;
{Edit nesnesinin bir buguymuş. Bu işlem yapılmazsa nesne büzüşür...}
if (Height < Boy) then
Height := Boy
else
if (FButon <> nil) then begin
if NewStyleControls and Ctl3D
then FButon.SetBounds(Width - FButon.Width - 4, 0, FButon.Width, Height - 4)
else FButon.SetBounds(Width - FButon.Width, 1, FButon.Width, Height - 2);
SetEditRect;
end;
end;
end.
Hatırlatma
Bu sayfa test aşamasında olup deneysel veriler içermektedir.
Cıvıltılar
- Herkes aynı fikirdeyse, hiç kimse yeterince düşünmüyor demektir
- Beleş malın ömrü kısa olur
- Bütün mucitler tembel olsaydı cilalıtaş devrine yeni girmiştik...
- Çaresizlik insana icat yaptırır...
- Yüzyılın Soykırımı
- Sparkfun elektronik 7 Ocak 2010'da 1000 kişiye 100$ değerinde hediye dağıtacakmış...
- Muharrem Ankara'da işbaşı yaptı, kendisine başarılı ve müreffeh bir iş hayatı diliyoruz :)
- Erhan'a da huzurlu ve mutlu bir ömür diliyoruz.
- MikroPascal'ın LCD kütüphanesinde ne tür bir sorun olabilir AÇAPAAAA! Nerede bu kodlar, nerede bu kaynak kodlar !!!
Kategori Bulutu
Algoritma Delphi Dialog Fonksiyon Kod Örneği Login Metin İşleme Mssql Parse Pascal Programlama Projeler Select Sql T-Sql Upeditbutton Uplogindialog Uplookupdialog Wıth Zaman Ölçme Öneri Şiir
Etikettekiler
Bağlantılar
- ARGE - Mikro Pascal
- ARGE - TOLA Elektronik
- Blog - Tuğruk Helvacı
- Delphi - Delphi Distiller
- Delphi - Delphi Peak (TR)
- Delphi - Delphi Product Page
- Delphi - Free Jans Components
- Delphi - Krsnsk (Blog)
- Delphi - Regular Expressions
- Delphi - TwinForms
- DHTML - Tab Box
- Donanım - Hardware ağırlıklı site...
- Gfx - Change DPI
- Komünite - Bildirgeç
- Komünite - Zamazing
- OpenXML
- PHP - PHP Designer 2007 - Personal
- SQL - PengoWorks
- SQL - SimpleTalk
- STÖ - Türkcan
- Web - Bluementals - Free CSS Toolbox
- Web - HTML Dog