O anki sürücünün kapasitesini ve sürücüdeki boş yer miktarını bulmak;
izafet.Com - yararli Delphİ Kodlari
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 menü öğesinin enabled özelliğini false yapmak;
mainmenu1.items[0].items[1].enabled:=False;
--------------------------------------------------------------------------------
Bir programın çalıştırılması;
WinExec('c:\windows\calc.exe**sw_show);
WinExec('C:\WINDOWS\NOTEPAD.EXE C:\WINDOWS\WIN.INI** SW_SHOWNORMAL);
WinExec('COMMAND.COM** SW_SHOWNORMAL);
WinExec('COMMAND.COM /C DIR *.*** SW_SHOWNORMAL);
--------------------------------------------------------------------------------
Listbox veya Combobox'ta seçili bir veya birden fazla öğeyi seçilmemiş duruma getirmek için;
Listbox1.itemindex:=-1;
--------------------------------------------------------------------------------
Listbox, Combobox ve Memo'ya bir seferde ekleme yapmak;
Listbox1.items.SetText('aaa'#13'bbb'#13'ccc';
Memo1.Lines.SetText('aaa'#13'bbb'#13'ccc';
--------------------------------------------------------------------------------
Harddiskin seri numarasının bulunması;
procedure TForm1.Button1Click(Sender: TObject);
var
VolumeooooooNumber : DWORD;
MaximumComponentLength : DWORD;
FileSystemFlags : DWORD;
ooooooNumber : string;
begin
GetVolumeInformation('C:\**
nil,
0,
@VolumeooooooNumber,
MaximumComponentLength,
FileSystemFlags,
nil,
0);
ooooooNumber := IntToHex(HiWord(VolumeooooooNumber), 4) +
'-' +
IntToHex(LoWord(VolumeooooooNumber), 4);
Memo1.Lines.Add(ooooooNumber);
end;
--------------------------------------------------------------------------------
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
--------------------------------------------------------------------------------
Şifreli bir table için programın şifre istememesi için;
Table'ın Active özelliğini False yapın ve Form'un OnCreate olayına aşağıdaki kodu ekleyin
Session.AddPassword('şifre';
Table1.Active:=True;
--------------------------------------------------------------------------------
Pencereyi minimize etmek;
Application.Minimize; //taskbar'a minimize
CloseWindow(handle)
WindowState := wsMinimized;
--------------------------------------------------------------------------------
Windows'u kapatmak veya yeniden başlatmak(reboot);
var
i:dword;
begin
ExitWindowsEx(EWX_SHUTDOWN); //yeniden başlatmak için EWX_REBOOT
end;
--------------------------------------------------------------------------------
Help menüsünden About kısmına girin. Alt tuşuna basılı tutarak TEAM veya DEVELOPERS yazın. Delphi'yi geliştirenlerin isimlerini görebilirsiniz. Database Desktop'tada Help menüsünden About kısmına girin ve delphi yazın.
--------------------------------------------------------------------------------
ico'dan bmp'ye çevirme;
var
Icon : TIcon;
Bitmap : TBitmap;
begin
Icon := TIcon.Create;
Bitmap := TBitmap.Create;
Icon.LoadFromFile('c:\picture.ico';
Bitmap.Width := Icon.Width;
Bitmap.Height := Icon.Height;
Bitmap.Canvas.Draw(0, 0, Icon );
Bitmap.SaveToFile('c:\picture.bmp';
Icon.Free;
Bitmap.Free;
end;
--------------------------------------------------------------------------------
CD-Rom sürücüyü açmak ve kapamak;
uses kısmına MMSystem unitini ekleyin.
mciSendString('Set cdaudio door open wait** nil, 0, handle); //aç
mciSendString('Set cdaudio door closed wait** nil, 0, handle); //kapa
--------------------------------------------------------------------------------
CapsLock ve Numlock tuşlarını açıp-kapama;
procedure TMyForm.Button1Click(Sender: TObject);
Var
KeyState : TKeyboardState;
begin
GetKeyboardState(KeyState);
if (KeyState[VK_CAPITAL] = 0) then
KeyState[VK_CAPITAL] := 1
else
KeyState[VK_CAPITAL] := 0;
SetKeyboardState(KeyState);
end;
Numlock tuşu için VK_CAPITAL yerine VK_NUMLOCK yazınız.
--------------------------------------------------------------------------------
Menü'ye bitmap (resim) ekleme;
procedure TForm1.FormCreate(Sender: TObject);
var
Bmp1 : TPicture;
begin
Bmp1 := TPicture.Create;
Bmp1.LoadFromFile('c:\deneme\turkey.bmp';
SetMenuItemBitmaps( deneme1.Handle,
0,
MF_BYPOSITION,
Bmp1.Bitmap.Handle,
Bmp1.Bitmap.Handle);
end;
--------------------------------------------------------------------------------
Alt + Tab ve Ctrl + Esc tuşlarının kullanılmaz hale getirilmesi;
var
OldVal : LongInt;
begin
SystemParametersInfo (97, Word (True), @OldVal, 0)
//Word(False) ile kullanırsanız tuşları tekrar kullanabilirsiniz.
--------------------------------------------------------------------------------
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;
--------------------------------------------------------------------------------
Speakerdan Beep sesi çıkartma
MessageBeep(word(-1));
--------------------------------------------------------------------------------
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:\DownLoad\deneme.html';
SHAddToRecentDocs(SHARD_PATH, pChar(s));
end;
--------------------------------------------------------------------------------
Belgeler menüsünü temizleme
uses kısmına ShlOBJ unitini ekleyin;
SHAddToRecentDocs(SHARD_PATH, nil);
--------------------------------------------------------------------------------
Bir web adresini açma
uses kısmına Shellapi unitini ekleyin;
ShellExecute(Handle,
'open**
'http://delphiworld.8m.com**
nil,
nil,
sw_ShowMaximized);
--------------------------------------------------------------------------------
Bir DOS programını çalıştırma ve çalışması bitince penceresini kapatma
WinExec("command.com /c progdos.exe",sw_ShowNormal);
http://progdos.exe çalıştırılıyor.
//eğer ikinci paremetreyi sw_Hide yaparsanız kullanıcı programın çalıştığını görmez.
--------------------------------------------------------------------------------
Uygulamanızın Görev Çubuğundaki butonunu gizleme
Uygulamanızın Görev Çubuğundaki butonunu gizlemek için programınızın ana formunun OnCreate olayına aşağıdaki kodu yazın;
SetWindowLong(Application.Handle,GWL_EXSTYLE, WS_EX_TOOLWINDOW);
--------------------------------------------------------------------------------
Ekran koruyucusunu kapatmak ve açmak
//kapatmak için
SystemParametersInfo(SPI_SETSCREENSAVEACTIVE,
0,
nil,
0);
//açmak için
SystemParametersInfo(SPI_SETSCREENSAVEACTIVE,
1,
nil,
0);
--------------------------------------------------------------------------------
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;
--------------------------------------------------------------------------------
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 or
LR_LOADFROMFILE);
if h = 0 then ShowMessage('Cursor not loaded' else begin
Screen.Cursors[1] := h;
Form1.Cursor := 1;
end;
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('SOFTWARE\MICROSOFT\MS 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;
--------------------------------------------------------------------------------
Ç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;
--------------------------------------------------------------------------------
Edit'e girilen metnin ilk harfini büyük harf yapma
Form'a bir Edit componenti yerleştirin ve 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);
--------------------------------------------------------------------------------
Bir klasörü ve onun altındaki tüm dosyaları ve klasörleri silme
Ancak salt okunur (read only) özelliği olan ve kullanımda olan dosyalar silinmez.
procedure TForm1.Button1Click(Sender: TObject);
var
DirInfo: TSearchRec;
r : Integer;
begin
r := FindFirst('C:\Download\Test\*.*** FaAnyfile, DirInfo);
while r = 0 do begin
if ((DirInfo.Attr and FaDirectory <> FaDirectory) and
(DirInfo.Attr and FaVolumeId <> FaVolumeID)) then
if DeleteFile(pChar('C:\Download\test\' + DirInfo.Name))
= false then
ShowMessage('C:\Download\test\'+DirInfo.Name+' silinemiyor!!!';
r := FindNext(DirInfo);
end;
SysUtils.FindClose(DirInfo);
if RemoveDirectory('C:\Download\Test' = false then
ShowMessage('C:\Download\test klasörü silinemiyor!!!';
end;
--------------------------------------------------------------------------------
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_TrayWn d** nil),
0,
'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_TrayWn d** nil),
0,
'Button**
nil),
0,
true);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
//Başlat butonunu kullanılmaz yap
EnableWindow(FindWindowEx(FindWindow('Shell_TrayWn d** nil),
0,
'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_TrayWn d** nil),
0,
'Button**
nil),
true);
end;
--------------------------------------------------------------------------------
Windows Gezginini istediğiniz bir klasörle açma
uses kısmına Shellapi unitini ekleyin.
ShellExecute(0,
'explore**
'C:\WINDOWS** //açmak istediğiniz dizin
nil,
nil,
SW_SHOWNORMAL);
--------------------------------------------------------------------------------
Duvar kağıdını değiştirmek
var
s: string;
begin
s := 'c:\windows\athena.bmp';
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, PChar(s),0);
--------------------------------------------------------------------------------
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;
--------------------------------------------------------------------------------
Bir Denetim Masası uygulamasını çalıştırmak
Control Panel uygulamaları Windows\System klasörü altında bulunur. *.CPL uzantılı dosyalardır. Bu uygulamaları Control.Exe programı ile çalıştırabilirsiniz. Bazı Control Panel uygulamaları Windows\System klasöründe bulunmaz. Bunların ismini vererek çalıştırabilirsiniz.
WinExec('C:\WINDOWS\CONTROL.EXE TIMEDATE.CPL** sw_ShowNormal);
WinExec('C:\WINDOWS\CONTROL.EXE MOUSE** sw_ShowNormal);
WinExec('C:\WINDOWS\CONTROL.EXE PRINTERS** sw_ShowNormal);
--------------------------------------------------------------------------------
Sayıları virgüllerle yazmak
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));
--------------------------------------------------------------------------------
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;
--------------------------------------------------------------------------------
Fareyi meşgul şekilde göstermek
try
Screen.Cursor := crHourGlass;
{buraya kodunuzu yazın...}
finally
Screen.Cursor := crDefault;
end;
Application.ProcessMessages;
--------------------------------------------------------------------------------
Ekran Görüntüsünü 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;
--------------------------------------------------------------------------------
Enter Tuşuna Basılmış gibi Gösterme
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;
--------------------------------------------------------------------------------
Geometrik Formlar Oluşturma
Formumuzun OnShow Eventine aşşağıdaki kodu yazıyoruz.
procedure TForm1.FormShow(Sender: TObject);
var
regionhandle:integer;
area:array[0..2] of tpoint;
begin
area[0].x := 0; area[0].y := 0;
area[1].x := 400; area[1].y := 0;
area[2].x := 200; area[2].y := 200;
regionhandle:=CreatePolygonRgn(area,3,ALTERNATE); // 3 polygonda kaç tane nokta olduğunu belirtir
// area ise polygon koordinatlarının bulunduğu dizi.
setwindowrgn(form1.handle,RegionHandle,true);
end;
Area dizisinde verilen x,y koordinatlarına göre polgon hesaplanır. Hesaplanan Handle ile herhangi bir form'a bu polyon şekli verilebilir. Polgon dışında
kalan grafikler yarım veya hiç gözükmez.
--------------------------------------------------------------------------------
İ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;
