DELPHI İPUÇLARI VE KODLARI
Alt+F4 tuş kombinasyonuyla programın kapanmaması için
Formun OnCreate olayına; KeyPreview := true;
Formun OnKeyDown olayına; if ((ssAlt in Shift) and (Key = VK_F4)) then
Key := 0;

Bir string'in başındaki ve sonundaki boşlukları atmak için
Trim(string)
TrimLeft (string) //stringin sadece başındaki boşlukları atmak için
TrimRight (string) //stringin sadece sonundaki boşlukları atmak için

Listbox'a, Memo'ya ve Combobox'a bir seferde birden çok eleman eklemek

Listbox1.items.SetText('Ali'#13'Veli'#13'kırkdokuzelli');
Memo1.Lines.SetText('Ali'#13'Veli'#13'kırkdokuzelli');
Combobox1.items.SetText('Ali'#13'Veli'#13'kırkdokuzelli');

Memo içinde imlecin hangi satır ve kolonda olduğunu bulma
var
LineNum:logint;
CharsBeforeLine:logint;
begin
LineNum:=SendMessage(Memo1.Handle,EM_LINEFROMCHAR,Memo1.SelStart,0);
CharsBeforeLine:=SendMessage(Memo1.Handle,EM_LINEINDEX,LineNum,0);
Label1.Caption:='Satır'+IntToStr(LineNum+1);
Label2.Caption:='Kolon'+IntToStr((Memo1.SelStart-CharsBeforeLine)+1);

ListBox veya ComboBox'ta seçili bir veya birden fazla öğeyi
seçilmemiş hale getirme

ListBox1.ItemIndex:=-1;
Combobox1.ItemIndex:=-1;

Bir menü öğesini kullanılamaz hale getirmek
MainMenu1.Items[0].Items[1].Enabled:=False; //ilk menünün, ikinci elemanı


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.

Bir Popup menüyü kod ile gösterme
PopupMenu1.Popup(Form1.Left+60,Form1.Top+140);

Sistem tarihini ve saatini değiştirmek
Sistemin tarihini ve saatini değiştirmek için SetLocalTime fonksiyonunu
kullanabilirsiniz.
var
t:TSystemTime;
begin
t.wYear:=1998; t.wMonth:=5; t.wDay:=23; t.wHour:=12;t.wMinute:=34;
SetLocalTime(t);
end;

Sayıları virgüllerle yazmak
Bu iş için FormatFloat fonksiyonunu kullanabilirsiniz. Sayı windows'unuz ayarına
göre 12.345.678 veya 12,345,678 şeklinde gösterilir.
procedure TForm1.Button1Click(Sender: TObject);
var
i : integer;
begin
i := 12345678;
Memo1.Lines.Add(FormatFloat('#,', i));

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


Fareyi meşgul şekilde göstermek

Bir işlem yaparken makinenin meşgul olduğunu göstermek için fareyi kum saati
şeklinde gösterip sonra eski haline getirmek için aşağıdaki gibi bir kod
kullanabilirsiniz.
try
Screen.Cursor := crHourGlass;
{buraya kodunuzu yazın...}
finally
Screen.Cursor := crDefault;
end;
Application.ProcessMessages;

Çok Satırlı İpucu
procedure TForm1.FormCreate(Sender: TObject);
begin
SpeedButton1.Hint:='Çok satırlı ipucunu '+chr(13)+
'mutlaka denemelisiniz '+chr(13)+'çok güzel';
end;

Form'un arka kısmına bir resmi döşemek
Bitmap: TBitmap;
procedure TForm1.FormCreate(Sender: TObject);
begin
Bitmap := TBitmap.Create;
Bitmap.LoadFromFile('C:\WINDOWS\cars.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;


Hareketli İmleç(animated cursor)leri kullanma 
procedure TForm1.Button1Click(Sender:TObject); 
var 
h : THandle; 
begin h := LoadImage(0, 'C:\TheWall\Magic.ani', IMAGE_CURSOR,0,0,LR_DEFAULTSIZE orLR_LOADFROMFILE); if h = 0 then ShowMessage('Cursor not loaded') else begin Screen.Cursors[1] := h; Form1.Cursor := 1; end; end;

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.

Bir form üzerindeki tüm bileşenleri read only(salt okunur) yapma
uses kısmına typinfo unitini ekleyin.
procedure TForm1.SetReadOnly( Value : boolean ) ;
var
PropInfo : PPropInfo ;
Component : TComponent ;
i : integer ;
begin
for i := 0 to ComponentCount - 1 do begin
Component := Components[ i ] ;
if Component is TControl then begin
PropInfo := GetPropInfo( Component.ClassInfo, 'ReadOnly' ) ;
if Assigned( PropInfo ) and
( PropInfo^.PropType^.Kind = tkEnumeration ) then
SetOrdProp( Component, PropInfo, integer( Value ) ) ;
end ;
end ;
end ;
procedure TForm1.Button1Click(Sender: TObject);
begin
SetReadOnly( true ) ;
end;


Dikdörtgen olmayan Edit'ler
Değişik şekilde bir edit elde etmek için formun OnCreate olayına aşağıdaki
kodu yazın.
SetWindowRgn(Edit1.handle,
CreateRoundRectRgn(2,2,Edit1.Width-2,Edit1.Height-2,15,15),
True);

Bir klasörün boyutunu öğrenmek
Bir klasördeki dosyaların kaç byte yer kapladığını öğrenmek için
function TForm1.GetDirectorySize(const ADirectory: string): Integer;
var
Dir: TSearchRec;
Ret: integer;
Path: string;
begin
Result := 0;
Path := ExtractFilePath(ADirectory);
Ret := Sysutils.FindFirst(ADirectory, faAnyFile, Dir);
if Ret <> NO_ERROR then
exit;
try
while ret=NO_ERROR do
begin
inc(Result, Dir.Size);
if (Dir.Attr in [faDirectory]) and (Dir.Name[1] <> '.') then
Inc(Result, GetDirectorySize(Path + Dir.Name + '\*.*'));
Ret := Sysutils.FindNext(Dir);
end;
finally
Sysutils.FindClose(Dir);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Showmessage(intToStr(getdirectorysize('C:\windows')));
end;

Bir dosyanın özelliklerini gösterme
procedure TForm1.Button1Click(Sender: TObject);
var
sei : TShellExecuteInfo;
begin
FillChar(sei,SizeOf(sei),#0);
sei.cbSize:=SizeOf(sei);
sei.lpFile:=PChar('c:\windows\notepad.exe');
sei.lpVerb:='properties';
sei.fMask:=SEE_MASK_INVOKEIDLIST;
ShellExecuteEx(@sei);
end;

Programım hangi klasörde çalışıyor
procedure TForm1.Button1Click(Sender: TObject);
var
path: string;
begin
Path := ExtractFilePath(ParamStr(0));
Showmessage (path);
end;
Bir dosyayı geri dönüşüm kutusuna (recyle bin) atmak
uses kısmına shellapi unitini ekleyin.
procedure TForm1.Button1Click(Sender: TObject);
var
T : TSHFileOpStruct;
begin
FillChar(T,SizeOf(TSHFileOpStruct),#0);
with T do
begin
Wnd:=0;
wFunc:=FO_DELETE;
pFrom:=Pchar('c:\test\2.avi');
fFlags:=FOF_ALLOWUNDO;
end;
SHFileOperation(T);
end;
Bir dosyanın boyutunu bulmak
procedure TForm1.Button1Click(Sender: TObject);
var
srFileSR: TSearchRec;
sFileName, sFileSize: string;
begin
sFileName := 'c:\test\2.avi';
FindFirst(sFileName,faAnyFile,srFileSR);
sFileSize := IntToStr(srFileSR.Size);
Showmessage(sFileSize);
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;
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:\WINDOWS\hasir.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:\Windows\deepblue.bmp', clBlack, clSilver);

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 Files\Internet Explorer\iexplore.exe Linklerin Görülmesine Izin Verilmiyor
Register or Login
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;
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 ('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run', true) then
AppExe:=#34+Application.Exename+#34;
WriteString('Proton', AppExe);
finally
end;
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;
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;
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, 'Linklerin Görülmesine Izin Verilmiyor
Register or Login', 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;

DLL Uygulaması
Selamlar ;
Bir aksaklık olmazsa bundan böyle Delphi çerçevesinde programcılık hakkında yazılarımla, sizlerle olacağım. Yani yazılarımız Delphi üzerine olmasına karşın, programcılığa da değineceğiz.
İlk cümlem bu olmadı ama şunu da dikkate almanızı dilerim, Delphi de uzman bir programcı değilim, Delphi’nin ne kadarını bildiğimi de bilmiyorum, Programcılıkta ne seviye de olduğumuda onun için bir şey iddia etmiyorum, bilgiyi paylaşalım diyorum.
Ben Delphi’ye yavaşça girecektim ama arkadaşlarla yaptığımız tartışmalarda, direk uygulama yazmaya karar verdim (Aslında arkadaşlar haklı, ben de haklıyım ama onlar daha haklı). Yani herkesin Delphi’yi kullanmayı bildiği ve birçok kavrama aşina olduğu varsayılarak yazılarımı yazacağım.
İlk uygulamamız DLL uygulaması olsun, ama sonuna kadar da incelemeden bırakmayalım. Her bi saçma gelen ayrıntıyı bile inceliyelim.
Di-El-El, nedir DLL, sizler için gittim olayi M$ fabrikasında inceledim, Amerikalıların icad ettiği ve bütün dünyadan da kabul gören (çok da iyi bir şey) kısatmalardan bir tanesi, hemen açalım yoksa anlayamıyacaz olayı; Dynamic Link Library (Dinamik Bağlantılı Kütüphaneler) bi sorunumuz var tabii açılmışı da açmak gerekiyor. Onu da açıklarsak Dinamik, hareket halinde olan, enerjik faal, durağan olmayan anlamlarına geliyor. Link te bildiğimiz bağlantı. Birleştirelim, Bağlantısı durağan olması gerekmeyen, dilediğimiz zaman bağlanıp işimiz bittikten sonra kopabileceğimiz kütüphane oluyor, Di-El-El. DLL lerin rutinleri başka programlar tarafından çağrılabilir ve programa derleme sırasında bağlanmazlar, program çalışırken istediğimiz bir anda DLL’e iş yaptırabilir.
DLL sayesinde bir çok program tarafından kullanılan işlemler tekbir DLL de bir sefer yazılabilir ve tüm programlar diledikleri anda DLL’e bu işleri yaptırabilirler, böylece fazla kodlamadan ve kargaşadan kurtulunmuş olur. Windows’un DLL ler üzerine kurulmuş olduğunu, ve DLL’in windows için herşey gibi bir şey olduğunu söylesem yalan olmaz. Bunu dikkate alın ve DLL ruhunu kavrarsanız Windows’a hakim olmaya başlıyorsunuz demektir. Hadi başlayalım.
Öncelikle Delphi nasıl DLL yapar ?
Delphi bir yazıyı derlemeden önce ilk satırı olan,
Program Project1;
Library Project1;
Unit Project1;
Gibi satırlara bakarak ona göre derleme yapar, zeki olanlar hemen anladılar tabii. Evet Bir DLL yapmak için
1-) Delphi’yi açalım, her zamanki gibi New Application diyelim bize Form ve Üzerinde Unit Unit1; yazılı kod penceremiz gelecektir. View ve Project Source dediğimizde bize Unit1 den başka ile düzey yazılarımızda da kullandığımz Proje kodları gelir. Burada
program Project1; ve diğer kodlaro göreceksiniz. program Project1; yazısının yerine Library Project1; yazarsanız ve Derlerseniz programınızın Exe değil DLL uzantısı ile derlendiğini göreceksiniz. İşte bir DLL yaptınız.
2-) Delphi’yi açalım sadece New diyelim, karşımıza Yeni oluşturabileceğimiz bir çok şey çıkacaktır biz şimdilik bunlardan DLL ile ilgilendiğimiz için DLL’i seçin (soldan 4.cü). Proje kod ekranı karşımıza çıkıyor save as deyip kaydedelim ve yine bir DLL oluşturdunuz.
Şimdi, oluşturduğumuz DLL ler hiçbir şey yapmıyor sadece oluşturmayı öğrendik. DLL’in içine ne yazarız ne yapabiliriz buna bakalım.
Baştan başlayalım, Delphi deyiz, New, ve oradan DLL yi seçelim. Kod pencersindeyiz.

library Project1;
uses
SysUtils,
Classes;
begin
end.
Yazıyor.
library Project1;
uses
SysUtils,
Classes;
function trscene:integer;export;
begin
result:=9;

KODLAR

Dosya Kopyalama (1)

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;

DOSYA KOPYALAMA 2

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); { Record size = 1 }
AssignFile(ToF, ToFile); { Open output file }
Rewrite(ToF, 1); { Record size = 1 }
repeat
BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
BlockWrite(ToF, Buf, NumRead, NumWritten);
until (NumRead = 0) or (NumWritten <> NumRead);
CloseFile(FromF);
CloseFile(ToF);
end;

Dosya Kopyalama (3)

procedure CopyFile(FromFileName, ToFileName: string);
var
FromFile, ToFile: File;
begin
AssignFile(FromFile, FromFileName); { Assign FromFile to FromFileName }
AssignFile(ToFile, ToFileName); { Assign ToFile to ToFileName }
Reset(FromFile); { Open file for input }
try
Rewrite(ToFile); { Create file for output }
try
if LZCopy(TFileRec(FromFile).Handle, TFileRec(ToFile).Handle) < 0
then
raise EInOutError.Create('Error using LZCopy')
finally
CloseFile(ToFile); { Close ToFile }
end;
finally
CloseFile(FromFile); { Close FromFile }
end;
end;

Directory Adı değiştirme

SysUtils unitesinin içindeki RenameFile function bu işi görmektedir.

Treeview componentinin durumunu kaydetme ve gösterme
Kaydetmek için

TreeView.SaveToFile('Dosya.adı');
Dosyayı açmak için
TreeView.LoadFromFile('Dosya.adı');
Dosyayı yanlızca okumak (read only) şeklinde açma
AssignFile(F, Dosya);
FileMode := 0; (read only modunda açmak}
Reset(F);
CloseFile(F);

Açılan dosyanın tarih ve zamanını ayarlamak

var
f: file;
begin
Assign(f, DirInfo.Name);
Reset(f);
SetFTime(f, Time);
Close(f);
end;
Deltree
{$I-} {$I+}
procedure delTree (DirName: string);
var
FileSearch: SearchRec;
begin
chDir (DirName);
FindFirst ('*.*', Directory, FileSearch);
while (DosError = 0) do begin
if (FileSearch.name <> '.') AND (FileSearch.name <> '..') AND
( (FileSearch.attr AND Directory) <> 0)
then begin
if DirName[length(DirName)] = '\' then
delTree (DirName+FileSearch.Name)
else
delTree (DirName+'\'+FileSearch.Name);
ChDir (DirName);
end;
FindNext (FileSearch)
end;

FindFirst ('*.*', AnyFile, FileSearch);
while (DosError = 0) do begin
if (FileSearch.name <> '.') AND (FileSearch.name <> '..') then
Remove (workdir);
end;
FindNext (FileSearch)
end;
rmDir (DirName)
end;

Dbgrid'de (Ctrl-Del diyince) dosya silmesini engelleme

if (ssctrl in shift) and (key=vk_delete) then
begin
key:=0;
end;

String'i renk'e renk'i stringe çevirme

Uses graphics;
form1.Color:=stringtocolor('121');
label1.caption:= ColorToString(form1.color);

Mouse'un yerini değiştirmek

randomize;
SetCursorPos(random(100),random(100));
ComboBox'ın aşağıya listelemesinin farklı bir yolu (DropComboBox)
SendMessage(ComboBox1.handle , 1039, 1, 0);

Başlığı Gizlemek ve Göstermek

Procedure HideTitlebar;
Var
Save : LongInt;
Begin
If form1.BorderStyle=bsNone then Exit;
Save:=GetWindowLong(form1.Handle,gwl_Style);
If (Save and ws_Caption)=ws_Caption then Begin
Case form1.BorderStyle of
bsSingle,
bsSizeable : SetWindowLong(form1.Handle,gwl_Style,Save and
(Not(ws_Caption)) or ws_border);
bsDialog : SetWindowLong(form1.Handle,gwl_Style,Save and
(Not(ws_Caption)) or ds_modalframe or ws_dlgframe);
End;
form1.Height:=form1.Height-getSystemMetrics(sm_cyCaption);
form1.Refresh;
End;
end;
Procedure ShowTitlebar;
Var
Save : LongInt;
begin
If form1.BorderStyle=bsNone then Exit;
Save:=GetWindowLong(form1.Handle,gwl_Style);
If (Save and ws_Caption)<>ws_Caption then Begin
Case form1.BorderStyle of
bsSingle,
cLabel1.Caption := 'Control'
else
if HiWord(GetKeyState(VK_MENU)) <> 0 then
Label1.Caption := 'Alt'
else
Label1.Caption := 'None';
end;

Formu taskbardan gizleme

ShowWindow(Application.Handle, SW_HIDE);

Silinmiş Dosyaları gösterme (DBF);

type
TForm1 = class(TForm)
Table1: TTable;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
CheckBox1: TCheckBox;
procedure CheckBox1Click(Sender: TObject);
public
procedure ShowDeleted(Table: TTable; ShowDeleted: Boolean);
end;
var
Form1: TForm1;
implementation
uses DBITYPES, DBIERRS, DBIPROCS;
{$R *.DFM}
procedure TForm1.ShowDeleted(Table: TTable; ShowDeleted: Boolean);
var
rslt: DBIResult;
szErrMsg: DBIMSG;
begin
Table.DisableControls;
try
Check(DbiSetProp(hDBIObj(Table.Handle), curSOFTDELETEON,
LongInt(ShowDeleted)));
finally
Table.EnableControls;
end;
Table.Refresh;
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
ShowDeleted(Table1, CheckBox1.Checked);
end;
end.

Form hakkında kısa bilgi

Form1.Show; {Formu göster}
Form1.Showmodal { Formu showmodal olarak göster (Showmodal iken başka hiçbir forma ulaşılamaz) }
myForm.Hide; {Formu gizle }
myForm.Free; {Formu sil }

Formu şeffaf hale getirilmesi

OnCreate olayına Brush.Style:=bsClear; yazmanız yeterli.
ESC tuşuyla programdan çıkma
OnKeyPress olayına if Key = #27 then halt; yazın.

Bir Resim Dosyası Açıp İçine Çizim Yapma

var
Resim: TBitmap;

Resim := TBitmap.Create;
with Resim do
try
Width := 100;
Height := 100;
with Canvas do
begin
Rectangle(0, 0, 100, 100);
MoveTo(0, 0);
LineTo(100, 100);
MoveTo(0, 100);
LineTo(100, 0);
end;
SaveToFile('test.bmp')
finally
Free;
end;
Asla Yazı Kutusundan Çıkamazsın
procedure TForm1.Edit1Exit(Sender: TObject);
begin
showmessage('Asla yazı kutusundan çıkamassın');
postmessage(handle,WM_NEXTDLGCTL,0,0);
postmessage(handle,WM_NEXTDLGCTL,1,0);
end;

Formun Boyutlarını Sabitleme

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
TForm1 = class(TForm)
private
{ Private declarations }
public
procedure WMGetMinMaxInfo( var Message :TWMGetMinMaxInfo ); message WM_GETMINMAXINFO;
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WMGetMinMaxInfo( var Message :TWMGetMinMaxInfo );
begin
with Message.MinMaxInfo^ do
begin
ptMaxSize.X := 200;
ptMaxSize.Y := 200;
ptMaxPosition.X := 99;
ptMaxPosition.Y := 99;
ptMinTrackSize.X := 100;
ptMinTrackSize.Y := 100;
ptMaxTrackSize.X := 300;
ptMaxTrackSize.Y := 300;
end;
Message.Result := 0;
inherited;
end;

end.

Windows'a True Type Font Ekleme

uses Registry;
procedure TForm1.Button1Click(Sender: TObject);
var
reg: TRegistry;
b : bool;
begin CopyFile('C:\DOWNLOAD\FP000100.TTF', 'C:\WINDOWS\FONTS\FP000100.TTF', b);
reg := TRegistry.Create; reg.RootKey := HKEY_LOCAL_MACHINE;
reg.LazyWrite := false; reg.OpenKey('Software\Microsoft\Windows\CurrentVer sion\Fonts', false); reg.WriteString('TESTMICR (TrueType)','FP000100.TTF');
reg.CloseKey; reg.free;
AddFontResource('c:\windows\fonts\FP000100.TTF'); SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
RemoveFontResource('c:\windows\fonts\FP000100.TTF' ); SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
end;

Dosya Taşıma

MoveFile('C:\Source\sourcefile.txt', 'C:\Dest\destfile.txt');

Trim Fonksiyonunun açılımı

unit StrFunc;
interface
procedure LTrim(var s : string);
procedure RTrim(var s : string)
;procedure Trim(var s : string);
implementation
{$R *.DFM}
procedure LTrim(var s : string);
begin
while ((length(s) > 0) and (s[1] = #32)) do Delete(s, 1, 1);
end;
procedure RTrim(var s : string);
begin
while ((length(s) > 0) and (s[Length(s)] = #32)) do Delete(s, Length(s), 1);
end;
procedure Trim(var s : string);
begin
LTrim(s); RTrim(s);
end;

Screen Capture Programı (Ekran Çalma)
Bir tane image componenti eklemek zorundasınız.

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;

Sağa yada Sola hizalama function'u

function hiza(sagsol,yer:string;sayi:integer):string;
var
i,bosluk,uzunluk:integer;
begin
trim(yer); //Boşlukları temizle
uzunluk:=length(yer); //Verilen stringin uzunluğunu öğren
bosluk:=sayi-uzunluk; //Verilen sayıdan uzunluğu çıkar
if sagsol='sag' then begin //Sağamı solamı yaslancağını öğren
for i:=1 to bosluk do begin //Fark kadar sağa boşluk ekle
yer:=' '+yer; //Boşluk ekle
end;
result:=yer; //Sonucu bildir
exit;
end;
if sagsol='sol' then
begin
trim(yer);
for i:=1 to bosluk do begin //Fark kadar sola ekle
yer:=yer+' ';
end;
result:=yer; //Sonucu bildir
exit;
end;

Sayıyı virgüllü yazma functionu
Bunun için forma birtana label componenti yerleştirin ve visible özeliğini false yapın.

function frmt(yer:string):string;
var
s:string;
uzunluk:integer;
kalan,k,dgr:integer;
begin
s:='.';
uzunluk:=Length(yer);
dgr:=uzunluk div 3;
kalan:=uzunluk - (dgr*3);
label1.caption:=inttostr(kalan);
if yer='0' then
begin
yer:='0,';
result:=yer;
exit;
end;
if label1.caption<>'0' then
begin
insert(s,yer,kalan+1);
for k:=1 to dgr do begin
if k=dgr then begin
insert(',',yer,(kalan +(k*3)+k+1));
result:=yer;
exit;
end;
insert(s,yer,(kalan +(k*3)+k+1));
end;
end;

Comp değerindeki bir sayıyı string yapma

function Comp2Str(N: Comp): String;
var
TS: String;
begin
Str(N:0:0, TS);Comp2Str := TS;
end;

Dosya açılış yolları

Windows programının açılışı
WinExec('C:\WINDOWS\NOTEPAD.EXE', SW_SHOWNORMAL);

Komut satırı ile birlikte :
WinExec('C:\WINDOWS\NOTEPAD.EXE C:\WINDOWS\WIN.INI', SW_SHOWNORMAL);

Pop Up dos kutusuyla :
WinExec('COMMAND.COM', SW_SHOWNORMAL);

Normal bir dos programının komutla açılışı
WinExec('COMMAND.COM /C DIR *.*', SW_SHOWNORMAL);

Dekstop'ı refresh etmek

procedure TForm1.Button1Click(Sender: TObject);
begin
SendMessage(FindWindow('Progman', 'Program Manager'), WM_COMMAND,$A065, 0);
end;

Programın windows'la birlikte açılması

uses Registry, {For Win32}
IniFiles; {For Win16}
{$IFNDEF WIN32}
const
MAX_PATH = 144;
{$ENDIF}
{For Win32}
procedure TForm1.Button1Click(Sender: TObject);
var
reg: TRegistry;
begin
reg := TRegistry.Create;
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.LazyWrite := false; reg.OpenKey('Software\Microsoft\Windows\CurrentVer sion\Run', false); reg.WriteString('My App', Application.ExeName);
reg.CloseKey;
reg.free;
end;

Formun ara çubuğunu gizleme

procedure TForm1.FormCreate(Sender: TObject);
begin
SetWindowLong(Form1.Handle,GWL_STYLE,GetWindowLong (Handle,GWL_STYLE) and not WS_CAPTION);
Height := ClientHeight;
end;

Flash icon

var Flash : bool;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
FlashWindow(Form1.Handle, Flash);
FlashWindow(Application.Handle, Flash); Flash := not Flash;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Flash := False;
end;
Taskbar'ın handle sayısı
hTaskbar := FindWindow('Shell_TrayWnd', Nil );