Verilen bir kredi karti numarasi'nin gecerli olup olmadiginin kontrolü
*************************
Verilen bir kredi karti numarasi'nin gecerli olup olmadiginin kontrolü
{-------------------------------------------------
Credit card validator
Returns:
0 : Card is invalid or unknown
1 : Card is a valid AmEx
2 : Card is a valid Visa
3 : Card is a valid MasterCard
-------------------------------------------------}
function Vc(c: string): integer;
var
card: string[21];
Vcard: array[0..21] of byte absolute card;
Xcard: integer;
Cstr: string[21];
y, x: integer;
begin
Cstr := ";
fillchar(Vcard, 22, #0);
card := c;
for x := 1 to 20 do
if (Vcard[x] in [48..57]) then
Cstr := Cstr + chr(Vcard[x]);
card := ";
card := Cstr;
Xcard := 0;
if not odd(length(card)) then
for x := (length(card) - 1) downto 1 do
begin
if odd(x) then
y := ((Vcard[x] - 48) * 2)
else
y := (Vcard[x] - 48);
if (y >= 10) then
y := ((y - 10) + 1);
Xcard := (Xcard + y)
end
else
for x := (length(card) - 1) downto 1 do
begin
if odd(x) then
y := (Vcard[x] - 48)
else
y := ((Vcard[x] - 48) * 2);
if (y >= 10) then
y := ((y - 10) + 1);
Xcard := (Xcard + y)
end;
x := (10 - (Xcard mod 10));
if (x = 10) then
x := 0;
if (x = (Vcard[length(card)] - 48)) then
Vc := ord(Cstr[1])-ord('2')
else
Vc := 0
end;
****************************
Delphi - .....................................
Verilen bir kredi karti numarasi'nin gecerli olup olmadiginin kontrolü
*************************
Verilen bir kredi karti numarasi'nin gecerli olup olmadiginin kontrolü
{-------------------------------------------------
Credit card validator
Returns:
0 : Card is invalid or unknown
1 : Card is a valid AmEx
2 : Card is a valid Visa
3 : Card is a valid MasterCard
-------------------------------------------------}
function Vc(c: string): integer;
var
card: string[21];
Vcard: array[0..21] of byte absolute card;
Xcard: integer;
Cstr: string[21];
y, x: integer;
begin
Cstr := ";
fillchar(Vcard, 22, #0);
card := c;
for x := 1 to 20 do
if (Vcard[x] in [48..57]) then
Cstr := Cstr + chr(Vcard[x]);
card := ";
card := Cstr;
Xcard := 0;
if not odd(length(card)) then
for x := (length(card) - 1) downto 1 do
begin
if odd(x) then
y := ((Vcard[x] - 48) * 2)
else
y := (Vcard[x] - 48);
if (y >= 10) then
y := ((y - 10) + 1);
Xcard := (Xcard + y)
end
else
for x := (length(card) - 1) downto 1 do
begin
if odd(x) then
y := (Vcard[x] - 48)
else
y := ((Vcard[x] - 48) * 2);
if (y >= 10) then
y := ((y - 10) + 1);
Xcard := (Xcard + y)
end;
x := (10 - (Xcard mod 10));
if (x = 10) then
x := 0;
if (x = (Vcard[length(card)] - 48)) then
Vc := ord(Cstr[1])-ord('2')
else
Vc := 0
end;
****************************
Delphi - .....................................
Programdan windows wallpaper'i degistirme islemi
Programdan windows wallpaper'i degistirme islemi
procedure TForm1.ChangeWallPaper(const FileName: string);
begin
SystemParametersInfoA(SPI_SETDESKWALLPAPER, 0,
PChar(FileName), SPIF_UPDATEINIFILE);
end;
Delphi - .....................................
Programdan windows wallpaper'i degistirme islemi
Programdan windows wallpaper'i degistirme islemi
procedure TForm1.ChangeWallPaper(const FileName: string);
begin
SystemParametersInfoA(SPI_SETDESKWALLPAPER, 0,
PChar(FileName), SPIF_UPDATEINIFILE);
end;
Delphi - .....................................
Bir Popup menüyü kod ile gösterme
Bir Popup menüyü kod ile gösterme
PopupMenu1.Popup(Form1.Left+60,Form1.Top+140);
Delphi - .....................................
Bir Popup menüyü kod ile gösterme
Bir Popup menüyü kod ile gösterme
PopupMenu1.Popup(Form1.Left+60,Form1.Top+140);
Delphi - .....................................
Edit'e sadece sayı girilsin
Edit'e sadece sayı girilsin
Bir edit'e sadece istediğiniz karakterlerin girilmesini sağlayabilirsiniz.
Bunun için Edit'in OnKeyPress olayına aşağıdaki kodu yazın.
if not (key in ['0'..'9',#8]) then
begin
Key:=#0; //girilen karakter rakam veya backspace değilse null(#0)'a dönüştür
Beep; //bip sesi ile kullanıcıyı uyar.
end;
NOT:Kullanıcı Edit'e rakamların dışında karakter giremez, ancak Paste ile Edit'e bir
metni kopyalayabilir. Bunuda Edit'in OnExit olayında kontrol edip, girilen değerin
istediğiniz şekilde olup olmadığını kontrol edebilirsiniz.
Delphi - .....................................
Edit'e sadece sayı girilsin
Edit'e sadece sayı girilsin
Bir edit'e sadece istediğiniz karakterlerin girilmesini sağlayabilirsiniz.
Bunun için Edit'in OnKeyPress olayına aşağıdaki kodu yazın.
if not (key in ['0'..'9',#8]) then
begin
Key:=#0; //girilen karakter rakam veya backspace değilse null(#0)'a dönüştür
Beep; //bip sesi ile kullanıcıyı uyar.
end;
NOT:Kullanıcı Edit'e rakamların dışında karakter giremez, ancak Paste ile Edit'e bir
metni kopyalayabilir. Bunuda Edit'in OnExit olayında kontrol edip, girilen değerin
istediğiniz şekilde olup olmadığını kontrol edebilirsiniz.
Delphi - .....................................
Edit'e girilen metnin ilk harfini büyük harf yapma
Edit'e girilen metnin ilk harfini büyük harf yapma
Bunun için Edit'in OnKeyPress olayına aşağıdaki kodu ekleyin.
with Sender as TEdit do
if (SelStart = 0) or
(Text[SelStart] = ' ') then
if Key in ['a'..'z'] then
Key := UpCase(Key);
Delphi - .....................................
Edit'e girilen metnin ilk harfini büyük harf yapma
Edit'e girilen metnin ilk harfini büyük harf yapma
Bunun için Edit'in OnKeyPress olayına aşağıdaki kodu ekleyin.
with Sender as TEdit do
if (SelStart = 0) or
(Text[SelStart] = ' ') then
if Key in ['a'..'z'] then
Key := UpCase(Key);
Delphi - .....................................
Form'un arka kısmına bir resmi döşemek
Form'un arka kısmına bir resmi döşemek
Bitmap: TBitmap;
procedure TForm1.FormCreate(Sender: TObject);
begin
Bitmap := TBitmap.Create;
Bitmap.LoadFromFile('C:WINDOWScars.BMP');
end; procedure TForm1.FormPaint(Sender: TObject); var X, Y, W, H: LongInt;
begin with Bitmap do begin W := Width; H := Height; end;
Y := 0; while Y < Height do begin X := 0;
while X < Width do begin Canvas.Draw(X, Y, Bitmap); Inc(X, W); end; Inc(Y, H); end; end;
Delphi - .....................................
Form'un arka kısmına bir resmi döşemek
Form'un arka kısmına bir resmi döşemek
Bitmap: TBitmap;
procedure TForm1.FormCreate(Sender: TObject);
begin
Bitmap := TBitmap.Create;
Bitmap.LoadFromFile('C:WINDOWScars.BMP');
end; procedure TForm1.FormPaint(Sender: TObject); var X, Y, W, H: LongInt;
begin with Bitmap do begin W := Width; H := Height; end;
Y := 0; while Y < Height do begin X := 0;
while X < Width do begin Canvas.Draw(X, Y, Bitmap); Inc(X, W); end; Inc(Y, H); end; end;
Delphi - .....................................
Sürücünün kapasitesini ve sürücüdeki boş yer miktarını bulmak
Sürücünün kapasitesini ve sürücüdeki boş yer miktarını bulmak
DiskFree(0) //o anki sürücüdeki boş yer miktarını byte cinsinden döndürür.
DiskSize(0) //o anki sürücünün kapasitesini byte cinsinden döndürür.
DiskSize(0) div 1024 //o anki sürücünün kapasitesini KB cinsinden döndürür.
Delphi - .....................................
Sürücünün kapasitesini ve sürücüdeki boş yer miktarını bulmak
Sürücünün kapasitesini ve sürücüdeki boş yer miktarını bulmak
DiskFree(0) //o anki sürücüdeki boş yer miktarını byte cinsinden döndürür.
DiskSize(0) //o anki sürücünün kapasitesini byte cinsinden döndürür.
DiskSize(0) div 1024 //o anki sürücünün kapasitesini KB cinsinden döndürür.
Delphi - .....................................
Programım hangi klasörde çalışıyor
Programım hangi klasörde çalışıyor
procedure TForm1.Button1Click(Sender: TObject);
var
path: string;
begin
Path := ExtractFilePath(ParamStr(0));
Showmessage (path);
end;
Delphi - .....................................
Programım hangi klasörde çalışıyor
Programım hangi klasörde çalışıyor
procedure TForm1.Button1Click(Sender: TObject);
var
path: string;
begin
Path := ExtractFilePath(ParamStr(0));
Showmessage (path);
end;
Delphi - .....................................
Bilgisayarı reboot etmek [assembley]
DELPHI -- ASSEMBLY İPUCU
1-Bilgisayarı reboot etmek
asm
cli
@@WaitOutReady:
in al,64h
test al,00000010b
jnz
@@WaitOutReady
mov al,0FEh
out 64h,al
End;
Delphi - .....................................
Bilgisayarı reboot etmek [assembley]
DELPHI -- ASSEMBLY İPUCU
1-Bilgisayarı reboot etmek
asm
cli
@@WaitOutReady:
in al,64h
test al,00000010b
jnz
@@WaitOutReady
mov al,0FEh
out 64h,al
End;
Delphi - .....................................
Delphi -- Form İpuçları
DELPHI – FORM İPUCU
1. Form üzerindeki bileşenleri resolution oranında büyütme.
//640*480 referans olarak alindi 
procedure AdjustResolution(oForm:TForm);
var
iPercentage:integer;
begin
if Screen.Width > 640 then
begin
iPercentage:=Round(((Screen.Width-640)/640)*100)+100;
oForm.ScaleBy(iPercentage,100);
end;
end;
AdjustResolution(Self);
2. Formun title Bar'da gözükmesini engellemek.
{ Mutlaka Winprocs & WinTypes unitlerinin çagrilmasi gerekli }
Procedure TSeninFormName.HideTitlebar;
Var
Save : LongInt;
Begin
If BorderStyle=bsNone then Exit;
Save:=GetWindowLong(Handle,gwl_Style);
If (Save and ws_Caption)=ws_Caption then Begin
Case BorderStyle of
bsSingle,
bsSizeable : SetWindowLong(Handle,gwl_Style,Save and
(Not(ws_Caption)) or ws_border);
bsDialog : SetWindowLong(Handle,gwl_Style,Save and
(Not(ws_Caption)) or ds_modalframe or ws_dlgframe);
End;
Height:=Height-getSystemMetrics(sm_cyCaption);
Refresh;
End;
end;
Procedure TSeninFormName.ShowTitlebar;
Var
Save : LongInt;
begin
If BorderStyle=bsNone then Exit;
Save:=GetWindowLong(Handle,gwl_Style);
If (Save and ws_Caption)<>ws_Caption then Begin
Case BorderStyle of
bsSingle,
bsSizeable : SetWindowLong(Handle,gwl_Style,Save or ws_Caption or
ws_border);
bsDialog : SetWindowLong(Handle,gwl_Style,Save or ws_Caption or
ds_modalframe or ws_dlgframe);
End;
Height:=Height+getSystemMetrics(sm_cyCaption);
Refresh;
End;
end;
3. Form'da kendi hotkeyini olusturma...
//Önce formun KeyPreview := true; yapin.
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (ssCtrl in Shift) and (chr(Key) in ['A', 'a']) then
ShowMessage('Ctrl-A');
end;
4. MDI Child formun kapatılması...
//Formun onClose olayina asagidaki satiri yazmaniz yeterli.
Action := caFree;
5. Formu ilk açılışta minimize açmak...
//Formun onCreate olayina
ShowWindow(Handle, SW_MINIMIZE);
//yazin...
Delphi - .....................................
Delphi -- Form İpuçları
DELPHI – FORM İPUCU
1. Form üzerindeki bileşenleri resolution oranında büyütme.
//640*480 referans olarak alindi
procedure AdjustResolution(oForm:TForm);
var
iPercentage:integer;
begin
if Screen.Width > 640 then
begin
iPercentage:=Round(((Screen.Width-640)/640)*100)+100;
oForm.ScaleBy(iPercentage,100);
end;
end;
AdjustResolution(Self);
2. Formun title Bar'da gözükmesini engellemek.
{ Mutlaka Winprocs & WinTypes unitlerinin çagrilmasi gerekli }
Procedure TSeninFormName.HideTitlebar;
Var
Save : LongInt;
Begin
If BorderStyle=bsNone then Exit;
Save:=GetWindowLong(Handle,gwl_Style);
If (Save and ws_Caption)=ws_Caption then Begin
Case BorderStyle of
bsSingle,
bsSizeable : SetWindowLong(Handle,gwl_Style,Save and
(Not(ws_Caption)) or ws_border);
bsDialog : SetWindowLong(Handle,gwl_Style,Save and
(Not(ws_Caption)) or ds_modalframe or ws_dlgframe);
End;
Height:=Height-getSystemMetrics(sm_cyCaption);
Refresh;
End;
end;
Procedure TSeninFormName.ShowTitlebar;
Var
Save : LongInt;
begin
If BorderStyle=bsNone then Exit;
Save:=GetWindowLong(Handle,gwl_Style);
If (Save and ws_Caption)<>ws_Caption then Begin
Case BorderStyle of
bsSingle,
bsSizeable : SetWindowLong(Handle,gwl_Style,Save or ws_Caption or
ws_border);
bsDialog : SetWindowLong(Handle,gwl_Style,Save or ws_Caption or
ds_modalframe or ws_dlgframe);
End;
Height:=Height+getSystemMetrics(sm_cyCaption);
Refresh;
End;
end;
3. Form'da kendi hotkeyini olusturma...
//Önce formun KeyPreview := true; yapin.
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (ssCtrl in Shift) and (chr(Key) in ['A', 'a']) then
ShowMessage('Ctrl-A');
end;
4. MDI Child formun kapatılması...
//Formun onClose olayina asagidaki satiri yazmaniz yeterli.
Action := caFree;
5. Formu ilk açılışta minimize açmak...
//Formun onCreate olayina
ShowWindow(Handle, SW_MINIMIZE);
//yazin...
Delphi - .....................................
Delphi -- Miscellaneous İpuçları
Delphi -- Miscellaneous İpuçları
1. Programı sleep moduna alma...
Procedure MsSleep(ms : Integer);
Var
tmpTime : Integer;
tmpMs : Integer;
Begin
tmpMs := ms;
tmpTime := GetTickCount + tmpMs;
While tmpTime > GetTickCount Do
Application.ProcessMessages;
End;
{Program kapanışında istediğiniz bir açıklamayı koyup çalıştırın
bu uyuma metodunu engellemenin yolu yok ) }
2. Saat'i parçalayarak yaz...
// Kayıtları oluştur
type TimeParse = record
timeDay : Integer;
timeHour : Integer;
timeMin : Integer;
timeSec : Integer;
timeMilli : Integer;
end;
// function burda başlıyor
function DoTime(MilliSeconds : Integer) : TimeParse;
begin
// Değerleri sıfırla
Result.timeHour := 0;
Result.timeMin := 0;
Result.timeDay := 0;
Result.timeSec := 0;
Result.timeMilli := 0;
// Günü al
While MilliSeconds > 86399999 Do
Begin
Result.timeDay := Result.timeDay + 1;
MilliSeconds := MilliSeconds - 86400000;
End;
// Saati al
While MilliSeconds > 3599999 Do
Begin
Result.timeHour := Result.timeHour + 1;
MilliSeconds := MilliSeconds - 3600000;
End;
// Dakikayı al
While MilliSeconds > 59999 Do
Begin
Result.timeMin := Result.timeMin + 1;
MilliSeconds := MilliSeconds - 60000;
End;
// Saniyeyi al
While MilliSeconds > 999 Do
Begin
Result.timeSec := Result.timeSec + 1;
MilliSeconds := MilliSeconds - 1000;
End;
// Kaç milisaniye geçti
Result.timeMilli := MilliSeconds;
end;
Procedure TFrom1.Button1Click(Sender:TObject)
Var
FTimeParse : TTimeParse;
I : Integer;
begin
I := GetTickCount;
I := GetTickCount - I;
LabelDays.Caption := FTimeParse.timeDay;
LabelHours.Caption := FTimeParse.timeHour;
LabelMinutes.Caption := FTimeParse.timeMin;
LabelSeconds.Caption := FTimeParse.timeSec;
LabelMilliseconds.Caption := FTimeParse.timeMilli;
end;
Delphi - .....................................
Delphi -- Miscellaneous İpuçları
Delphi -- Miscellaneous İpuçları
1. Programı sleep moduna alma...
Procedure MsSleep(ms : Integer);
Var
tmpTime : Integer;
tmpMs : Integer;
Begin
tmpMs := ms;
tmpTime := GetTickCount + tmpMs;
While tmpTime > GetTickCount Do
Application.ProcessMessages;
End;
{Program kapanışında istediğiniz bir açıklamayı koyup çalıştırın
bu uyuma metodunu engellemenin yolu yok ) }
2. Saat'i parçalayarak yaz...
// Kayıtları oluştur
type TimeParse = record
timeDay : Integer;
timeHour : Integer;
timeMin : Integer;
timeSec : Integer;
timeMilli : Integer;
end;
// function burda başlıyor
function DoTime(MilliSeconds : Integer) : TimeParse;
begin
// Değerleri sıfırla
Result.timeHour := 0;
Result.timeMin := 0;
Result.timeDay := 0;
Result.timeSec := 0;
Result.timeMilli := 0;
// Günü al
While MilliSeconds > 86399999 Do
Begin
Result.timeDay := Result.timeDay + 1;
MilliSeconds := MilliSeconds - 86400000;
End;
// Saati al
While MilliSeconds > 3599999 Do
Begin
Result.timeHour := Result.timeHour + 1;
MilliSeconds := MilliSeconds - 3600000;
End;
// Dakikayı al
While MilliSeconds > 59999 Do
Begin
Result.timeMin := Result.timeMin + 1;
MilliSeconds := MilliSeconds - 60000;
End;
// Saniyeyi al
While MilliSeconds > 999 Do
Begin
Result.timeSec := Result.timeSec + 1;
MilliSeconds := MilliSeconds - 1000;
End;
// Kaç milisaniye geçti
Result.timeMilli := MilliSeconds;
end;
Procedure TFrom1.Button1Click(Sender:TObject)
Var
FTimeParse : TTimeParse;
I : Integer;
begin
I := GetTickCount;
I := GetTickCount - I;
LabelDays.Caption := FTimeParse.timeDay;
LabelHours.Caption := FTimeParse.timeHour;
LabelMinutes.Caption := FTimeParse.timeMin;
LabelSeconds.Caption := FTimeParse.timeSec;
LabelMilliseconds.Caption := FTimeParse.timeMilli;
end;
Delphi - .....................................
Delphi -- Sistem İpuçları
Delphi -- Sistem İpuçları
1. Registryden kayıt okuma...
procedure TForm1.FormCreate(Sender: TObject);
Var
Registry: TRegistry;
Listan:TStringList;
begin
Listan := TStringList.create;
Registry := TRegistry.Create;
try
Registry.RootKey := HKey_Classes_Root;
Registry.OpenKey('',False);
Registry.GetKeynames(Listan);
ComboBox1.Items := Listan;
finally
Registry.Free;
end;
end;
2. Porttan bilgi oku...
function ReadPortB( wPort : Word ) : Byte;
begin
asm
mov dx, wPort
in al, dx
mov result, al
end;
end;
3. Porta bilgi gönder...
procedure WritePortB( wPort : Word; bValue : Byte );
begin
asm
mov dx, wPort
mov al, bValue
out dx, al
end;
end.
4.Uygulamanız Desktop'ta kısayol oluştursun..
procedure desktopShortcut(ffilename:string; fcaption: widestring);
var
IObject : IUnknown;
ISLink : IShellLink;
IPFile : IPersistFile;
PIDL : PItemIDList;
InFolder : array[0..MAX_PATH] of Char;
TargetName : String;
LinkName : WideString;
FLinkName : String;
begin
TargetName := ffilename;
IObject := CreateComObject(CLSID_ShellLink);
ISLink := IObject as IShellLink;
IPFile := IObject as IPersistFile;
with ISLink do begin
SetPath(pChar(TargetName));
SetWorkingDirectory
(pChar(ExtractFilePath(TargetName)));
end;
SHGetSpecialFolderLocation
(0, CSIDL_DESKTOPDIRECTORY, PIDL);
SHGetPathFromIDList
(PIDL, InFolder);
FlinkName := ''+ FCaption + '.lnk';
LinkName := InFolder + FlinkName;
IPFile.Save(PWChar(LinkName), false);
end;
Kullanımı:
DesktopShortcut('C:/windows/notepad.exe','Notepad');
Delphi - .....................................
Delphi -- Sistem İpuçları
Delphi -- Sistem İpuçları
1. Registryden kayıt okuma...
procedure TForm1.FormCreate(Sender: TObject);
Var
Registry: TRegistry;
Listan:TStringList;
begin
Listan := TStringList.create;
Registry := TRegistry.Create;
try
Registry.RootKey := HKey_Classes_Root;
Registry.OpenKey('',False);
Registry.GetKeynames(Listan);
ComboBox1.Items := Listan;
finally
Registry.Free;
end;
end;
2. Porttan bilgi oku...
function ReadPortB( wPort : Word ) : Byte;
begin
asm
mov dx, wPort
in al, dx
mov result, al
end;
end;
3. Porta bilgi gönder...
procedure WritePortB( wPort : Word; bValue : Byte );
begin
asm
mov dx, wPort
mov al, bValue
out dx, al
end;
end.
4.Uygulamanız Desktop'ta kısayol oluştursun..
procedure desktopShortcut(ffilename:string; fcaption: widestring);
var
IObject : IUnknown;
ISLink : IShellLink;
IPFile : IPersistFile;
PIDL : PItemIDList;
InFolder : array[0..MAX_PATH] of Char;
TargetName : String;
LinkName : WideString;
FLinkName : String;
begin
TargetName := ffilename;
IObject := CreateComObject(CLSID_ShellLink);
ISLink := IObject as IShellLink;
IPFile := IObject as IPersistFile;
with ISLink do begin
SetPath(pChar(TargetName));
SetWorkingDirectory
(pChar(ExtractFilePath(TargetName)));
end;
SHGetSpecialFolderLocation
(0, CSIDL_DESKTOPDIRECTORY, PIDL);
SHGetPathFromIDList
(PIDL, InFolder);
FlinkName := ''+ FCaption + '.lnk';
LinkName := InFolder + FlinkName;
IPFile.Save(PWChar(LinkName), false);
end;
Kullanımı:
DesktopShortcut('C:/windows/notepad.exe','Notepad');
Delphi - .....................................
Delphi -- Database İpuçları
Delphi -- Database İpuçları
1. İstenilen alanları Combobox'a yazdırma...
procedure TForm1.FormCreate(Sender: TObject);
begin
with Table1 do begin
DisableControls;
try
First
while not EOF do begin
with MyCombo.Items do
Objects[Add(FieldByName('Terms').AsString)] := Pointer((FieldByName('EmpNo').AsInteger));
Next;
end;
finally
EnableControls;
end;
end;
end;
procedure TForm1.MyComboClick(Sender: TObject);
var EmpNo: Integer;
begin
with MyCombo do
EmpNo:=LongInt(Items.Objects[ ItemIndex ]);
ShowMessage('Emp.No.: ' + IntToStr(EmpNo));
End;
2. Query'de SQL kullanarak arama yapmak...
procedure TForm1.Button1Click(Sender: TObject);
begin
Query1.Close;
Query1.Sql.Clear;
Query1.Sql.Add('Select * From Database Where Adi like "'+Edit1.text+'%"');
Query1.Open;
End;
3. Table'da istenilen alana göre arama yapmak
procedure TForm1.Button1Click(Sender: TObject);
begin
Table1.Locate('AlanAdi',Edit1.Text,[]);
end;
4. Table'da her tuşa basışta girilen kadarının uyduğu kayıdı bulma...
procedure TForm1.Edit1Change(Sender: TObject);
begin
Table1.FindNearst([Edit1.Text]);
end;
5. Table'da indexli alana göre arama yapmak...
procedure TForm1.Button1Click(Sender: TObject);
begin
Table1.FindKey([Edit1.text]);
end;
Delphi - .....................................
Delphi -- Database İpuçları
Delphi -- Database İpuçları
1. İstenilen alanları Combobox'a yazdırma...
procedure TForm1.FormCreate(Sender: TObject);
begin
with Table1 do begin
DisableControls;
try
First
while not EOF do begin
with MyCombo.Items do
Objects[Add(FieldByName('Terms').AsString)] := Pointer((FieldByName('EmpNo').AsInteger));
Next;
end;
finally
EnableControls;
end;
end;
end;
procedure TForm1.MyComboClick(Sender: TObject);
var EmpNo: Integer;
begin
with MyCombo do
EmpNo:=LongInt(Items.Objects[ ItemIndex ]);
ShowMessage('Emp.No.: ' + IntToStr(EmpNo));
End;
2. Query'de SQL kullanarak arama yapmak...
procedure TForm1.Button1Click(Sender: TObject);
begin
Query1.Close;
Query1.Sql.Clear;
Query1.Sql.Add('Select * From Database Where Adi like "'+Edit1.text+'%"');
Query1.Open;
End;
3. Table'da istenilen alana göre arama yapmak
procedure TForm1.Button1Click(Sender: TObject);
begin
Table1.Locate('AlanAdi',Edit1.Text,[]);
end;
4. Table'da her tuşa basışta girilen kadarının uyduğu kayıdı bulma...
procedure TForm1.Edit1Change(Sender: TObject);
begin
Table1.FindNearst([Edit1.Text]);
end;
5. Table'da indexli alana göre arama yapmak...
procedure TForm1.Button1Click(Sender: TObject);
begin
Table1.FindKey([Edit1.text]);
end;
Delphi - .....................................
Delphi -- Graphic İpuçları
Delphi -- Graphic İpuçları
1. 3D Yazı yazmak..
procedure imgPaintCanvas(TheCanvas : TCanvas; TheString : String; TheFontSize, UCorner, LCorner : Integer);
Begin
TheCanvas.Brush.Style := bsClear;
TheCanvas.Font.Style := [fsBold];
TheCanvas.Font.Name := 'MS Sans Serif';
TheCanvas.Font.Size := TheFontSize;
TheCanvas.Font.Color := clBlack;
TheCanvas.TextOut(UCorner, LCorner, TheString);
TheCanvas.Font.Color := clGray;
TheCanvas.TextOut(UCorner - 1, LCorner - 1, TheString);
TheCanvas.Font.Color := clSilver;
TheCanvas.TextOut(UCorner - 2, LCorner - 2, TheString);
TheCanvas.Font.Color := clBlack;
TheCanvas.TextOut(UCorner - 3, LCorner - 3, TheString);
End;
//Şöyle Çalışıyor
imgPaintCanvas(Image3.Canvas, '0', 10, 6, 4);
2. Form da MetaFile çizmek...
implementation
{$R *.DFM}
type
TMetafileCanvas = class(TCanvas)
private
FClipboardHandle: THandle;
FMetafileHandle: HMetafile;
FRect: TRect;
protected
procedure CreateHandle; override;
function GetMetafileHandle: HMetafile;
public
constructor Create;
destructor Destroy; override;
property Rect: TRect read FRect write FRect;
property MetafileHandle: HMetafile read GetMetafileHandle;
end;
constructor TMetafileCanvas.Create;
begin
inherited Create;
FClipboardHandle := GlobalAlloc(
GMEM_SHARE or GMEM_ZEROINIT, SizeOf(TMetafilePict));
end;
destructor TMetafileCanvas.Destroy;
begin
DeleteMetafile(CloseMetafile(Handle));
if Bool(FClipboardHandle) then GlobalFree(FClipboardHandle);
if Bool(FMetafileHandle) then DeleteMetafile(FMetafileHandle);
inherited Destroy;
end;
procedure TMetafileCanvas.CreateHandle;
var
MetafileDC: HDC;
begin
MetafileDC := CreateMetaFile(nil);
if Bool(MetafileDC) then
begin
with FRect do SetWindowOrg(MetafileDC, Left - 10, Top - 10);
with FRect do SetWindowExt(MetafileDC, Right - Left + 20, Bottom - Top + 20);
if Bool(FMetafileHandle) then
begin
PlayMetafile(MetafileDC, FMetafileHandle);
end;
end;
Handle := MetafileDC;
end;
function TMetafileCanvas.GetMetafileHandle: HMetafile;
var
MetafilePict: PMetafilePict;
IC: HDC;
ExtRect: TRect;
begin
if Bool(FMetafileHandle) then DeleteMetafile(FMetafileHandle);
FMetafileHandle := CloseMetafile(Handle);
Handle := 0;
MetafilePict := GlobalLock(FClipboardHandle);
MetafilePict^.mm := mm_AnIsoTropic;
IC := CreateIC('DISPLAY', nil, nil, nil);
SetMapMode(IC, mm_HiMetric);
ExtRect := FRect;
DPtoLP(IC, ExtRect, 2);
DeleteDC(IC);
MetafilePict^.xExt := ExtRect.Right - ExtRect.Left;
MetafilePict^.yExt := ExtRect.Top - ExtRect.Bottom;
MetafilePict^.HMF := FMetafileHandle;
GlobalUnlock(FClipboardHandle);
Result := FClipboardHandle;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
MetafileCanvas : TMetafileCanvas;
begin
MetafileCanvas := TMetafileCanvas.Create;
MetafileCanvas.Rect := Rect(0,0,500,500);
MetafileCanvas.Ellipse(10,10,400,400);
Image1.Picture.Metafile.LoadFromClipboardFormat(cf_MetafilePict, MetafileCanvas.MetafileHandle, 0);
MetafileCanvas.Free;
end;
end.
3. Forma Bitmap kaplanması...
var
Form1: TForm1;
Bitmap: TBitmap;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
Bitmap := TBitmap.Create;
Bitmap.LoadFromFile('C:WINDOWShasir.bmp');
end;
procedure TForm1.FormPaint(Sender: TObject);
var
X, Y, W, H: LongInt;
begin
with Bitmap do
begin
W := Width;
H := Height;
end;
Y := 0;
while Y < Height do
begin
X := 0;
while X < Width do
begin
Canvas.Draw(X, Y, Bitmap);
Inc(X, W);
end;
Inc(Y, H);
end;
end;
end.
4.Transparan Bitmap nasıl yapılır...
procedure DrawTrans(DestCanvas: TCanvas; X,Y: smallint; SrcBitmap: TBitmap; AColor, BackColor: TColor);
var ANDBitmap, ORBitmap: TBitmap;
CM: TCopyMode;
Src: TRect;
begin
ANDBitmap:= NIL;
ORBitmap:= NIL;
try
ANDBitmap:= TBitmap.Create;
ORBitmap:= TBitmap.Create;
Src := Bounds(0,0, SrcBitmap.Width, SrcBitmap.Height);
with ORBitmap do begin
Width:= SrcBitmap.Width;
Height:= SrcBitmap.Height;
Canvas.Brush.Color := clBlack;
Canvas.CopyMode := cmSrcCopy;
Canvas.BrushCopy(Src, SrcBitmap, Src, AColor);
end;
with ANDBitmap do begin
Width:= SrcBitmap.Width;
Height:= SrcBitmap.Height;
Canvas.Brush.Color := BackColor;
Canvas.CopyMode := cmSrcInvert;
Canvas.BrushCopy(Src, SrcBitmap, Src, AColor);
end;
with DestCanvas do begin
CM := CopyMode;
CopyMode := cmSrcAnd;
Draw(X,Y, ANDBitmap);
CopyMode := cmSrcPaint;
Draw(X,Y, ORBitmap);
CopyMode := CM;
end;
finally
ANDBitmap.Free;
ORBitmap.Free;
end;
end;
Kullanımı :
DrawTrans(Image2.Canvas, 0,0, 'C:Windowsdeepblue.bmp', clBlack, clSilver);
Delphi - .....................................
