197)COMBOBOX BILEŞENININ, IÇINE GIRILDIĞINDE AÇILMASI VE KAPANMASI 321
198)YAZICIYA DOĞRUDAN BASKI GÖNDERME IŞLEMI 321
199)BILGISAYARI KAPATIP YENIDEN BAŞLATMA 323
1.Veri Tabanı/BDE
Bu başlık altında, Delphi programlarında veri tabanı ve veri erişiminde kullanılan bileşenler ile ilgili püf noktaları ve gerekli kod örnekleri yer almaktadır.
Ttable/TQuery üzerinde arttırarak arama
Tedit kullanarak, Ttable üzerinde arttırmalı arama yapmak için, Tedid bileşeninin OnChange olay yordamına, aşğıdaki kod yazılır.
procedure TForm1.Edit1Change(Sender: TObject);
begin
With Edit1 do
if Text <> '' then
Table1.FindNearest([Text]);
end;
Bu türlü bir arama Tquerry üzerinde yapılacaksa,
procedure TForm1.Edit1Change(Sender: TObject);
begin
With Edit1 do
if Text <> '' then begin
Query1.Filter := 'code = '''+Edit1.Text+'''';
Query1.FindFirst;
end;
end;
veya
procedure TForm1.Edit1Change(Sender: TObject);
begin
With Edit1 do
if Text <> '' then
Query1.Locate('code',Edit1.Text,[loPartialKey]);
end;
Paradox-Tablo yaratılması
Kod içerisinden bir Paradox tablosu şu şekilde yaratılır.
Ttable bileşeninden yola çıkarak, bağlı olduğu tablonun alan bilgileri "FieldDefs" özelliği sayesinde elde edilebilir. GetFieldNames davranışı alan isimlerini, GetIndexNames davranışı ise tabloda mevcut olan indeks isimlerini döndürür.
Master-Detay ilişki içerisindeki tablolarda, detayı olan bir ana kayıt silindiğinde, detaylar ortada kalır. Ana kayıt olmadığına göre detaylara da ihtiyaç yoktur. Bu nedenle ana kayıt silinmeden önce detayları silmek gerekir. Table1 ana tabloya, Table2 de Detay tabloya bağlı kabul edilirse, Table1' den bir kayıt silinmek istendiğinde önce Table2' deki detaylar temizlenecektir aşağıdaki örnek bunu göstermektedir.
DBGrid bileşeninde Memo/Blob alanlar<memo> olarak gösterilir.
Aşağıdaki örnekte bu tür alanların da metin olarak görüntülenmesi sağlanmaktadır. Table bileşeni üzerine yüklenen kolonlardan NOTES alanı MEMO tipindedir. Bu alanın GetText yordamında Blob2Str fonksiyonu kullanılarak, alandaki veri görünür hale getirilmektedir.
procedure TForm1.Table1NotesGetText(Sender: TField; var Text: String;
Tablo içeriğinin TstrinGrid bileşenine doldurulması şu şekilde olur.
table.first;
row := 0;
grid.rowcount := table.recordCount;
while not table.eof do begin
for i := 0 to table.fieldCount-1 do
grid.cells[i,row] := table.fields[i].asString;
inc (row);
table.next;
end;
TTable veya TQuery üzerinden kayıt numarasının bulunması
Dataset Paradox veya dBASE tablosuna bağlı ise kayıt numarasını bulmak, birkaç BDE fonksiyon kullanmak suretiyle mümkündür. Ancak SQL tabanlı veri tabanı sunumcularında, sunumcunun kendisi buna imkan vermiyorsa, bu bilgi elde edilemez.
Aşağıdaki fonksiyon parametre olarak bir Ttable bileşeni almakta ve gösterdiği Paradox/dBase tablosunudan kayıt numarasını, başarısız olduğunda ise 0 değerini döndürmektedir.
Bu fonksiyonun döndürdüğü kayıt numarası, kaydın tablodaki fiziksel yeri ile ilgilidir. Indeks tanımlanmış bir TTable veya "Order by" ile sıraya sokulmuş bir sorgu kümesi döndüren Tquery bileşeninde, hatalı değer döndüğü sanısına kapılınmamalıdır.
Ttable bileşenini kullanarak, bir tablodaki alan sayısının bulunması için
TableX.fieldcount
Özelliğinden faydalanılabilir. Ancak tablo alanlarının bir kısmı, ttable bileşeni üzerine yüklenmişse fieldcount özelliği sadece yüklenen alan sayısını getirir. Alanları ttable üzerine kısmen yüklenmiş olan bir tablonun, gerçek alan sayısının bulunabilmesi için, aşağıdaki fonksiyon kullanılabilir.
Bu kodun kullanılabilmesi için, form üzerine yerleştirileni ttable bileşenine, bağlandığı tablo alanlarının bir kısmı yüklenmelidir.
Alanlar yüklendiğinde, tanımları buraya yerleşecektir.
}
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
function GetFieldCount(T: TTable): Integer;
var
curProp: CURProps;
bWasOpen: Boolean;
begin
Result := 0; {Just in case something goes wrong.}
bWasOpen := T.Active;
try
if not bWasOpen then
T.Open;
Check(DbiGetCursorProps(T.Handle, curProp));
Result := curProp.iFields;
finally
if not bWasOpen then
T.Close;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
showmessage(inttostr(table1.fieldcount));
showmessage(inttostr(GetFieldCount(table1)));
end;
end.
Bir tablodaki verinin, başka bir tabloya eklenmesi
Aynı yapıdaki iki ayrı toblo muhteviyatının, birleştirilmesi için kullanılabilecek olan bu fonksiyon, <SourceTable> isimli tablodaki verileri, <DestinationTable>isimli tabloya kopyalamaktadır. Bu yöntemle veriler, farklı veri tabanları arasında da taşınabilir.
Function AddTables(
const
SourceDatabaseName,
SourceTable,
DestDatabaseName,
DestinationTable: string): Boolean;
Var
BMode : TBatchMode;
Begin
If IsTableKeyed(DestDatabaseName,DestinationTable) Then
Begin
If IsTableKeyed(SourceDatabaseName,SourceTable) Then
Begin
BMode := BatAppendUpdate;
End
Else
Begin
BMode := BatAppend;
End;
End
Else
Begin
BMode := BatAppend;
End;
Result := DBRecordMove(SourceDatabaseName,SourceTable,
DestDatabaseName,DestinationTable,BMode);
End;
Sorgudan tablo yaratılması
Karmaşık sorgular sonucunda toplanan veriler, bu fonksiyon yardımıyla yaratılan bir tablo içerisine doldurulabilir.
Function DBCreateTableFromQuery(
Query: TQuery;
NewTableName,
TableDatabaseName: String): Boolean;
var
D: TTable;
ActiveWas : Boolean;
begin
D := nil;
try
{The Source Table}
ActiveWas:= Query.Active;
Query.Active:= true;
D:= TTable.Create(nil);
D.Active:= False;
D.DatabaseName := TableDatabaseName;
D.TableName:= NewTableName;
D.ReadOnly:= False;
D.BatchMove(Query,batCopy);
Query.Active := ActiveWas;
Result := True;
finally
D.Free;
end;
End;
Sorgudan tabloya veri aktarımı
Bir sorgu neticesinde elde edilen veriler, bu fonksiyon kullanılarak, mevcut bir tabloya aktarılabilir.
Procedure DBAddQueryToTable(
DataSet : TQuery;
const
DestDatabaseName,
DestinationTable: string);
var
DTable : TTable;
BMove: TBatchMove;
begin
DTable := TTable.Create(nil);
BMove:= TBatchMove.Create(nil);
Try
DataSet.Active:= True;
DTable.DatabaseName:= DestDatabaseName;
DTable.TableName:= DestinationTable;
DTable.Active:= True;
BMove.AbortOnKeyViol:= False;
BMove.AbortOnProblem:= False;
BMove.ChangedTableName := 'CTable';
BMove.Destination:= DTable;
BMove.KeyViolTableName := 'KTable';
BMove.Mode:= batAppend;
BMove.ProblemTableName := 'PTable';
BMove.Source:= DataSet;
BMove.Execute;
Finally
DTable.Active:= False;
DTable.Free;
BMove.Free;
End;
End;
Tablodaki bir alana ait verilerin, başka bir alana kopyalanması
Bir tabloda bulunan alanlardan bir içerisinde bulunan veriler, başka bir alana kopyalanacağı zaman, aşağıdaki fonksiyon kullanılabilir.
function DBCopyFieldAToB(
DatabaseName,
TableName,
SourceField,
DestField: String): Boolean;
var
Query: TQuery;
CursorWas : TCursor;
Sess: TSession;
begin
CursorWas:= Screen.Cursor;
Sess:= DBSessionCreateNew;
Sess.Active:= True;
Query:= TQuery.Create(sess);
Query.SessionName := Sess.SessionName;
Sess.Active:= True;
Query.Active:= False;
Query.RequestLive := True;
try
Result := False;
Query.DatabaseName := DatabaseName;
Query.SQL.Clear;
Query.SQL.Add('Select ');
Query.SQL.Add(SourceField+',');
Query.SQL.Add(DestField);
Query.SQL.Add('From '+TableName);
Query.Open;
Query.First;
While Not Query.EOF Do
Begin
ProgressScreenCursor;
Try
Query.Edit;
Query.FieldByName(DestField).AsString :=
Query.FieldByName(SourceField).AsString;
Query.Post;
Except
End;
Query.Next;
End;
Result := True;
finally
Query.Free;
Screen.Cursor := CursorWas;
Sess.Active:= False;
end;
end;
Tablo kopyalama
Bir tablo olduğu gibi , başka bir veri tabanına veya aynı veri tabanına kopyalanabilir. <DestTable> isimli bir tablo mevcutsa, eskisi silinir.. Bu fonksiyon oldukça güçlü bir veri taşıma aracıdır. Tablolar, BDE tarafından desteklenen, herhangi bir veri tabanı ortamından, başka bir veri tabanı ortamına kopyalanabilir. Aşağıdaki örnekte, "DBDemos" veri tabanındaki "Customer.db" isimli tablo, "Sybase" veri tabanına kopyalanmaktadır.,
Tablo yapısı, <SourceTable> tablosundan alınmak suretiyle, karşı tarafta yeni bir tablo yaratılmaktadır. Tarafların, lokalde veya uzakta olmaları farketmez.Eğer karşı tarafta aynı adı taşıyan bir tablo varsa, silinir ve yerine yenisi yaratılır.
Function DBCreateTableBorrowStr(
SourceDatabaseName: String;
SourceTableName: String;
DestDatabaseName: String;
DestTableName: String): Boolean;
Var
S: TTable;
D: TTable;
i,j: Integer;
IMax: Integer;
IndexName: String;
IndexFields: String;
IndexFields2: String;
Q: TQuery;
IDXO: TIndexOptions;
Begin
S := TTable.Create(nil);
D := TTable.Create(nil);
Try
Try
S.Active:= False;
S.DatabaseName := SourceDatabaseName;
S.TableName:= SourceTableName;
S.TableType:= ttDefault;
S.Active:= True;
D.DatabaseName := DestDatabaseName;
D.TableName:= DestTableName;
D.TableType:= ttDefault;
D.FieldDefs.Assign(S.FieldDefs);
D.CreateTable;
{Similar method could be used to create the indices}
Herhangi bir veri tabanından tablo silmek gerektiğinde, aşağıdaki fonksiyon kullanılabilir.
Function DBDropTable(const DatabaseName, TableName : string):Boolean;
var Query : TQuery;
begin
Result := False;
If Not IsTable(DatabaseName, TableName) Then
Begin
Exit;
End;
Query := TQuery.Create(nil);
try
Query.DatabaseName := DatabaseName;
Query.SQL.Clear;
Query.SQL.Add('Drop Table ');
If (Pos('.DB', UpperCase(TableName)) > 0) Or
(Pos('.DBF',UpperCase(TableName)) > 0) Then
Begin
Query.Sql.Add('"'+TableName+'"');
End
Else
Begin
Query.Sql.Add(TableName);
End;
Result := True;
Try
Query.ExecSQL;
Except
Result := False;
End;
finally
Query.Free;
end;
end;
Alan adının bulunması
Sıra numarası verilen bir tablo alanının alan adı bu fonksiyonla alınabilir.
Function DBFieldNameByNo(
DatabaseName: String;
TableName: String;
FieldNo: Integer): String;
Var
Table: TTable;
Begin
Result := '';
If Not IsTable(DatabaseName, TableName) Then Exit;
If FieldNo < 0 Then Exit;
If FieldNo >= DBNFields(DatabaseName, TableName) Then Exit;
Table := TTable.Create(nil);
Try
Try
Table.Active:= False;
Table.DatabaseName := DatabaseName;
Table.TableName:= TableName;
Table.Active:= True;
Result := Table.FieldDefs[FieldNo].Name;
Except
End;
Finally
Table.Free;
End;
End;
Ortak alan isimleri
Bu fonksiyonda, her iki tabloda da mevcut olan alan isimleri, aralarına konan virgüllerle ayrılmış olarak dönerler.
Function DBFieldNamesCommonToString(
DatabaseName1 : String;
TableName1: String;
DatabaseName2 : String;
TableName2: String): String;
Var
List1 : TStringList;
List2 : TStringList;
i: Integer;
Suffix: String;
Begin
Result := '';
List1:= TStringList.Create();
List2:= TStringList.Create();
Try
DBFieldNamesToTStrings(
DatabaseName1,
TableName1,
List1);
For i := 0 To List1.Count - 1 Do
Begin
List1[i] := UpperCase(List1[i]);
End;
DBFieldNamesToTStrings(
DatabaseName2,
TableName2,
List2);
For i := 0 To List2.Count - 1 Do
Begin
List2[i] := UpperCase(List2[i]);
End;
For i := 0 To List1.Count - 1 Do
Begin
If Result = '' Then
Begin
Suffix := '';
End
Else
Begin
Suffix := ', ';
End;
If List2.IndexOf(List1[i]) <> -1 Then
Begin
Result := Result + Suffix + List1[i];
End;
End;
Finally
List1.Free;
List2.Free;
End;
End;
Tablodaki alan isimleri
Bu fonksiyon, tablodaki alanlara ait isimleri, bir Tstrings nesnesi içerisine doldurur.
Function DBFieldNamesToTStrings(
DatabaseName : String;
TableName: String;
Strings: TStrings): Boolean;
Var
Table: TTable;
FieldNo: Integer;
Begin
Result := False;
If Not IsTable(DatabaseName, TableName) Then Exit;
Table := TTable.Create(nil);
Try
Try
Table.Active:= False;
Table.DatabaseName := DatabaseName;
Table.TableName:= TableName;
Table.Active:= True;
Strings.Clear;
For FieldNo := 0 To Table.FieldDefs.Count -1 Do
Begin
Strings.Add(Table.FieldDefs[FieldNo].Name);
End;
Result := True;
Except
End;
Finally
Table.Free;
End;
End;
Alan numarası
Bu fonksiyon, adı bilinen bir alanın, tablo içerisindeki sırasını bulur.
Function DBFieldNo(DatabaseName, TableName, FieldName: String): Integer;
Var
Table: TTable;
FieldIndex : Integer;
FieldNumber: Integer;
Begin
Result := -1;
If Not IsTable(DatabaseName, TableName) Then Exit;
If Not IsField(DatabaseName, TableName, FieldName) Then Exit;
Table := TTable.Create(nil);
Try
Try
Table.Active:= False;
Table.DatabaseName := DatabaseName;
Table.TableName:= TableName;
Table.Active:= True;
FieldIndex:=
Table.FieldDefs.IndexOf(FieldName);
FieldNumber:=
Table.FieldDefs[FieldIndex].FieldNo;
Result := FieldNumber;
Except
End;
Finally
Table.Free;
End;
End;
Alan uzunluğu
Tablo içerisindeki bir alanın, uzunluğu, bu fonksiyon ile bulunur.
Function DBFieldSize(DatabaseName, TableName, FieldName: String): Integer;
Var
Table: TTable;
FieldIndex : Integer;
FieldSize: Integer;
Begin
Result := 0;
If Not IsTable(DatabaseName, TableName) Then Exit;
If Not IsField(DatabaseName, TableName, FieldName) Then Exit;
Table := TTable.Create(nil);
Try
Try
Table.Active:= False;
Table.DatabaseName := DatabaseName;
Table.TableName:= TableName;
Table.Active:= True;
FieldIndex:=
Table.FieldDefs.IndexOf(FieldName);
FieldSize:=
Table.FieldDefs[FieldIndex].Size;
Result := FieldSize;
Except
End;
Finally
Table.Free;
End;
End;
Alan tipleri
Adı bilinen bir alanın tipini bulmak için aşağıdaki fonksiyon kullanılabilir.
Function TypeField(DatabaseName, TableName, FieldName: String): String;
Var
Table: TTable;
FieldIndex : Integer;
FieldType: TFieldType;
Begin
Result := '';
If Not IsTable(DatabaseName, TableName) Then Exit;
If Not IsField(DatabaseName, TableName, FieldName) Then Exit;
Table := TTable.Create(nil);
Try
Try
Table.Active:= False;
Table.DatabaseName := DatabaseName;
Table.TableName:= TableName;
Table.Active:= True;
FieldIndex:=
Table.FieldDefs.IndexOf(FieldName);
FieldType:=
Table.FieldDefs[FieldIndex].DataType;
If FieldType=ftUnknownThen Result := 'Unknown';
If FieldType=ftStringThen Result := 'String';
If FieldType=ftSmallInt Then Result := 'SmallInt';
If FieldType=ftIntegerThen Result := 'Integer';
If FieldType=ftWordThen Result := 'Word';
If FieldType=ftBooleanThen Result := 'Boolean';
If FieldType=ftFloatThen Result := 'Float';
If FieldType=ftCurrency Then Result := 'Currency';
If FieldType=ftBCDThen Result := 'BCD';
If FieldType=ftDateThen Result := 'Date';
If FieldType=ftTimeThen Result := 'Time';
If FieldType=ftDateTime Then Result := 'DateTime';
If FieldType=ftBytesThen Result := 'Bytes';
If FieldType=ftVarBytes Then Result := 'VarBytes';
If FieldType=ftBlobThen Result := 'Blob';
If FieldType=ftMemoThen Result := 'Memo';
If FieldType=ftGraphicThen Result := 'Graphic';
{$IFDEF WIN32}
If FieldType=ftAutoIncThen Result := 'AutoInc';
If FieldType=ftFmtMemoThen Result := 'FmtMemo';
If FieldType=ftParadoxOleThen Result := 'ParadoxOle';
If FieldType=ftDBaseOleThen Result := 'DBaseOle';
If FieldType=ftTypedBinaryThen Result := 'TypedBinary';
{$ENDIF}
Except
End;
Finally
Table.Free;
End;
End;
Yukarıdaki fonksiyon ile aynı işleve sahip bir fonksiyondur. Fakat fonksiyona alan adı değil, sıra numarası verilir.
Function DBFieldTypeByNo(DatabaseName, TableName: String; FieldNo: Integer): String;
Var
Table: TTable;
FieldIndex : Integer;
FieldType: TFieldType;
Begin
Result := '';
If Not IsTable(DatabaseName, TableName) Then Exit;
Table := TTable.Create(nil);
Try
Try
Table.Active:= False;
Table.DatabaseName := DatabaseName;
Table.TableName:= TableName;
Table.Active:= True;
FieldIndex:= FieldNo;
Try
FieldType:=
Table.FieldDefs[FieldIndex].DataType;
Except
FieldType:= ftUnknown;
End;
{TFieldType Possible values are
ftUnknown, ftString, ftSmallint,
ftInteger, ftWord, ftBoolean,
ftFloat, ftCurrency, ftBCD, ftDate,
ftTime, ftDateTime, ftBytes, ftVarBytes,
ftBlob, ftMemo or ftGraphic}
If FieldType=ftUnknownThen Result := 'Unknown';
If FieldType=ftStringThen Result := 'String';
If FieldType=ftSmallInt Then Result := 'SmallInt';
If FieldType=ftIntegerThen Result := 'Integer';
If FieldType=ftWordThen Result := 'Word';
If FieldType=ftBooleanThen Result := 'Boolean';
If FieldType=ftFloatThen Result := 'Float';
If FieldType=ftCurrency Then Result := 'Currency';
If FieldType=ftBCDThen Result := 'BCD';
If FieldType=ftDateThen Result := 'Date';
If FieldType=ftTimeThen Result := 'Time';
If FieldType=ftDateTime Then Result := 'DateTime';
If FieldType=ftBytesThen Result := 'Bytes';
If FieldType=ftVarBytes Then Result := 'VarBytes';
If FieldType=ftBlobThen Result := 'Blob';
If FieldType=ftMemoThen Result := 'Memo';
If FieldType=ftGraphicThen Result := 'Graphic';
Except
End;
Finally
Table.Free;
End;
End;
Tablonun anahtar alanları
Bir tabloda, anahtar olarak kullanılan alanlar, Tstrings nesnesine doldurulur.
Function DBKeyFieldNamesToTStrings(
DatabaseName : String;
TableName: String;
Strings: TStrings): Boolean;
Var
Table: TTable;
FieldNo: Integer;
Begin
Result := False;
If Not IsTable(DatabaseName, TableName) Then Exit;
Table := TTable.Create(nil);
Try
Try
Table.Active:= False;
Table.DatabaseName := DatabaseName;
Table.TableName:= TableName;
Table.Active:= True;
Strings.Clear;
For FieldNo := 0 To Table.FieldDefs.Count -1 Do
Begin
If IsFieldKeyed(
DatabaseName,
TableName,
Table.FieldDefs[FieldNo].Name) Then
Begin
Strings.Add(Table.FieldDefs[FieldNo].Name);
End;
End;
Result := True;
Except
End;
Finally
Table.Free;
End;
End;
LookUp yöntemiyle değer seçme diyaloğu
Kullanıcıya bir LookUp diyaloğu gösterip, seçtiği değeri döndüren bir fonksiyondur. Eğer kullanıcı "Cancel" butonuna basarsa, boş bir karakter dizisi döner.
Function DialogLookupDetail(
Const DialogCaption: string;
Const InputPrompt: string;
Const DefaultValue: string;
Const Values: TStringList;
Const ButtonSpacing: Integer;
Const SpacerHeight: Integer;
Const TopBevelWidth: Integer;
Const PromptHeight: Integer;
Const FormHeight: Integer;
Const FormWidth: Integer;
Const Hint_OK: string;
Const Hint_Cancel: string;
Const Hint_ListBox: string;
Const ListSorted: Boolean;
Const AllowDuplicates : Boolean
): string;
Var
Form: TForm;
Base_Panel: TPanel;
Base_Buttons : TPanel;
Spacer: TPanel;
Base_Top: TPanel;
ButtonSlider : TPanel;
ButtonSpacer : TPanel;
Prompt: TPanel;
ListBox: TListBox;
ButtonCancelB: TPanel;
ButtonOKB: TPanel;
Button_Cancel: TButton;
Button_OK: TButton;
DefItemIndex : Integer;
TempValues: TStringList;
Begin
Result:= DefaultValue;
Form:= TForm.Create(Application);
TempValues := TStringList.Create();
Try
TempValues.Sorted := ListSorted;
TempValues.Clear;
If AllowDuplicates Then
Begin
TempValues.Duplicates := dupAccept;
End
Else
Begin
TempValues.Duplicates := dupIgnore;
End;
If Values <> nil Then
Begin
TempValues.Assign(Values);
End;
With Form Do
Begin
Try
Canvas.Font:= Font;
BorderStyle:= bsSizeable;
Caption:= DialogCaption;
Height:= FormHeight;
Width:= FormWidth;
ShowHint:= True;
Position:= poScreenCenter;
BorderIcons:= [biMaximize];
Base_Panel:= TPanel.Create(Form);
With Base_Panel Do
Begin
Parent:= Form;
Align:= alClient;
Caption:= ' ';
BorderWidth := 10;
BorderStyle := bsNone;
BevelOuter:= bvNone;
BevelInner:= bvNone;
End;
Base_Buttons:= TPanel.Create(Form);
With Base_Buttons Do
Begin
Parent:= Base_Panel;
Align:= alBottom;
Caption:= ' ';
BorderWidth := 0;
BorderStyle := bsNone;
BevelOuter:= bvNone;
BevelInner:= bvNone;
Height:= 27;
End;
ButtonSlider:= TPanel.Create(Form);
With ButtonSlider Do
Begin
Parent:= Base_Buttons;
Align:= alClient;
Caption:= ' ';
BorderWidth := 0;
BorderStyle := bsNone;
BevelOuter:= bvNone;
BevelInner:= bvNone;
End;
ButtonCancelB:= TPanel.Create(Form);
With ButtonCancelB Do
Begin
Parent:= ButtonSlider;
Align:= alRight;
Caption:= ' ';
BorderWidth := 0;
BorderStyle := bsNone;
BevelOuter:= bvNone;
BevelInner:= bvNone;
Width:= 75+ButtonSpacing;
End;
ButtonSpacer:= TPanel.Create(Form);
With ButtonSpacer Do
Begin
Parent:= ButtonCancelB;
Align:= alLeft;
Caption:= ' ';
BorderWidth := 0;
BorderStyle := bsNone;
BevelOuter:= bvNone;
BevelInner:= bvNone;
Width:= ButtonSpacing;
End;
ButtonOKB:= TPanel.Create(Form);
With ButtonOKB Do
Begin
Parent:= ButtonSlider;
Align:= alRight;
Caption:= ' ';
BorderWidth := 0;
BorderStyle := bsNone;
BevelOuter:= bvNone;
BevelInner:= bvNone;
Width:= 75;
End;
Spacer:= TPanel.Create(Form);
With Spacer Do
Begin
Parent:= Base_Panel;
Align:= alBottom;
Caption:= ' ';
BorderWidth := 0;
BorderStyle := bsNone;
BevelOuter:= bvNone;
BevelInner:= bvNone;
Height:= SpacerHeight;
End;
Base_Top:= TPanel.Create(Form);
With Base_Top Do
Begin
Parent:= Base_Panel;
Align:= alClient;
Caption:= ' ';
BorderWidth := 10;
BorderStyle := bsNone;
BevelOuter:= bvRaised;
BevelInner:= bvNone;
BevelWidth:= TopBevelWidth;
End;
Prompt:= TPanel.Create(Form);
With Prompt Do
Begin
Parent:= Base_Top;
Align:= alTop;
Caption:= ' ';
BorderWidth := 0;
BorderStyle := bsNone;
BevelOuter:= bvNone;
BevelInner:= bvNone;
Caption:= InputPrompt;
Height:= PromptHeight;
Alignment:= taCenter;
End;
Button_Cancel := TButton.Create(Form);
With Button_Cancel Do
Begin
Parent:= ButtonCancelB;
Caption:= 'Cancel';
ModalResult := mrCancel;
Default:= True;
Align:= alClient;
Hint:= Hint_Cancel;
End;
Button_OK := TButton.Create(Form);
With Button_OK Do
Begin
Parent:= ButtonOKB;
Caption:= 'OK';
ModalResult := mrOK;
Default:= False;
Align:= alClient;
Hint:= Hint_OK;
End;
ListBox := TListBox.Create(Form);
With ListBox Do
Begin
Parent:= Base_Top;
Align:= alClient;
Hint:= Hint_ListBox;
Sorted:= ListSorted;
Focused;
If TempValues <> nil Then
Begin
Items.Assign(TempValues);
DefItemIndex := Items.IndexOf(DefaultValue);
If DefItemIndex <> -1 Then
Begin
ItemIndex := DefItemIndex;
Selected[DefItemIndex];
End
Else
Begin
Result:= '';
ItemIndex := 0;
Selected[0];
End;
IntegralHeight:= True;
Button_OK.Default:= True;
Button_Cancel.Default := False;
End
Else
Begin
Result := '';
End;
End;
SetFocusedControl(ListBox);
If ShowModal = mrOk Then
Begin
If ListBox.ItemIndex<>-1 Then
Result := ListBox.Items[ListBox.ItemIndex];
End;
Finally
Form.Free;
End;
End;
Finally
TempValues.Free;
End;
End;
Bir Paradox tablosunun yeniden anahtarlanması
Mevcut bir Paradox tablosu, aşağıdaki fonksiyon kullanılarak yeniden anahtarlanabilir.
ShowMessage('Error in Function DBParadoxCreateNKeys');
End;
Finally
T.Free;
T2.Free;
End;
End;
Tablo adının değiştirilmesi
Belirtilen tablonun adını değiştirir. Bu fonksiyon kullanılırken, veri tabanındaki referans sınırlamalarına dikkat edilmelidir. SQL tabanlı veri tabanlarında, eğer tabloya referans eden başka veri tabanı nesneleri varsa, tablonun silinmesine izin verilmeyecektir.
Function DBReNameTable(
DatabaseName,
TableNameOld,
TableNameNew: String): Boolean;
Begin
Result := True;
Try
If Not IsTable(DatabaseName, TableNameOld) Then
Begin
Result := False;
Exit;
End;
{First Copy The Source Table To The New Table}
If Not DBCopyTable(
DatabaseName,
TableNameOld,
DatabaseName,
TableNameNew) Then
Begin
Result := False;
Exit;
End;
{Now Drop The Source Table}
If Not DBDropTable(DatabaseName, TableNameOld) Then
Begin
Result := False;
Exit;
End;
Except
Result := False;
End;
End;
{!~ Applies BatchMode Types As Appropriate To
Source and Destination Tables}
Function DBRecordMove(
SourceDatabaseName,
SourceTable,
DestDatabaseName,
DestTable: String;
BMode: TBatchMode): Boolean;
var S : TTable;
D : TTable;
B : TBatchMove;
begin
S := TTable.Create(nil);
D := TTable.Create(nil);
B := TBatchMove.Create(nil);
try
{Create The Source Table}
S.Active:= False;
S.DatabaseName := SourceDatabaseName;
S.ReadOnly:= False;
S.TableName:= SourceTable;
S.Active := true;
{Create The Destination Table}
D.Active:= False;
D.DatabaseName := DestDatabaseName;
D.TableName:= DestTable;
D.ReadOnly:= False;
{Make the table copy}
B.AbortOnKeyViol := False;
B.AbortOnProblem := False;
B.Destination:= D;
B.Source:= S;
B.Mode:= BMode;
Try
B.Execute;
Except
End;
Result := True;
finally
S.Free;
D.Free;
B.Free;
end;
End;
Tablo yapıları aynı mı?
Bu fonksiyonda, iki tablonun yapısı karşılaştırılır ve aynı ise TRUE değeri döndürülür.
Function DBSchemaSame(const
DatabaseName1,
Table1,
DatabaseName2,
Table2: string): Boolean;
Begin
Result := IsStructureSame(DatabaseName1,Table1,DatabaseName2,Table2);
End;
{!~ Creates a new TSession object.}
{$IFDEF WIN32}
Function DBSessionCreateNew: TSession;
{$ENDIF WIN32}
{$IFDEF WIN32}
Var
List : TStringList;
Seed : String;
i: Integer;
Ses: String;
Begin
Seed := 'Session';
Ses:= Seed+'0';
List := TStringList.Create;
Try
Sessions.GetSessionNames(List);
For i := 0 To 1000 Do
Begin
Ses := Seed + IntToStr(i);
If List.IndexOf(Ses) = -1 Then Break;
End;
Result := Sessions.OpenSession(Ses);
Finally
List.Free;
End;
End;
{$ENDIF}
Bir tablo alanındaki değerlerin sağ tarafındaki boşlukların temizlenmesi
Belirtilen alandaki değerlerin, sağ yanındaki boşlukları temizleyen bir fonksiyondur.
Function DBTrimBlanksRight(
DatabaseName : String;
TableName: String;
FieldName: String): Boolean;
Var
Q : TQuery;
S : String;
Begin
{Result := False;}{zzz}
Q := TQuery.Create(nil);
Try
Q.Active:= False;
Q.DatabaseName := DatabaseName;
Q.RequestLive:= True;
Q.Sql.Clear;
Q.Sql.Add('Select');
Q.Sql.Add('*');
Q.Sql.Add('From');
Q.Sql.Add('"'+TableName+'"');
Q.Active := True;
Q.First;
While Not Q.EOF Do
Begin
S := Q.FieldByName(FieldName).AsString;
S := Trim(S);
S := Trim(S);
Q.Edit;
Q.FieldByName(FieldName).AsString := S;
Q.Post;
Q.Next;
End;
Result := True;
Finally
Q.Free;
End;
End;
Aranan alan, tabloda var mı?
Alan, belirtilen tabloda varsa fonksiyondan TRUE değeri döner.
Function IsField(DatabaseName, TableName, FieldName: String): Boolean;
Var
Query: TQuery;
T: TTable;
i: Integer;
UpperFN : String;
TestFN: String;
Begin
Result:= False;
UpperFN := UpperCase(FieldName);
If Not IsTable(DatabaseName, TableName) Then Exit;
Query := TQuery.Create(nil);
T:= TTable.Create(nil);
Try
Try
Query.DatabaseName := DatabaseName;
Query.Sql.Clear;
Query.Sql.Add('Select ');
Query.Sql.Add('a.'+FieldName+' XYZ');
Query.Sql.Add('From');
If (Pos('.DB', UpperCase(TableName)) > 0) Or
(Pos('.DBF',UpperCase(TableName)) > 0) Then
Begin
Query.Sql.Add('"'+TableName+'" a');
End
Else
Begin
Query.Sql.Add(TableName+' a');
End;
Query.Active := True;
Result := True;
Except
Try
T.Active:= False;
T.DatabaseName := DatabaseName;
T.TableName:= TableName;
T.Active:= True;
If T.FieldDefs.IndexOf(FieldName) > -1 Then
Begin
Result := True;
End
Else
Begin
For i := 0 To T.FieldDefs.Count -1 Do
Begin
TestFN := UpperCase(T.FieldDefs[i].Name);
If TestFN = UpperFN Then
Begin
Result := True;
Break;
End;
End;
End;
T.Active := False;
Except
End;
End;
Finally
Query.Free;
T.Free;
End;
End;
Alan anahtar mı?
Belirtilen alan, o tabloda mevcutsa ve anahtar olarak kullanılıyorsa, bu fonksiyondan TRUE değeri döner.
Function IsFieldKeyed(DatabaseName, TableName, FieldName: String): Boolean;
Var
Table: TTable;
FieldIndex : Integer;
i: Integer;
KeyCount: Integer;
LocalTable : Boolean;
ParadoxTbl : Boolean;
DBaseTable : Boolean;
TempString : String;
Begin
Result := False;
If Not IsTable(DatabaseName, TableName) Then Exit;
If Not IsField(DatabaseName, TableName, FieldName) Then Exit;
{Need to check if FieldName is in the Expression listing}
If Pos(UpperCase(FieldName),UpperCase(Table.IndexDefs[i].Expression))>0 Then
Begin
Result := True;
Break;
End;
{Need to check if FieldName is in the Fields listing}
If Pos(UpperCase(FieldName),UpperCase(Table.IndexDefs[i].Fields))>0 Then
Begin
Result := True;
Break;
End;
End;
End;
End
Else
Begin
If Table.
FieldDefs[FieldIndex].
Required
Then
Begin
Result := True;
End;
End;
Except
End;
Finally
Table.Free;
End;
End;
Tablo mevcut mu?
Bu fonksiyon, belirtilen tablo varsa TRUE değerini döndürür.
Function IsTable(DatabaseName, TableName: String): Boolean;
Var
Query: TQuery;
Begin
Result := False;
Query := TQuery.Create(nil);
Try
Try
Query.DatabaseName := DatabaseName;
Query.Sql.Clear;
Query.Sql.Add('Select *');
Query.Sql.Add('From');
If (Pos('.DB', UpperCase(TableName)) > 0) Or
(Pos('.DBF',UpperCase(TableName)) > 0) Then
Begin
Query.Sql.Add('"'+TableName+'"');
End
Else
Begin
Query.Sql.Add(TableName);
End;
Query.Active := True;
Result := True;
Except
End;
Finally
Query.Free;
End;
End;
Tablo mevcut ve esas anahtarı var mı
Bu fonksiyon, belirtilen tablo, mevcutsa ve öncelikli anahtara sahipsei TRUE değerini döndürür.
Function IsTableKeyed(DatabaseName, TableName: String): Boolean;
Var
Table: TTable;
i: Integer;
IsKeyed: Boolean;
Begin
Result:= False;
IsKeyed := False;
If Not IsTable(DatabaseName, TableName) Then Exit;
Table := TTable.Create(nil);
Try
Try
Table.DatabaseName := DatabaseName;
Table.TableName:= TableName;
Table.Active:= True;
For i := 0 To Table.FieldDefs.Count-1 Do
Begin
If Table.FieldDefs[i].Required Then
Begin
IsKeyed := True;
Break;
End;
End;
If IsKeyed Then
Begin
Result := True;
End
Else
Begin
Result := False;
{Need to examine indexdefs}
If (Pos('.DB', UpperCase(TableName)) > 0) Then
Begin
{Table is either Paradox or DBase}
Table.IndexDefs.UpDate;
If (Pos('.DBF', UpperCase(TableName)) > 0) Then
Begin
{Table is a DBase Table}
If Table.IndexDefs.Count > 0 Then
Begin
Result := True;
End;
End
Else
Begin
{Table is a Paradox Table}
For i := 0 To Table.IndexDefs.Count-1 Do
Begin
If ixPrimary in Table.IndexDefs[i].Options Then
Begin
Result := True;
Break;
End;
End;
End;
End
Else
Begin
Result := False;
End;
End;
Except
End;
Finally
Table.Free;
End;
End;
Mevcut bir tablo ile aynı yapıda başka bir tablo yaratmak
Bir veri tabanı içerisinde var olan tablo ile tıpatıp aynı bir başka tablo, herhangi bir veri tabanı içerisinde yaratılabilir. "Datali" değişkenine bağlı olarak, verilerde yeni tabloya aktarılabilir.
implementation
uses DB, DBTables ;
{$R *.DFM}
function tabloaktar(SourceDB,
SourceTable,
DestDb,
DestTable:string;
datali:boolean):boolean;
var
tSource, TDest: TTable;
i:integer;
begin
TSource := TTable.create(nil);
with TSource do begin
DatabaseName := sourcedb;
TableName := Sourcetable;
open;
end;
TDest := TTable.create(nil);
with TDest do begin
DatabaseName := DestDb;
TableName := DestTable;
FieldDefs.Assign(TSource.FieldDefs);
IndexDefs.Assign(TSource.IndexDefs);
CreateTable;
end;
tdest.open;
tsource.first;
if datali then
begin
while not tsource.eof do
begin
tdest.append;
for i:=0 to tsource.fieldcount-1 do begin
tdest.fields[i].assign(tsource.fields[i]);
showmessage(tsource.fields[i].asstring)
end;
tsource.Next;
end;
end;
TSource.close;
tdest.close;
showmessage('aktarma bitti')
end;
Tablo filtreleme
Bir tablonun filterelenmesi, basit olarak filter özelliğine, seçim kriterinin yazılıp, filtered özelliğinin TRUE yapılması ile yapılır. Tablo seçim kriterine uyan kayıtları gösterir, diğerlerini göstermez.
Filtreleme işleminin, dinamik bir sorgu niteliğinde, form üzerindeki alanlar kullanılarak yapılması, daha kullanışlı olabilir. Örneğin, Oracle formlarında, sorgu moduna girildiğinde, veri alanlarının temizlenerek, sorgu parametrelerinin yazılmasına imkan vermekte ve sorgu uygula komutu ile birlikte, belirtilen kriterlere uygun sonuç kümesi getirilmektedir.
Benzer bir yapı, Delphi formlarında da kurulabilir. Bunun için takip edilecek adımlar şunlardır.
"Form üzerine,"Sorgu moduna geçiş" için kullanılacak bir buton yerleştirin.
"Butona basıldığında çalışması için, OnClick olay yordamı içerisinde verilecek
<SorgulanacakTabloAdı>.Insert
"komutu ile, veri alanlarının temizlenmesini sağlayın
"Form üzerine "Sorgu uygulama" için kullanılacak başka bir buton yerleştirip, OnClick olay yordamına,
< SorgulanacakTabloAdı >.cancel
"komutunu yazarak, arama kriteri olarak girilen değerlerin, tabloya kaydedilmemesini sağlayın. Fakat bu işlemden önce, sorgulama kriteri olarak kullanılacak alanlardaki sorgu kriterlerini değişkenlere aktararak, saklayın.
"Seçilen alanların tümü, sorgu işleminde kullanılmayabilir. Bu nedenle boş bırakılan alanların, sorgulama esnasında problem yaratmaması için, aşağıdaki fonksiyonları kullanın. Eğer, sorgulama alanı boş bırakılmışsa, bu fonksiyonlar, o alana ait her türlü değerin kabul edilmesini sağlayacaktır.
function nvlforstr(birinci:string;ikinci:string):string;
begin
if birinci=''
then result:=ikinci
else result:=birinci;
end;
function nvlforscl(birinci:string;ikinci:string):string;
begin
if birinci=' ...'
then result:=ikinci
else result:=birinci;
end;
function nvlforTEL(birinci:string;ikinci:string):string;
begin
if birinci='()'
then result:=ikinci
else result:=birinci;
end;
function nvltoyil(s1 : string) : string;
begin
if length(s1)=0 then result:='*' else result:=s1;
end;
"Filtre uygulanacak tablonun OnFilter olay yordamı parametreleri arasında bulunan ACCEPT, TRUE değerini alırsa, tablodaki o kayıt, filtreleme kriterine uygun demektir. Aksi taktirde, kayıt gösterilmeyecektir. Bu yordam aşağıdaki gibi kullanılır. Bu yordamdaki kod, tablonun her satırı için çalışarak, gereken mantıksal karşılaştırmayı yapacak ve ACCEPT parametresinin değerine göre kayıt kabul veya red edilecektir.
Paradox tablolarına da şifre konabilir. Bu durumda, kullanıcı bağlanırken, şifresini belirtmek zorundadır. Şifrenin uygulama tarafından otomatik olarak girilmesi için tablo açılmadan önce
Session.addpassword('<şifre>');
Komutu verilmelidir.
SubString fonksiyonunun SQL cümlesinde kullanılması
DBase ve Paradox veri tabanlarında sorgulama yapılırken kullanılabilecek bir fonksiyon olan SubString fonksiyonu, neredeyse hiç dökümante edilmemiştir. Bu fonksiyon, hem sorguda, hem sıralamada hem de karşılaştırma kısmında kullanılabilir. Notasyonu şu şekildedir.
Substring(<alan adı> from <Başlangıç> to <Bitiş>)
Örnek
Select substring(adi from 2 to 5) from customer
Where substring(adi from 4 to 5)='AL'
Order by substring(adi from 2 to 3)
DbControlGrid kaydırma çubukları
DbControlGrid bileşeninde, normalda sadece dikey kaydırma çubuğu vardır. Yatay kaydırma çubuğu görünmez. Eğer yatay kaydırma çubuğunun da görünmesi ve kullanılması istenirse yapılması gereken, ScrollBars özelliğinin yayınlanması ve seçime göre araç çubuklarının hazırlanmasıdır.
unit EDBcgrd;
interface
uses
Windows,
Messages,
SysUtils,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
DBCGrids,
Unit1 in '......Program FilesBorlandDelphi 3Unit1.pas' {Form1};
type scrollbartype=(sbBoth,SbNone,sbVertical,sbHorizontal);
Bir Ttable bileşeninin bağlı olduğu veri tabanı tablosundaki verilerin, Sabit kolon uzunluğunda veya, kolonlar arasına ayıraçlar koymak suretiyle metin dosyasına saklanması için geliştirilmiş bir Ttable türevi bileşene ait kod aşağıdadır.
'Kayıt Sayısı: '+inttostr(fieldcount)+' Kolon X '+inttostr(recordcount)+' Satır.'#10#13+
'İşlem tamam!');
enablecontrols;
closefile(f);
end;
end.
Sorgudan dosyaya aktarma
Tquery bileşeni kullanarak yapılan sorgu neticesinde dönen sonuç kümesinin, metin dosyasına atılması için geliştirilmiş Tquery türevi bir bileşene ait kod örneği aşağıdadır. Bu örnekte, Dene ve al sürümü, bileşen uygulamasına örnek bir yöntem de yer almaktadır.
Tarih alanlarına veri girişi herzaman problemdir. Bilgisayarların tarih formatları farklı olabileceği gibi, kullanıcıların tarih kullanma alışkanlıklarındaki farklılıklar da, veri tabanına tarih girişi işlemlerinde, hata mesajlarına sebep olur.
Aşağıdaki bileşen, DBGrid bileşeninden türetilmiş olup, Tarih alanına çift tıklandığında, otomatik olarak açılan bir takvimden seçim yapmak suretiyle bilgi girişini sağlamaktadır.
