- .com
- Türkçe, Delphi ve SQL konusundaki deneyimler, örnek kodlar, eleştiri ve düşünceler...
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.
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
- Etiket Sınırlamasını Kaldır
- Delphi ile "Login olmak" (Kullanıcı giriş denetimi)
- T-SQL ile Dakikayı Metne Çevirmek
- T-SQL ile Metinleri Parçalarına Ayrıştırmak
- T-SQL ile Sonuçlarda Sorgulamak
- T-SQL ile Yazım Kurallarını Uygulamak...
- T-SQL ile Metin Filtreleme
- Lookup'a Farklı Bir Yaklaşım (TupLookupDialog)
- Butonlu Edit Nesnesi (TupEditButon)
- Ölü Proje "Tazı"
- T-SQL İle Soy Ağacı Oluşturmak
- Pascal ile Metinleri parçalarına ayrıştırmak
- Düşünmek için algoritma kullanmak
- Bir Cemal Süreya Şiiri
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
Sayfa Seç
1 Toplam 1 sayfa var. Siz 1. sayfadasınız ve 1 kayıt içinden 1 ile 1 arasını görmektesiniz