PROGRAM BİR KEZ ÇALIŞSIN (Hatta açıksa hiç açılmasın bile)
Arkadaşlar merhabalar bilmeyen arkadaşlar için yazayım dedim, Kodbankta Programın yalnızca bir kez çalışması
ile ilgili,
CreateMutex(nil,FALSE,'PROGRAMADI');
if GetLastError = ERROR ALREADY EXISTS then
begin
ShowMessage('Program şu an çalışmakta.');
Halt(0);
end;
şeklinde kodlar var ve çok güzelde çalışıyor ancak bazı arkadaşlarımız bunun projenin kaynak kodlarına
eklenmesini söylemişler, bir arkadaşımızda kaynak kod dan çalışmayacağını bu kodun OnCreate yordamına
eklenmesi gerektiğini söylemiş. Şimdi önemli olan Evet bu kod doğru ve çok güzel çalışıyor ancak bir eksik
var o da bu kodlar kaynak koda eklenip çalıştırılabilirler sadece kaynak kodunuzdaki uses alanına
"CreateMutex" fonksiyonunu barındıran "Windows" ve "Showmessage" fonksiyonunu eklemeniz
gerekiyor. Bu şekilde açılış engellemenin en güzel tarafı eğer program açıksa daha form hafızaya alınmadan
program kapatılıyor. Eğerki bu kodu onCreate yordamına eklerseniz, program çalışır, form(lar) yüklenir ve
eğer aynı isimli çalışan program varsa program kapatılır. Umarım bilmeyen arkadaşlara yazdımcı olur...
Programın Kaynak Kodunun Son Hali:
program ABC;
uses
Forms,Windows,
Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
begin
CreateMutex(nil,FALSE,'ABC v1.0'); if GetLastError = ERROR_ALREADY_EXISTS then Halt(0); //isterseniz uyarı felan da
Application.Initialize; // gösterebilirsiniz..
Application.MainFormOnTaskbar := True;
Application.Title := 'ABC v1.0';
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Delphi - .....................................
ArSoft : Dosyayı kendi programınızla çalıştırabilirsiniz.
{
ArSoft Yazılım
Kendi dosya formatınızı yapmak istiyorsanız aşağıdaki fonksiyonu kullanabilirsiniz.
Bu fonksiyon parametre olarak gönderilen dosya adını verir. 1 olan değeri değiştirdiğinizde
dosya hakkındaki değişik bilgileri edinebilirsiniz.
Program çalışır çalışmaz çift tıklanan dosyayı açmak istiyor iseniz.
1. Dosya türlerine, istediğiniz dosya türünü yazıp birlikte açabileceğiniz yani kendi yazdığınız
programın adını ve adresini yazıp ekliyorsunuz.
2.aşağıdaki kodu programınıza ekleyin.
3. Programı çalıştırın.
4. Belirttiğiniz dosyaya çift tıklayınız.
Kolay gelsin.
}
procedure TAnaForm.FormActivate(Sender: TObject);
begin
Memo1.Lines.LoadFromFile:=paramstr(1);
end;
{
Mustafa AKDEMİR
Yazılım Uzmanı
makdemir08@hotmail.com
www.arsoft.com.tr
}
Delphi - .....................................
Ağdaki bilgisayar adlarını listeleme
{Valla tertemiz kod çok aradım iyisini bulamamıştım belki sizinde işinize yarar}
procedure EnumNetResources(List: TStrings);
procedure EnumFunc(NetResource: PNetResource);
var
Enum: THandle;
Count, BufferSize: DWORD;
Buffer: array[0..16384 div SizeOf(TNetResource)] of TNetResource;
i: Integer;
tstr: string;
begin
if WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, NetResource,
Enum) = NO_ERROR then
try
Count := $FFFFFFFF;
BufferSize := SizeOf(Buffer);
while WNetEnumResource(Enum, Count, @Buffer, BufferSize) = NO_ERROR do
for i := 0 to Count - 1 do
begin
if Buffer[i].dwDisplayType = RESOURCEDISPLAYTYPE_SERVER then
begin
tstr := Buffer[i].lpRemoteName;
delete(tstr,1,2);
List.Add(tstr);
end;
if (Buffer[i].dwUsage and RESOURCEUSAGE_CONTAINER) > 0 then
EnumFunc(@Buffer[i])
end;
finally
WNetCloseEnum(Enum);
end;
end;
begin
List.Clear;
EnumFunc(nil);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
EnumNetResources(ListBox1.Items);
end;
Delphi - .....................................
RichEdit'de Font Ayarlamaları
Seçili Kısmın Kalın olup olamamsı: //Eğer Kalın ise Normal Normal ise Kalın'a çevirir..
procedure TForm1.Button1Click(Sender: TObject);
begin
if fsBold in RichEdit1.SelAttributes.Style then
RichEdit1.SelAttributes.Style:=
RichEdit1.SelAttributes.Style-[fsBold]
else
RichEdit1.SelAttributes.Style:=
RichEdit1.SelAttributes.Style+[fsBold];
RichEdit1.SetFocus;
end;
Seçili Kısmın Yatık(İtalik) olup Olmaması: //Eğer Yatık ise Normal Normal ise Yatık'a çevirir.
procedure TForm1.Button1Click(Sender: TObject);
begin
if fsItalic in RichEdit1.SelAttributes.Style then
RichEdit1.SelAttributes.Style:=
RichEdit1.SelAttributes.Style-[fsItalic]
else
RichEdit1.SelAttributes.Style:=
RichEdit1.SelAttributes.Style+[fsItalic];
RichEdit1.SetFocus;
end;
Seçili Kısmın AltıÇizili olup Olmaması: //Eğer AltıÇizili ise Normal Normal ise AltıÇizili'ye çevirir.
procedure TForm1.Button1Click(Sender: TObject);
begin
if fsUnderline in RichEdit1.SelAttributes.Style then
RichEdit1.SelAttributes.Style:=
RichEdit1.SelAttributes.Style-[fsUnderline]
else
RichEdit1.SelAttributes.Style:=
RichEdit1.SelAttributes.Style+[fsUnderline];
RichEdit1.SetFocus;
end;
YazıTipi boyutunu Ayarlamak:
RichEdit1.SelAttributes.Size:=10; // Seçili Kısmın yazıtipi boyutunu 10 yapar
YazıTipi Rengini Ayarlamak:
RichEdit1.SelAttributes.Color:=clBlue; // Seçili Kısmın yazıtipi rengini Mavi Yapar
Delphi - .....................................
puf noktalar
//yunusnacar
1. Ek Bölüm : Delphi'de PÜF Noktaları
PÜF İNDEKSİ
2. 1. VERI TABANI - BDE (7 - 105)
1) TTABLE/TQUERY ÜZERINDE ARTTIRARAK ARAMA 7
2) PARADOX-TABLO YARATILMASI 8
3) DBMEMO IÇERIĞININ BAŞKA BIR DBMEMO BILEŞENINE AKTARILMASI 8
4) TDBNAVIGATOR BILEŞENIN, KOD IÇERISINDEN KONTROL EDILMESI 8
5) DBMEMO IÇERISINDE BIR METNIN ARANMASI 9
6) BIR TABLONUN ALAN BILGILERININ ELDE EDILMESI 14
7) TDBGRID BILEŞENI ÜZERINDE, KAYIT SIRALAMA 20
8) MEVCUT TABLODAKI KOLONLARIN ELENMESI 20
9) BIR TABLODAKI TMEMOFIELD TIPLI BIR ALAN IÇERIĞININ, TMEMO BILEŞENINE AKTARILMASI 20
10) BIR PARADOX TABLOSUNA IKINCI İNDEKS EKLENMESI 21
11) DBGRID KOLONLARI ÜZERINDE DOLAŞMA 21
12) DETAYI OLAN BIR TABLODAN KAYIT SILME 21
13) DBGRID VE MEMO ALANLAR 22
14) TABLO IÇERIĞININ TSTRINGRID BILEŞENINE DOLDURULMASI 23
15) TTABLE VEYA TQUERY ÜZERINDEN KAYIT NUMARASININ BULUNMASI 23
16) DBASE TABLOLARINDAN SILINMIŞ KAYITLARIN ATILMASI 29
17) UYGULAMA IÇERISINDEN BDE KOD ADI (ALIAS) YARATILMASI 30
18) BDE KOD ADI (ALIAS) PARAMETRELERININ ELDE EDILMESI 31
19) BIR DBASE (.DBF) TABLOSUNDAKI SILINMIŞ KAYITLARIN GÖRÜNTÜLENMESI 31
20) BIR TABLODAKI ALAN SAYISININ BULUNMASI 37
21) BIR TABLODAKI VERININ, BAŞKA BIR TABLOYA EKLENMESI 39
22) SORGUDAN TABLO YARATILMASI 40
23) SORGUDAN TABLOYA VERI AKTARIMI 41
24) TABLODAKI BIR ALANA AIT VERILERIN, BAŞKA BIR ALANA KOPYALANMASI 42
25) TABLO KOPYALAMA 44
26) TABLO SILME 49
27) ALAN ADININ BULUNMASI 50
28) ORTAK ALAN ISIMLERI 51
29) TABLODAKI ALAN ISIMLERI 53
30) ALAN NUMARASI 54
31) ALAN UZUNLUĞU 55
32) ALAN TIPLERI 56
33) TABLONUN ANAHTAR ALANLARI 59
34) LOOKUP YÖNTEMIYLE DEĞER SEÇME DIYALOĞU 60
35) BIR PARADOX TABLOSUNUN YENIDEN ANAHTARLANMASI 68
36) TABLO ADININ DEĞIŞTIRILMESI 71
37) TABLO YAPILARI AYNI MI? 74
38) BIR TABLO ALANINDAKI DEĞERLERIN SAĞ TARAFINDAKI BOŞLUKLARIN TEMIZLENMESI 75
39) ARANAN ALAN, TABLODA VAR MI? 76
40) ALAN ANAHTAR MI? 78
41) TABLO MEVCUT MU? 81
42) TABLO MEVCUT VE ESAS ANAHTARI VAR MI 82
43) MEVCUT BIR TABLO ILE AYNI YAPIDA BAŞKA BIR TABLO YARATMAK 84
44) TABLO FILTRELEME 86
45) ŞIFRELI PARADOX TABLOSUNA OTOMATIK BAĞLANTI 88
46) SUBSTRING FONKSIYONUNUN SQL CÜMLESINDE KULLANILMASI 88
47) DBCONTROLGRID KAYDIRMA ÇUBUKLARI 89
48) TABLODAN DOSYAYA AKTARMA 91
49) SORGUDAN DOSYAYA AKTARMA 94
50) ÖZEL BIR DBGRID 98
51) DBNAVIGATOR BUTONLARINA ERIŞIM 104
3. 2. AĞ IŞLEMLERI (106 - 115)
52) AĞ SÜRÜCÜLERI 106
53) AĞ DA TANIMLI KULLANICILAR KIMLER? 108
54) TANIMLI AĞ SÜRÜCÜLERI 112
4. 3. SES VE GRAFIK IŞLEMLERI (114 - 159)
55) FARKLI ÇIZGILER 115
56) STRINGGRID IÇERISINDE BMP 116
57) TONLAMALI(GRADIENT) FORM 119
58) EKRAN YAKALAMA 120
59) BIR RESMI, BMP FORMATINDAN JPEG FORMATINA ÇEVIRME 121
60) DUVAR KAĞIDI DEĞIŞTIRME 121
61) SISTEMIN KULLANABILECEĞI RENK SAYISININ BULUNMASI 122
62) DBGRID ALANLARININ RENKLENDIRILMESI 122
63) LISTBOX BILEŞENLERINDE RENKLI SATIRLAR 123
64) RENK PALETLERININ YARATILMASI VE KULLANIMI 124
65) MÜZIK CD SI ÇALINIRKEN, TRACK SAYISININ OKUNMASI 128
66) EKRAN ÇÖZÜNÜRLÜĞÜ DEĞIŞTIRME 130
67) BMP RESMININ PANOYA YAPIŞTIRILMASI VE PANODAN KOPYALAMASI 135
68) BIR EXE DEN IKONUN ALINIP BAŞKA BIR YERE ÇIZILMESI 138
69) İKON RESMININ, BUTON ÜZERINDE KULLANILMASI 139
70) GRAFIK ÇIZME IŞLEMI 142
71) HAREKETLI GRAFIK ÇIZIMI 143
72) PANOYA RESIM KOPYALAMA 146
73) BIR REMIN ŞEFFAF OLARAK BAŞKA BIR RESIM ÜZERINE YAPIŞTIRILMASI 147
74) PALET DEĞIŞTIRME 153
75) PANODAKI METNIN DISKTEKI BIR DOSYAYA KAYDEDILMESI 158
5. 4. FORM VE PENCERE IŞLEMLERI (160 - 186)
76) MASA ÜSTÜNDEKI IKONLARIN SAKLANMASI 161
77) BÜTÜN AÇIK PENCERELERIN LISTELENMESI 165
78) FARKLI BIR PENCERE 166
79) ÜZERINE BIRAKILAN DOSYALARA DUYARLI FORM 167
80) FORM BAŞLIĞININ SAKLANMASI 169
81) STANDART DIŞI FORMLAR 169
82) FORM POZÜSYONU 173
83) EKRAN ÇÖZÜNÜRLÜĞÜ 174
84) FORM BAŞLIK ALANI ÜZERINDE SAAT GÖSTERILMESI 176
85) FORM BAŞLIĞININ GIZLENMESI 177
86) FORMUN BAŞLIK ALANINA BUTON YERLEŞTIRME 180
87) AÇILIR-KAPANIR FORM 184
88) PENCERENIN TAŞINMASI 186
6. 5. DISK VE DOSYA IŞLEMLERI (186 - 212)
89) SÜRÜCÜ LISTESI 186
90) DISKET SÜRÜCÜSÜNDE DISKET TAKILI MI ? 188
91) ÇALIŞAN UYGULAMANIN BULUNDUĞU DIZIN 188
92) WINDOWS'UN STANDART "BROWSEFOLDER" DIYALOG PENCERESININ KULLANILMASI 189
93) BIR DIZINDEKI DOSYALARIN VE ALT DIZINLERIN TÜMÜNÜN SILINMESI 191
94) DOSYA KOPYALAMA 192
95) İKILI DOSYADAN OKUMA 194
96) BIR DOSYANIN SALT OKUNUR OLARAK AÇILMASI 194
97) SATIR SONU KARAKTERININ ASCII KODU NEDIR? 194
98) DISK SERI NUMARASI VE ETIKETININ OKUNMASI 194
99) DOSYANIN SÜRÜKLENIP BIRAKILMASI 203
100) WINDOWS GEÇICI KLASÖRÜNÜN BULUNMASI 205
101) WINDOWS SISTEM DIZINININ BULUNMASI 206
102) DOSYA YARATILMA TARIHI 206
103) DOSYANIN SON KULLANILDIĞI TARIH 207
104) DOSYANIN SON DEĞIŞTIRILDIĞI TARIH 208
105) DIZIN BOŞ MU? 208
106) DOSYA UZANTISI HANGI PROGRAMLA BAĞLANTILI? 209
107) GERI DÖNÜŞÜM KUTUSUNA GÖNDER 211
7. 6. GENEL (213 - 323)
108) KARAKTER DIZISI KARŞILAŞTIRMA 213
109) YÜKLENMIŞ DLL DOSYALARININ HAFIZADAN ATILMASI 215
110) BIR DOS KOMUTUNUN KULLANILMASI 216
111) TEDIT METNININ, ONCHANGE OLAYINDA DEĞIŞTIRILMESI 218
112) TMEMO BILEŞENINDE, IMLEÇ HANGI SATIRDA? 218
113) ULUSAL AYARLAR 218
114) TEDITBOX BILEŞENINDEKI METNIN ILK KARAKTERININ, BÜYÜK HARFE ÇEVIRILMESI 219
115) WINDOWS'UN KAPANMA ANININ TESPITI 219
116) BIR MEMO VEYA RICHEDIT BILEŞENINDE, IMLECIN ISTENEN YERE GÖNDERILMESI 223
117) WINDOWS ÇEVIRMELI AĞ BAĞLANTI PENCERESININ ÇAĞIRILMASI 223
118) OTOMATIK E-MAIL 223
119) MONITÖRÜN KAPATILMASI/AÇILMASI 223
120) WINDOWS'UN KAPATILMASI/YENIDEN BAŞLATILMASI 224
121) SISTEMDE SES KARTI VAR MI? 224
122) PROGRAMIN ARKA PLANDA ÇALIŞTIRILMASI 225
123) WINDOWS GÖREV ÇUBUĞUNUN GIZLENMESI/GÖSTERILMESI 228
124) ÇALIŞAN PROGRAMIN, GÖREV ÇUBUĞU ÜZERINDEN KALDIRILMASI 228
125) OCX'KULLANIMI 229
126) EKRAN ÇÖZÜNÜRLÜĞÜNDEKI DEĞIŞIKLIKLERIN TESPITI 231
127) PANO GÖRÜNTÜLEME 232
128) CPU BILGILERI 234
129) ENTER TUŞUNUN TAB YERINE KULLANILABILECEĞI BIR TEDIT BILEŞENI 251
130) TARIH DOĞRU MU 254
131) AYDA KAÇ GÜN VAR? 254
132) GEÇEN HAFTANIN ILK GÜNÜ 255
133) SONRAKI AYIN ILK GÜNÜ 255
134) SONRAKI HAFTANIN ILK GÜNÜ 255
135) HAFTANIN ILK GÜNÜ 256
136) AYIN SON GÜNÜ 256
137) AY 256
138) GELECEK AY 257
139) GEÇEN AY 257
140) GÜN SONRA 258
141) GELECEK AY 258
142) ÖNCEKI GÜN 258
143) GEÇEN HAFTA 259
144) METIN IÇERISINDEN BIR KARAKTER SILME 259
145) METIN IÇERISINDEN, BIR KARAKTERI DEĞIŞTIRME 259
146) BIR METNI BELLI BIR UZUNLUĞA TAMAMLAMA 260
147) METIN DEĞIŞTIRME 262
148) PROGRAM IÇERISINDEN, BAŞKA BIR UYGULAMAYA TUŞ GÖNDERME 263
149) PROGRAMI DENEME SÜRÜMÜ HALINE GETIRME 263
150) LISTBOX BILEŞENINE YATAY KAYDIRMA ÇUBUĞU EKLENMESI 264
151) KONTROL PANEL APPLETLERININ DELPHI IÇERISINDEN KULLANILMASI 265
152) SISTEM TARIH/SAAT AYARININ DEĞIŞTIRILMESI 266
153) EKRAN KORUYUCUNUN DEVREDEN ÇIKARILMASI 268
154) PROGRAMIN, WINDOWSUN BAŞLANGICINDA ÇALIŞTIRILMASI 269
155) HATA MESAJI KONTROLÜ 270
156) EKRAN KORUYUCU KURULMASI 271
157) LISTBOX YAZI TIPININ DEĞIŞTIRILMESI 271
158) TAŞINABILIR PANEL 271
159) CD-ROM KAPAĞININ KAPATILMASI 272
160) ÇALIŞMA ESNASINDA, BILEŞEN SAYISININ KONTROLÜ 273
161) FARE IMLECININ, ISTENEN KONTROL ÜZERINE GETIRILMESI 274
162) ALT-? TUŞ KOMBINASYONU 274
163) PROGRAMIN DURAKLATILMASI 276
164) YAZI KARAKTERI STILININ DEĞIŞTIRILMESI 277
165) MEVCUT BIR DAVRANIŞIN DEĞIŞTIRILMESI 277
166) KES, KOPYALA, YAPŞTIR 278
167) FARE IMLECININ, PENCERE ÜZERINDE OLUP OLMADIĞININ KONTROLÜ 278
168) GETKEYBOARDSTATE 279
169) OLAY YAKALAMA YORDAMLARININ DINAMIK OLARAK ATANMASI 280
170) SENDER PARAMETRESININ KULLANILMASI 281
171) BÜYÜK METINLERIN PANODAN ALINMASI 281
172) WINDOWS SÜRÜM NUMARASININ OKUNMASI 282
173) PROGRAM GURUPLARININ LISTBOX BILEŞENINE DOLDURULMASI 282
174) TLISTBOX VE TCOMBOBOX BILEŞENLERI IÇERISINE RESIM YERLEŞTIRILMESI 286
175) BASIT BIR DLL ŞABLONU 291
176) İPUCU PENCEREININ ÖZELLEŞTIRILMESI 292
177) DIZI SABITI TANIMI 293
178) STRINGRID BILEŞENI IÇERISINDEKI METNIN HIZALAMASI 293
179) TSTRINGGRID BILEŞENINDEN BIR SATIRIN SILINMESI 294
180) TSTRINGGRID SATIRININ EN ALTA GÖNDERILMESI 295
181) SISTEMDE TANIMLI YAZICILARIN LISTELENMESI 295
182) YAZDIRMA 296
183) ISTENEN YAZICININ SEÇIMI 296
184) YAZICI YAZI TIPLERI 297
185) HEX->DEC 297
186) HAFIZA MIKTARI 298
187) FARE HAREKET ALANININ KISITLANMASI 299
188) PGUP VE PGDOWN TUŞLARI ILE FORMU AŞAĞI YUKARI KAYDIRMA 301
189) ÖZEL YAZI KARAKTERI 302
190) EKRAN KORUYUCU 304
191) BIR NESNEDEKI ÖZELLIKLERIN LISTESI 310
192) HABERLEŞME PORTLARINA ERIŞIM 310
193) BILEŞEN ÖZELLIKLERININ KAYIT DEFTERINDE SAKLANMASI 311
194) LISTBOX IÇERISINDE ARTAN ARAMA 317
195) SISTEM MENÜSÜNÜN GELIŞTIRILMESI 318
196) BIR TEDIT.TEXT BILGISINDEKI DEĞIŞIKLIĞIN FARKEDILMESI 320
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.
with TTable.create(self) do begin
DatabaseName := 'C:temp';
TableName := 'FOO';
TableType := ttParadox;
with FieldDefs do Begin
Add('Age', ftInteger, 0, True);
Add('Name', ftString, 25, False);
Add('Weight', ftFloat, 0, False);
End;
IndexDefs.Add('MainIndex','IntField', [ixPrimary, ixUnique]);
CreateTable;
End;
DBMemo içeriğinin başka bir DBMemo bileşenine aktarılması
DBMemo6.Lines:=DBMemo5.Lines.Assign;
TDBNavigator bileşenin, kod içerisinden kontrol edilmesi
procedure TForm1.DBNavigator1Click(Sender: TObject; Button: TNavigateBtn);
var
BtnName: string;
begin
case Button of
nbFirst : BtnName := 'nbFirst';
nbPrior : BtnName := 'nbPrior';
nbNext : BtnName := 'nbNext';
nbLast : BtnName := 'nbLast';
nbInsert : BtnName := 'nbInsert';
nbDelete : BtnName := 'nbDelete';
nbEdit : BtnName := 'nbEdit';
nbPost : BtnName := 'nbPost';
nbCancel : BtnName := 'nbCancel';
nbRefresh: BtnName := 'nbRefresh';
end;
MessageDlg(BtnName + ' button clicked.', mtInformation, [mbOK], 0);
end;
DBMemo içerisinde bir metnin aranması
procedure Tform1.FindDialog1Find(Sender: TObject);
var Buff, P, FT : PChar;
BuffLen : Word;
begin
With Sender as TFindDialog do
begin
GetMem(FT, Length(FindText) + 1);
StrPCopy(FT, FindText);
BuffLen:= DBMemo1.GetTextLen + 1;
GetMem(Buff,BuffLen);
DBMemo1.GetTextBuf(Buff,BuffLen);
P:= Buff + DBMemo1.SelStart + DBMemo1.SelLength;
P:= StrPos(P, FT);
if P = NIL then MessageBeep(0)
else
begin
DBMemo1.SelStart:= P - Buff;
DBMemo1.SelLength:= Length(FindText);
end;
FreeMem(FT, Length(FindText) + 1);
FreeMem(Buff,BuffLen);
DBMemo1.SetFocus;
end;
end;
Şekil 1 : Form1
kod örneği 1 : form1.dfm
object Form1: TForm1
Left = 200
Top = 108
Width = 696
Height = 445
Caption = 'Form1'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
PixelsPerInch = 96
TextHeight = 13
object DBMemo1: TDBMemo
Left = 16
Top = 152
Width = 657
Height = 193
DataField = 'Notes'
DataSource = DataSource1
TabOrder = 0
OnDblClick = DBMemo1DblClick
end
object DBGrid1: TDBGrid
Left = 16
Top = 16
Width = 657
Height = 120
DataSource = DataSource1
TabOrder = 1
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
end
object DBNavigator1: TDBNavigator
Left = 432
Top = 352
Width = 240
Height = 25
TabOrder = 2
end
object DataSource1: TDataSource
DataSet = Table1
Left = 138
Top = 364
end
object Table1: TTable
Active = True
DatabaseName = 'dbdemos'
TableName = 'BIOLIFE.DB'
Left = 220
Top = 366
end
object FindDialog1: TFindDialog
OnFind = FindDialog1Find
Left = 40
Top = 360
end
end
kod örneği 2 : unit1.pas
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls, Grids, DBGrids, Db, DBTables, DBCtrls, ExtCtrls;
type
TForm1 = class(TForm)
DBMemo1: TDBMemo;
DataSource1: TDataSource;
Table1: TTable;
DBGrid1: TDBGrid;
FindDialog1: TFindDialog;
DBNavigator1: TDBNavigator;
procedure FindDialog1Find(Sender: TObject);
procedure DBMemo1DblClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure Tform1.FindDialog1Find(Sender: TObject);
var Buff, P, FT : PChar;
BuffLen : Word;
begin
With Sender as TFindDialog do
begin
GetMem(FT, Length(FindText) + 1);
StrPCopy(FT, FindText);
BuffLen:= DBMemo1.GetTextLen + 1;
GetMem(Buff,BuffLen);
DBMemo1.GetTextBuf(Buff,BuffLen);
P:= Buff + DBMemo1.SelStart + DBMemo1.SelLength;
P:= StrPos(P, FT);
if P = NIL then MessageBeep(0)
else
begin
DBMemo1.SelStart:= P - Buff;
DBMemo1.SelLength:= Length(FindText);
end;
FreeMem(FT, Length(FindText) + 1);
FreeMem(Buff,BuffLen);
DBMemo1.SetFocus;
end;
end;
procedure TForm1.DBMemo1DblClick(Sender: TObject);
begin
finddialog1.execute;
end;
end.
Bir tablonun alan bilgilerinin elde edilmesi
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.
Şekil 2 : form1
kod örneği 3 : form1.dfm
object Form1: TForm1
Left = 200
Top = 108
Width = 425
Height = 340
Caption = 'Form1'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 16
Top = 136
Width = 43
Height = 13
Caption = 'İndeksler'
end
object Label2: TLabel
Left = 16
Top = 0
Width = 32
Height = 13
Caption = 'Alanlar'
end
object Label3: TLabel
Left = 232
Top = 0
Width = 122
Height = 13
Caption = 'Alan isimleri ve uzunlukları'
end
object Memo1: TMemo
Left = 232
Top = 16
Width = 169
Height = 249
Lines.Strings = (
'Memo1')
TabOrder = 0
end
object Button1: TButton
Left = 240
Top = 272
Width = 153
Height = 25
Caption = 'Alan isimleri ve uzunlukları'
TabOrder = 1
OnClick = Button1Click
end
object Button2: TButton
Left = 16
Top = 272
Width = 201
Height = 25
Caption = 'Alan ve İndeks isimleri '
TabOrder = 2
OnClick = Button2Click
end
object ListBox1: TListBox
Left = 16
Top = 16
Width = 201
Height = 113
ItemHeight = 13
TabOrder = 3
end
object ListBox2: TListBox
Left = 16
Top = 152
Width = 201
Height = 113
ItemHeight = 13
TabOrder = 4
end
object Table1: TTable
DatabaseName = 'dbdemos'
TableName = 'ANIMALS.DBF'
Left = 104
Top = 72
end
kod örneği 4 : unit1.pas
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls, Db, DBTables;
type
TForm1 = class(TForm)
Memo1: TMemo;
Table1: TTable;
Button1: TButton;
Button2: TButton;
ListBox1: TListBox;
ListBox2: TListBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure ShowFields;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.ShowFields;
var
i : Word;
begin
Memo1.Lines.Clear;
Table1.FieldDefs.Update;
for i := 0 to Table1.FieldDefs.Count - 1 do
With Table1.FieldDefs.Items[i] do
Memo1.Lines.Add(Name + ' - ' + IntToStr(Size));
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
showfields;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
If Table1.State = dsInactive then Table1.Open;
Table1.GetFieldNames(listbox1.items);
Table1.GetIndexNames(listbox2.items);
end;
end.
TDBGrid bileşeni üzerinde, kayıt sıralama
Eğer bir Interbase tablosu ile çalışılıyor ise, Dbgrid üzerinde seçilen kolon başlığına göre verilerin sıralanması mümkündür.
procedure TForm1.DBGrid1CellClick(Column: TColumn);
begin
if checkbox1.checked then
with dbgrid1.datasource.dataset as ttable do
indexfieldnames:=column.field.fieldname;
end;
Mevcut tablodaki kolonların elenmesi
Bir tablodaki alanların "Visible" özelliğine "False" değeri verilerek, istenmeyen alanların görüntülenmesi engellenir.
Table1.FieldByName(<saklanacak alanb adı>).Visible := False;
veya
Table1.Field[<saklanacak alan no>].Visible := false;
Bir tablodaki TMemoField tipli bir alan içeriğinin, TMemo bileşenine aktarılması
Procedure TMemoToTMemoField;
begin
TMemoField.Assign( TMemo.Lines );
end;
Procedure TMemoFieldToTMemo;
VAR aBlobStream : TBlobStream;
Begin
aBlobStream := TBlobStream.Create(tblobfield(table1.fieldbyname('Notes')), bmRead);
Memo1.Lines.LoadFromStream( aBlobStream );
aBlobStream.Free;
end;
Bir Paradox tablosuna ikinci İndeks eklenmesi
Table1.AddIndex('<indeks adı>', 'CustNo;CustName', [ixDescending]);
DBGrid kolonları üzerinde dolaşma
dbgrid1.selectedindex:=dbgrid1.selectedindex+1;
dbgrid1.setfocus;
Detayı olan bir tablodan kayıt silme
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.
procedure TForm1.Table1BeforeDelete(DataSet: TDataset)
begin
with Table2 do begin
DisableControls;
First;
While not EOF do
Delete;
EnableControls;
end;
end;
DBGrid ve Memo alanlar
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;
DisplayText: Boolean);
begin
Text := Blob2Str(TMemoField(Sender));
end;
Blob2Str fonksiyonu:
function Blob2Str(TheField : TMemoField): String;
var
Buffer: PChar;
MemSize: Integer;
tmp:string;
begin
if TheField.IsNull then
Result := '' else
with TBlobStream.Create(TheField, bmRead) do
begin
MemSize := Size;
Inc(MemSize); Buffer := AllocMem(MemSize);
Read(Buffer^, memsize);
Free;
end;
result:=strpas(buffer);
end;
Tablo içeriğinin TstrinGrid bileşenine doldurulması
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.
uses
DbiProcs, DbiTypes, DBConsts;
function Form1.Recno( oTable: TTable ): Longint;
var
rError: DBIResult;
rRecProp: RECprops;
szErrMsg: DBIMSG;
begin
Result := 0;
try
oTable.UpdateCursorPos;
rError := DbiGetRecord( oTable.Handle, dbiNOLOCK, nil, @rRecProp );
if rError = DBIERR_NONE then
Result := rRecProp.iPhyRecNum
else
case rError of
DBIERR_BOF: Result := 1;
DBIERR_EOF: Result := oTable.RecordCount + 1;
else
begin
DbiGetErrorString( rError, szErrMsg );
ShowMessage( StrPas( szErrMsg ));
end;
end;
except
on E: EDBEngineError do ShowMessage( E.Message );
end;
end;
Şekil 3 : Form1
kod örneği 5 : form1.dfm
object Form1: TForm1
Left = 200
Top = 108
Width = 451
Height = 250
Caption = 'Form1'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 112
Top = 16
Width = 32
Height = 13
Caption = 'Label1'
end
object Label2: TLabel
Left = 32
Top = 16
Width = 49
Height = 13
Caption = 'Kayıt No : '
end
object DBGrid1: TDBGrid
Left = 16
Top = 32
Width = 417
Height = 120
DataSource = DataSource1
TabOrder = 0
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
end
object DBNavigator1: TDBNavigator
Left = 192
Top = 168
Width = 240
Height = 25
DataSource = DataSource1
TabOrder = 1
end
object DataSource1: TDataSource
DataSet = Table1
Left = 88
Top = 168
end
object Table1: TTable
Active = True
AfterScroll = Table1AfterScroll
DatabaseName = 'dbdemos'
TableName = 'ANIMALS.DBF'
Left = 16
Top = 168
end
end
kod örneği 6 : unit1.pas
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls, ExtCtrls, DBCtrls, Grids, DBGrids, Db, DBTables;
type
TForm1 = class(TForm)
DataSource1: TDataSource;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
Label1: TLabel;
Label2: TLabel;
Table1: TTable;
function Recno( oTable: Ttable): Longint;
procedure Table1AfterScroll(DataSet: TDataSet);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
DbiProcs, DbiTypes, DBConsts;
{$R *.DFM}
function TForm1.Recno( oTable: Ttable): Longint;
var
rError: DBIResult;
rRecProp: RECprops;
szErrMsg: DBIMSG;
begin
Result := 0;
try
oTable.UpdateCursorPos;
rError := DbiGetRecord( oTable.Handle, dbiNOLOCK, nil, @rRecProp );
if rError = DBIERR_NONE then
Result := rRecProp.iPhyRecNum
else
case rError of
DBIERR_BOF: Result := 1;
DBIERR_EOF: Result := oTable.RecordCount + 1;
else
begin
DbiGetErrorString( rError, szErrMsg );
ShowMessage( StrPas( szErrMsg ));
end;
end;
except
on E: EDBEngineError do ShowMessage( E.Message );
end;
end;
procedure TForm1.Table1AfterScroll(DataSet: TDataSet);
begin
label1.caption:=inttostr(recno(table1));
end;
end.
dBase tablolarından silinmiş kayıtların atılması
Bu işlem için DbiPackTable. İsimli BDE fonksiyonu kullanılır.
Örnek kod şu şekildedir.
uses
DbiProcs, DbiTypes, DBConsts;
procedure TForm1.Button1Click(Sender: TObject);
var
Error: DbiResult;
ErrorMsg: String;
Special: DBIMSG;
begin
table1.Active := False;
try
Table1.Exclusive := True;
Table1.Active := True;
Error := DbiPackTable(Table1.DBHandle, Table1.Handle, nil, szdBASE, True);
Table1.Active := False;
Table1.Exclusive := False;
finally
Table1.Active := True;
end;
case Error of
DBIERR_NONE:
ErrorMsg := 'Tamam';
DBIERR_INVALIDPARAM:
ErrorMsg := 'Tablo belirsiz' +
'name is NULL';
DBIERR_INVALIDHNDL:
ErrorMsg := 'Veri tabanı belirsiz';
DBIERR_NOSUCHTABLE:
ErrorMsg := 'Tablo adı belirsiz';
DBIERR_UNKNOWNTBLTYPE:
ErrorMsg := 'Tablo tipi belirsiz';
DBIERR_NEEDEXCLACCESS:
ErrorMsg := 'Tablo exclusive modda değil';
else
DbiGetErrorString(Error, Special);
ErrorMsg := '[' + IntToStr(Error) + ']: ' + Special;
end;
MessageDlg(ErrorMsg, mtWarning, [mbOk], 0);
end;
Uygulama içerisinden BDE Kod Adı (Alias) yaratılması
procedure createalias(aliasname, servername, servertype, filename:string);
var
List: TStringList;
lang,
user,
pdox : string;
begin
lang:='ANTURK';
user:='SYSDBA';
pdox:='PARADOX';
List := TStringList.Create;
with List do
begin
Clear;
if servertype='INTRBASE' then
begin
Add(Format('SERVER NAME=%s',[filename]));
Add(Format('LANGDRIVER=%s',[lang]));
Add(Format('USER NAME=%s',[user]));
end;
if servertype='STANDART' then
begin
Add(Format('DEFAULT DRIVER=%s',[pdox]));
Add(Format('PATH=%s',[filename]));
end;
end;
if session.isalias(aliasname) then
Session.ModifyAlias(aliasname, List)
else
Session.addAlias(aliasname,servertype, List);
Session.SaveConfigFile;
List.Free;
end;
BDE Koad adı (alias) parametrelerinin elde edilmesi
Session.GetAliasParams('DBDEMOS',listbox1.items);
Bir dBase (.DBF) tablosundaki silinmiş kayıtların görüntülenmesi
dBase tablolarındaki silinmiş kayıtların görünür hale getirilmesi için DbiSetProp fonksiyonu kullanılır.
procedure SetDelete(oTable:TTable; Value: Boolean);
var
rslt: DBIResult;
szErrMsg: DBIMSG;
begin
try
oTable.DisableControls;
try
rslt := DbiSetProp(hDBIObj(oTable.Handle), curSOFTDELETEON,
LongInt(Value));
if rslt <> DBIERR_NONE then
begin
DbiGetErrorString(rslt, szErrMsg);
raise Exception.Create(StrPas(szErrMsg));
end;
except
on E: EDBEngineError do ShowMessage(E.Message);
on E: Exception do ShowMessage(E.Message);
end;
finally
oTable.Refresh;
oTable.EnableControls;
end;
end;
Şekil 4 : Örnek uygulama form yapısı
kod örneği 7: Form1.dfm
object Form1: TForm1
Left = 200
Top = 108
Width = 559
Height = 293
Caption = 'Form1'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
PixelsPerInch = 96
TextHeight = 13
object DBGrid1: TDBGrid
Left = 8
Top = 8
Width = 409
Height = 177
DataSource = DataSource1
TabOrder = 0
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
end
object DBNavigator1: TDBNavigator
Left = 8
Top = 200
Width = 240
Height = 25
DataSource = DataSource1
TabOrder = 1
end
object Button1: TButton
Left = 432
Top = 8
Width = 113
Height = 25
Caption = 'Silinenleri göster'
TabOrder = 2
OnClick = Button1Click
end
object Button2: TButton
Left = 432
Top = 40
Width = 113
Height = 25
Caption = 'Silinenleri sakla'
TabOrder = 3
OnClick = Button2Click
end
object Table1: TTable
Active = True
DatabaseName = 'dbdemos'
TableName = 'ANIMALS.DBF'
Left = 440
Top = 80
end
object DataSource1: TDataSource
DataSet = Table1
Left = 488
Top = 80
end
end
kod örneği 8 : unit1.pas
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, DBCtrls, Grids, DBGrids, Db, DBTables;
type
TForm1 = class(TForm)
Table1: TTable;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
DbiProcs, DbiTypes, DBConsts;
{$R *.DFM}
procedure SetDelete(oTable:TTable; Value: Boolean);
var
rslt: DBIResult;
szErrMsg: DBIMSG;
begin
try
oTable.DisableControls;
try
rslt := DbiSetProp(hDBIObj(oTable.Handle), curSOFTDELETEON,
LongInt(Value));
if rslt <> DBIERR_NONE then
begin
DbiGetErrorString(rslt, szErrMsg);
raise Exception.Create(StrPas(szErrMsg));
end;
except
on E: EDBEngineError do ShowMessage(E.Message);
on E: Exception do ShowMessage(E.Message);
end;
finally
oTable.Refresh;
oTable.EnableControls;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SetDelete(Table1, TRUE);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
SetDelete(Table1, False);
end;
end.
Bir tablodaki alan sayısının bulunması
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.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Db, DBTables,
DbiErrs, DbiTypes, DbiProcs ,bde;
type
TForm1 = class(TForm)
{
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;
