Programlama yapalım ve Öğrenelim.

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 -- 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;

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.

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;

Kullanımı :

DrawTrans(Image2.Canvas, 0,0, 'C:Windowsdeepblue.bmp', clBlack, clSilver);

Delphi -- Shareware İpuçları

1 . Programınız her windows açılışında sadece bir kere çalışsın...

procedure TForm1.FormShow(Sender : TObject);

var atom : integer;

CRLF : string;

begin

GlobalFindAtom('THIS_IS_SOME_OBSCUREE_TEXT') = 0 then

atom := GlobalAddAtom('THIS_IS_SOME_OBSCUREE_TEXT')

else

begin

CRLF := #10 + #13;

ShowMessage('Bu versiyon her Windows oturumunda yanlızca bir kere çalışır.' + CRLF +

'Programı tekrar çalıştırmak için Windows'u restart edin. ' + CRLF +

'REGISTER !!');

Close;

end;

Delphi -- WinAPI İpuçları

1.Windows'un dial-up bağlantısının çağrılması

//modem yüklü olmalı

winexec(PChar('rundll32.exe rnaui.dll,RnaDial '+Edit1.Text),sw_show);

2.Programına Animasyonlu Cursor Ekle

const

cnCursorID1 = 1;

begin

Screen.Cursors[ cnCursorID1 ] :=

LoadCursorFromFile(

'c:winntcursorspiano.ani' );

Cursor := cnCursorID1;

end;

3.Programa E-mail linki eklemek

procedure email;

var

x: string;

begin

x:='mailto:'+FEmailTo+'?Subject='+FEmailSubject+'&cc='+FEmailCC;

ShellExecute(0, nil, PChar(x), nil, nil, SW_SHOWDEFAULT);

end;

4.Registry'den Bilgi okumak

var

RegIni : TRegIniFile;

begin

RegIni := TRegIniFile.Create('');

with RegIni do

begin

RootKey := HKEY_LOCAL_MACHINE;

LazyWrite := True;

OpenKey('SoftwareMicrosoftWindows',False);

ShowMessage(ReadString('CurrentVersion', 'RegisteredOrganization', 'not assigned'));

Free;

end;

5.Açık bütün pencereleri listeleme

function EnumWindowsProc(Wnd : HWnd;Form : TForm1) : Boolean; Export; {$ifdef Win32} StdCall; {$endif}

var

Buffer : Array[0..99] of char;

begin

GetWindowText(Wnd,Buffer,100);

if StrLen(Buffer) <> 0 then

Form.ListBox1.Items.Add(StrPas(Buffer));

Result := True;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

EnumWindows(@EnumWindowsProc,LongInt(Self));

end;

Delphi -- File Yönetimi İpuçları

1. Delphi 'de dosya nasıl Kopyalanır ?

Bunun için bir kaç yöntem var...

Procedure FileCopy( Const sourcefilename, targetfilename: String );

Var

S, T: TFileStream;

Begin

S := TFileStream.Create( sourcefilename, fmOpenRead );

try

T := TFileStream.Create( targetfilename,

fmOpenWrite or fmCreate );

try

T.CopyFrom(S, S.Size ) ;

finally

T.Free;

end;

finally

S.Free;

end;

End;

procedure FileCopy(const FromFile, ToFile: string);

var

FromF, ToF: file;

NumRead, NumWritten: Word;

Buf: array[1..2048] of Char;

begin

AssignFile(FromF, FromFile);

Reset(FromF, 1);

AssignFile(ToF, ToFile);

Rewrite(ToF, 1);

repeat

BlockRead(FromF, Buf, SizeOf(Buf), NumRead);

BlockWrite(ToF, Buf, NumRead, NumWritten);

until (NumRead = 0) or (NumWritten <> NumRead);

CloseFile(FromF);

CloseFile(ToF);

end;

{ USES LZExpand.}

procedure CopyFile(FromFileName, ToFileName: string);

var

FromFile, ToFile: File;

begin

AssignFile(FromFile, FromFileName);

AssignFile(ToFile, ToFileName);

Reset(FromFile);

try

Rewrite(ToFile);

try

if LZCopy(TFileRec(FromFile).Handle, TFileRec(ToFile).Handle) < 0 then

raise EInOutError.Create

finally

CloseFile(ToFile);

end;

finally

CloseFile(FromFile);

end;

2. Dosyanın değiştirilme tarih ve saatinin öğrenilmesi

function GetModifiedDate(FileName: string): TDateTime;

var

SearchRec: TSearchRec;

ModifiedTime: TFileTime;

SystemTime: TSystemTime;

begin

Result := 0;

If FindFirst(FileName, faAnyFile, SearchRec) = 0 then

begin

ModifiedTime := SearchRec.FindData.ftLastWriteTime;

FileTimeToLocalFileTime(ModifiedTime, ModifiedTime);

FileTimeToSystemTime(ModifiedTime, SystemTime);

Result := SystemTimeToDateTime(SystemTime);

end;

FindClose(SearchRec);

end;

3. Dosyanın varlığının kontrol edilmesi

Function GetShortFileName(Const FileName : String) : String;

var

aTmp: array[0..255] of char;

begin

if GetShortPathName(PChar(FileName),aTmp,Sizeof(aTmp)-1)=0 then

Result:= FileName+ ' <--Bulunamadı'

else

Result:=FileName+' <--Bulundu';

end;

4. Verilen bir dizinin içini silme

procedure DelTree(StartDir: string);

var

Search : TSearchRec;

begin

if Startdir[Length(Startdir)] <> '' then

startdir := startdir + '';

if FindFirst(startdir + '*.*', faAnyFile, Search) = 0 then

repeat

if (Search.Name[1] <> '.' ) then

if ((Search.Attr and faDirectory) > 0) then

begin

RmDir(StartDir + Search.Name);

ChangeFAttrib(StartDir + Search.Name);

end else

begin

DeleteFile(StartDir + Search.Name);

Application.ProcessMessages;

end;

until FindNext(Search) <> 0;

FindClose(Search);

end

Delphi -- Hardware İpuçları

1. CD-ROM Drive'ı kontrol etmek...

function IsCDROM(DriveNum: Integer): Boolean; assembler;

asm

MOV AX,1500h { MSCDEX 'e bakıyor}

XOR BX,BX

INT 2fh

OR BX,BX

JZ @Finish

MOV AX,150Bh { CD driver ın kullanılırlığına bakıyor}

MOV CX,DriveNum

INT 2fh

OR AX,AX

@Finish:

end;

// Win32 kontrolörlü

Function IsCdRom(DriveNum : Word) : Boolean;

Var

F : WordBool;

Begin

asm

mov ax, 1500h

xor bx, bx

int 2fh

mov ax, bx

or ax, ax

jz @no_mscdex

mov ax, 150bh

mov cx, DriveNum

int 2fh

@no_mscdex:

mov f,ax

end;

Result := F;

End;

2. Disk veya Disket yerinde mi ?

function DiskInDrive(Drive: Char): Boolean;

var

ErrorMode: word;

begin

if Drive in ['a'..'z'] then Dec(Drive, $20);

if not (Drive in ['A'..'Z']) then

raise EConvertError.Create('Not a valid drive ID');

ErrorMode := SetErrorMode(SEM_FailCriticalErrors);

try

{ sürücü 1 = a, 2 = b, 3 = c, etc. }

if DiskSize(Ord(Drive) - $40) = -1 then

Result := False

else

Result := True;

finally

{ error moduna geri dön }

SetErrorMode(ErrorMode);

end;

3. Sistem Tarih ve Saatini değiştirme...

procedure SetDate(Year, Month, Day: Word); assembler;

asm

MOV CX,Year

MOV DH,BYTE PTR Month

MOV DL,BYTE PTR Day

MOV AH,2BH

INT 21H

end;

procedure SetTime(Hour, Minute, Second, Sec100: Word); assembler;

asm

MOV CH,BYTE PTR Hour

MOV CL,BYTE PTR Minute

MOV DH,BYTE PTR Second

MOV DL,BYTE PTR Sec100

MOV AH,2DH

INT 21H

end;

function SetSystemDateTime(Year, Month, Day, Hour, Minute, Second: word): integer;export;

begin

SetDate(Year, Month, Day);

SetTime(Hour, Minute + 1, Second, 0);

result := 1;

end

Delphi -- String İpuçları

1. Editten sadece sayımı girilsin...

procedure CheckText(Sender:TEdit; var Key:Char);

begin

If not (Key in ['0'..'9','.',#8, #13]) then

Key := #0;

If Key = '.' then

begin

If Pos('.', Sender.Text) > 0 then

Key := #0;

end;

2. Editin içini belli bir formatta yazdırmak...

Procedure Format(MyEdit1,MyEdit2:TEdit);

Var

I : Integer;

S : String;

begin

I := StrToInt(MyEdit1.Text);

FmtStr(S, '%.3d', [I]);

MyEdit2.Text := S;

// I.E. If Edit1.Text := '1' den Edit2.Text := '001'; döndürür

end;

3. String içinde belli iki karakter arasını almak...

Function GetParsedItem(TheItemStr, ParseStr : String; ItemNum : Integer): String;

Var

I4 : Integer;

S4 : String;

Begin

TheItemStr := TheItemStr + ParseStr;

S4 := '';

I4 := 0;

While I4 <= ItemNum Do

Begin

S4 := Copy(TheItemStr, 1, Pos(ParseStr, TheItemStr) - 1);

Delete(TheItemStr, 1, Pos(ParseStr, TheItemStr));

Inc(I4);

End;

Result := S4;

End;

{TheItemStr de Parsestr ye bakiyor ve ItemNum inci parsestrden sonra tekrar bulana dek olan str yi veriyor.}

4.String şifreleme...

function EnDeCode(const Value : String) : String;

var

CharIndex : Integer;

ReturnValue : String;

begin

ReturnValue := '';

for CharIndex := 1 to Length(Value) do

begin

ReturnValue := ReturnValue + chr(NOT(ord(Value[CharIndex])));

end;

Result := ReturnValue;

end;

******************************************Database'de Türkçe Problemi

BDE administor programında configuration/dirvers/native/[kullandığın dosya türü] seçeneklerinde langdriver kısmını türkçe bir sürücü olarak değiştir. Bunu yaptıktan sonra delphi ile türkçe karakterleri görebilirsiniz

Bu ayarı yaptıktan sonra Database Desktopta Türkçe karakterler yine görünmeyecek.

Enter Tuşu Kullanımı

Windows programlarında bir alttaki alana geçmek için TAB tuşu kullanılır.Ancak DOS programlarından gelen alışkanlıkla kullanıcılar hep Enter ile alt alana geçmek ister ve bu bir tik olmuştur.

Delphide Enter tuşu ile bir alt alana geçmek için bir yöntem;

· Formun Keypreview olayını True yapılır.

· Form üzerinde herhangiki tüm bileşenlere Default false yaplır.

· formun onKeypres olayına aşağıdaki function ilave edilir.

procedure TAdresformu.FormKeyPress(Sender: TObject; var Key: Char);

begin

if Key = #13 then begin

Key := #0;

if (Sender is TDBGrid) then

TDBGrid(Sender).Perform(WM_KeyDown,VK_Tab,0)

else

Perform(Wm_NextDlgCtl,0,0);

end;

Açık Windows Uygulamalarının Gösterilmesi

Burada EnumWindows API fonksiyonuyla bir window handle ve pointer parametreleri çağrılarak gizli ve görünür uygulamalar listelenir.

//AnaForm üzerine bir ListBox1 ve Button1 ekleyin

//implementation {$R *.DFM} altyna a?a?ydaki fonksiyonu yaz

function EnumWindowsProc(Wnd : HWnd;Form : TForm1) : Boolean;

Export; {$ifdef Win32} StdCall; {$endif}

var

Buffer : Array[0..99] of char;

begin

GetWindowText(Wnd,Buffer,100);

if StrLen(Buffer)

<> 0 then

Form1.ListBox1.Items.Add(StrPas(Buffer));

Result := True;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

//Tüm gizli ve görünür uygulamalary listele

EnumWindows(@EnumWindowsProc,LongInt(Self));

end;

Delphide Yazılan Kodla Exe Çalıştırma

Aşağıdaki örnek kod verilen web sitesini Internet Explorer' ı çalıştırarak açar.

procedure TForm1.Button1Click(Sender: TObject);

begin

winexec('C:Program FilesInternet Exploreriexplore.exe <a href="http://wwww.programlama.com',SW_MAXIMIZE);

end;

" target="_blank">http://wwww.programlama.com',SW_MAXIMIZE);

end;

</a>

Bir Harddiskin Seri Numarasının Bulunması

Hard diskin seri numarasını bulur.

procedure TForm1.Button1Click(Sender: TObject);

var

VolumeSerialNumber : DWORD;

MaximumComponentLength : DWORD;

FileSystemFlags : DWORD;

SerialNumber : string;

begin

GetVolumeInformation('C:', nil, 0, @VolumeSerialNumber,

MaximumComponentLength, FileSystemFlags, nil, 0);

SerialNumber := IntToHex(HiWord(VolumeSerialNumber), 4) + '-' + IntToHex(LoWord(VolumeSerialNumber), 4);

Memo1.Lines.Add(SerialNumber);

end;

Windows'un Belgeler Menüsünü Temizleme

Formun uses kısmına ShlOBJ şeklinde ilave yapın; bir butona veya herhangi bir olayın event' ine de ;

SHAddToRecentDocs(SHARD_PATH, nil); şeklinde yazın.

Ekran Görüntüsü Aktarma

Belirttiğiniz sınırlar dahilinde ekranın belli bir alanını formunuzun üzerine koymak isterseniz. Formunuza image1 adlı bir resim objesi ekleyin ve daha sonra formunuzun create olayına şu kodu yazın.

procedure TForm1.FormCreate(Sender: TObject);

var

DCDesk: HDC;

begin

DCDesk:=GetWindowDC(GetDesktopWindow);

BitBlt(Image1.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,DCDesk, 0, 0,SRCCOPY);

ReleaseDC(GetDesktopWindow, DCDesk);

end;

Mouse Pointerı Gizlemek

Mouse Pointerı gizlemek için ShowCursor(False) komutunu kullanmak yeterli. Tabi yeniden görünmesini sağlamak için ShowCursor(True) komutunu kullanıyoruz.

İmlecin Ekrandaki Yerinin Belirlenmesi

İmlecin o anda ekranın neresinde olduğunu bulan ufak bir kod parçası.

procedure TForm1.Button1Click(Sender: TObject);

var Yer:TPoint;

begin

if Assigned(ActiveControl) then

begin

Yer:=Point(0,0); { burda 0,0 imleç'in ekrandaki yeri oluyor }

ActiveControl.ClientToScreen(Yer);

SetCursorPos(Yer.X,Yer.Y);

end;

Başlat Menüsü Programlarının Tespit Edilmesi

Başlat menüsünde hangi programların bulunduğunu tespit eden bir kod parçası.Forma bir ListBox, bir Buton, birde DDEClientConv nesnesi ekleyip, Service ve Topic özelligini "Progman" olarak giriniz.

var

B:Pchar;

procedure TForm1.Button1Click(Sender: TObject);

begin

ListBox1.Items.clear;

B := DDEClientConv1.RequestData('Groups');

ListBox1.Items.SetText(B);

StrDispose(B);

end;

Register Kullanım Örneği

Windows açılırken programınızın otomatik olarak başlatılıp başlatılmamasını nasıl ayarlarsınız. İşte size güzel bir örnek kod.Formunuza CheckBox Ekleyin ve adını Autorun yapın ( veya ne isterseniz.) ve formun Close Olayına Aşağıdaki kodları yazın.

procedure Tfilesetup.FormClose(Sender: TObject; var Action: TCloseAction);

var

AppExe :string;

begin

if autorun.Checked=true then begin

with TRegistry.Create do

try

RootKey := HKEY_CURRENT_USER;

if OpenKey ('SOFTWAREMicrosoftWindowsCurrentVersionRun', true) then

AppExe:=#34+Application.Exename+#34;

WriteString('Proton', AppExe);

finally

end;

//DeleteValue('Proton'); İse Programınız Registry den Siler

end;

Ekran Çözünürlüğünün Değiştirilmesi

Programınızdan ekran çözünürlüğünü değiştirmek isterseniz yararlı bir kod.

{Ekran Çözünürlüğü Örneği-PC'nizin Mevcut Ekran Ayarları}

// AnaForm üzerine ListBox1 ve Button1 bileşenlerini yerleştirin

{Ana formun OnCreate olayı}

procedure TForm1.FormCreate(Sender: TObject);

var

i : Integer;

DevMode : TDevMode;

begin

Button1.Enabled:=False;

i := 0;

while EnumDisplaySettings(nil,i,Devmode) do begin

with Devmode do

ListBox1.Items.Add(Format('%dx%d %d Colors',[dmPelsWidth,dmPelsHeight,1 shl dmBitsperPel]));

Inc(i);

end;

{ListBox1'in Onclick olayı}

procedure TForm1.ListBox1Click(Sender: TObject);

// Listede istenilen çözünürlük değeri seçildiğinde Button1'de kullanır hale getir

begin

Button1.Enabled := Listbox1.ItemIndex >= 0;

end;

procedure TForm1.Button1Click(Sender: TObject);

// Seçilen çözünürlük değerini değerini uygula

var

DevMode : TDevMode;

begin

EnumDisplaySettings(nil,Listbox1.ItemIndex,Devmode);

ChangeDisplaySettings(DevMode,0);

end;

Ekran çözünürlüğünün ekran tarafından desteklenmeyen değerlere ayarlanması ekranınızın bozulmasına neden olabilir.

Mouse'un Sağ Tuşuna Kullanmak

Mouse'un sağ tuşunun kullanımını anlatan küçük bir kod.

//bu örnekte form üzerinde mouse'un sağ tuşuna basılınca merhaba yazan bir mesaj çıkar

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

if ssright in shift then begin

MessageDlg('Merhaba', mtInformation, [mbOk], 0);

end;

Varsayılan Browser ile Web Adresi Açmak

Programınızdan herhangi bir internet adresini açmak ister misiniz?

Aşağıdaki kodu girmeden önce programın uses komut satırına "Shellapi" tanımını girmelisiniz.

ShellExecute(0, nil, 'http://www.programlama.com', nil, nil, SW_SHOWDEFAULT);

Sayıları Formatlı Yazdırmak

Eğer bir ticari program yazıyorsanız, veritabanında bulunmayan bir alanda para ya da benzeri cinsten bir büyüklük göstermek istiyorsanız, ve müşteriniz sizden rahat okuma talep etmişse aşağıdaki kod işinizi görecektir.

procedure TForm1.Button1Click(Sender: TObject);

var

a,i:integer;

s:string;

begin

s:=Edit1.Text;

i:=length(s);

if pos(',',s) <>0 then exit;

for a:=1 to i-1 do if (a mod 3)=0 then insert(',',s,i-a+1);

Edit1.text:=s;

end;

Final Diyaloğunu Açıp Kapatmak

Find diyalog penceresini açıp kapatan bir kod.

H:=FindWindow(PChar('#32770'),Nil); // #32770 Find diyalog'un sınıf adıdır.

If H = 0 Then // eğer Find diyalog'u açık değilse onu aç...

Begin

With dd1 Do

Begin

ConnectMode:=ddeManual;

ServiceApplication:='explorer.exe';

SetLink('Folders','AppProperties');

OpenLink;

ExecuteMacro('[FindFolder(,C:Dene)]',False);

CloseLink;

End;

H:=FindWindow(PChar('#32770'),Nil);

End;

ShowMessage('Find File Dialogunu gizle...!!');

ShowWindow(H,SW_HIDE);

ShowMessage('Find File Dialogunu göster...!!');

ShowWindow(H,SW_SHOW);

Ana Formunuzu Gizleyin

Programınız çalıştığında Ana Formunuzun görünmesini istemiyor musunuz? Çok kolay aşağıdaki kodu projenize ekleyin.

program Project1;

uses

Forms,

Unit1 in 'Unit1.pas' {Form1};

{$R *.RES}

begin

Application.Initialize;

Application.ShowMainForm := False;

Application.CreateForm(TForm1, Form1);

Application.Run;

end;

******************************************

WİNDOWS API

Belgeler menüsüne bir dosya ekleme

uses kısmına ShlOBJ unitini ekleyin;

procedure TForm1.Button1Click(Sender: TObject);

var

s : string;

begin

s := 'C:DownLoaddeneme.html';

SHAddToRecentDocs(SHARD_PATH, pChar(s));

end;

Belgeler menüsünü temizleme

uses kısmına ShlOBJ unitini ekleyin;

SHAddToRecentDocs(SHARD_PATH, nil);

Duvar kağıdını değiştirmek

var

s: string;

begin

s := 'c:windowsathena.bmp';

SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, PChar(s),0);

Başlat butonunu gizlemek veya kullanılmaz hale getirmek

procedure TForm1.Button1Click(Sender: TObject);

var

Rgn : hRgn;

begin

// Başlat butonunu gizle

Rgn := CreateRectRgn(0, 0, 0, 0);

SetWindowRgn(FindWindowEx(FindWindow('Shell_TrayWnd', nil),

'Button',

nil),

Rgn,

true);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

//Gizlenen Başlat butonunu eski haline döndürmek için

SetWindowRgn(FindWindowEx(FindWindow('Shell_TrayWnd', nil),

'Button',

nil),

true);

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

//Başlat butonunu kullanılmaz yap

EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd', nil),

'Button',

nil),

false);

end;

procedure TForm1.Button4Click(Sender: TObject);

begin

//Kullanılmaz yapılan Başlat butonunu eski haline getirmek için

EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd', nil),

'Button',

nil),

true);

end;

Bir programın çalıştırılması

WinExec('c:windowscalc.exe',sw_show);

WinExec('C:WINDOWSNOTEPAD.EXE C:WINDOWSWIN.INI', SW_SHOWNORMAL);

WinExec('COMMAND.COM', SW_SHOWNORMAL);

WinExec('COMMAND.COM /C DIR *.*', SW_SHOWNORMAL);

Harddiskin seri numarasının bulunması

procedure TForm1.Button1Click(Sender: TObject);

var

VolumeSerialNumber : DWORD;

MaximumComponentLength : DWORD;

FileSystemFlags : DWORD;

SerialNumber : string;

begin

GetVolumeInformation('C:',

nil,

@VolumeSerialNumber,

MaximumComponentLength,

FileSystemFlags,

nil,

0);

SerialNumber := IntToHex(HiWord(VolumeSerialNumber), 4) + '-' +

IntToHex(LoWord(VolumeSerialNumber), 4);

Memo1.Lines.Add(SerialNumber);

end;

Windows ve System klasörlerinin bulunması

procedure TForm1.Button1Click(Sender: TObject);

var

a : Array[0..144] of char;

begin

GetWindowsDirectory(a, sizeof(a));

ShowMessage(StrPas(a));

GetSystemDirectory(a, sizeof(a));

ShowMessage(StrPas(a));

end;

Windows lisans bilgilerinin (isim ve şirket) bulunması

uses kısmına Registry unitini ekleyin;

procedure TForm1.Button1Click(Sender:TObject);

var

reg: TRegIniFile;

begin

reg := TRegIniFile.create('SOFTWAREMICROSOFTMS SETUP (ACME)');

Memo1.Lines.Add(reg.ReadString('USER INFO',

'DefName',

'Mustafa ŞİMŞEK'));

Memo1.Lines.Add(reg.ReadString('USER INFO',

'DefCompany',

'Bilgisayar Bilimleri Müh.'));

reg.free;

end;

Speakerdan Beep sesi çıkartma

MessageBeep(word(-1));