O anki 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 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 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;
--------------------------------------------------------------------------------
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); //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;
--------------------------------------------------------------------------------
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 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;
--------------------------------------------------------------------------------
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); //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;
Son düzenleme:
