O anki surucunun kapasitesini ve surucudeki boş yer miktarını bulmak DiskFree(0) //o anki surucudeki boş yer miktarını byte cinsinden dondurur. DiskSize(0) //o anki surucunun kapasitesini byte cinsinden dondurur. DiskSize(0) div 1024 //o anki surucunun kapasitesini KB cinsinden dondurur. Bir menu oğesinin enabled ozelliğini false yapmak mainmenu1.items[0].items[1].enabled:=False; Bir programın calıştırılması Kod:
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 secili bir veya birden fazla oğeyi secilmemiş duruma getirmek icin Alıntı:
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');
Bir string'in başındaki ve sonundaki boşlukları atmak icin Trim(string) TrimLeft (string) //stringin sadece başındaki boşlukları atmak icin TrimRight (string) //stringin sadece sonundaki boşlukları atmak icin Şifreli bir table icin programın şifre istememesi icin Table'ın Active ozelliğini False yapın ve Form'un OnCreate olayına aşağıdaki kodu ekleyin Kod:
Session.AddPassword('şifre'); Table1.Active:=True;
Pencereyi minimize etmek Kod:
Application.Minimize; //taskbar'a minimize CloseWindow(handle) WindowState := wsMinimized;
Harddiskin seri numarasının bulunması Alıntı:
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'u kapatmak veya yeniden başlatmak(reboot) Alıntı:
var i:dword; begin ExitWindowsEx(EWX_SHUTDOWN); //yeniden başlatmak icin EWX_REBOOT end;
ico'dan bmp'ye cevirme Kod:
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 surucuyu acmak ve kapamak uses kısmına MMSystem unitini ekleyin. Kod:
mciSendString('Set cdaudio door open wait', nil, 0, handle); //ac mciSendString('Set cdaudio door closed wait', nil, 0, handle); //kapa
CapsLock ve Numlock tuşlarını acıp-kapama Kod:
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 icin VK_CAPITAL yerine VK_NUMLOCK yazınız. Menu'ye bitmap (resim) ekleme Kod:
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 end;
Windows ve System klasorlerinin bulunması Kod:
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 cıkartma MessageBeep(word(-1)); Belgeler menusune bir dosya eklemesı uses kısmına ShlOBJ unitini ekleyin; Kod:
procedure TForm1.Button1Click(Sender: TObject); var s : string; begin s := 'C:\DownLoad\deneme.html'; SHAddToRecentDocs(SHARD_PATH, pChar(s)); end;
Belgeler menusunu temizlemesı uses kısmına ShlOBJ unitini ekleyin; Alıntı:
SHAddToRecentDocs(SHARD_PATH, nil);
Bir web adresini acması uses kısmına Shellapi unitini ekleyin Kod:
ShellExecute(Handle, 'open', 'http://www.yahoo.com', nil, nil, sw_ShowMaximized);
Bir DOS programını calıştırma ve calışması bitince penceresini kapatma Kod:
WinExec("command.com /c progdos.exe",sw_ShowNormal); //progdos.exe
calıştırılıyor. //eğer ikinci paremetreyi sw_Hide yaparsanız kullanıcı programın calıştığını gormez. Uygulamanızın Gorev Cubuğundaki butonunu gizleme Uygulamanızın Gorev Cubuğundaki butonunu gizlemek icin programınızın ana formunun OnCreate olayına aşağıdaki kodu yazın; Kod:
SetWindowLong(Application.Handle,GWL_EXSTYLE, WS_EX_TOOLWINDOW);
Ekran koruyucusunu kapatmak ve acmak //kapatmak icin Kod:
SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, 0, nil, 0); //acmak icin SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, 1, nil, 0);
Alt+F4 tuş kombinasyonuyla programın kapanmaması icin Formun OnCreate olayına; Kod:
KeyPreview := true; Formun OnKeyDown olayına; if ((ssAlt in Shift) and (Key = VK_F4)) then Key := 0;
Hareketli İmlec(animated cursor)leri kullanma Kod:
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; Kod:
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', 'Ayşe ve Fatma team')); Memo1.Lines.Add(reg.ReadString('USER INFO', 'Company', 'Bilgisayar Bilimleri Muh.')); reg.free; end;
Cok Satırlı İpucu Kod:
procedure TForm1.FormCreate(Sender: TObject); begin SpeedButton1.Hint:='Cok satırlı ipucunu '+chr(13] 'mutlaka denemelisiniz '+chr(13] 'cok guzel'; end;
Edit'e girilen metnin ilk harfini buyuk harf yapma Form'a bir Edit componenti yerleştirin ve OnKeyPress olayına aşağıdaki kodu ekleyin. Kod:
with Sender as TEdit do if (SelStart = 0) or (Text[SelStart] = ' ') then if Key in ['a'..'z'] then Key := UpCase(Key);
Bir klasoru ve onun altındaki tum dosyaları ve klasorleri silme Ancak salt okunur (read only) ozelliği olan ve kullanımda olan dosyalar silinmez. Kod:
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 klasoru silinemiyor!!!'); end;
Başlat butonunu gizlemek veya kullanılmaz hale getirmek Kod:
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;
Kod:
procedure TForm1.Button2Click(Sender: TObject); begin //Gizlenen Başlat butonunu eski haline dondurmek icin SetWindowRgn(FindWindowEx(FindWindow('Shell_TrayWn d', nil), 0, 'Button', nil), 0, true); end;
Kod:
procedure TForm1.Button3Click(Sender: TObject); begin //Başlat butonunu kullanılmaz yap EnableWindow(FindWindowEx(FindWindow('Shell_TrayWn d', nil), 0, 'Button', nil), false); end;
Kod:
procedure TForm1.Button4Click(Sender: TObject); begin //Kullanılmaz yapılan Başlat butonunu eski haline getirmek icin EnableWindow(FindWindowEx(FindWindow('Shell_TrayWn d', nil), 0, 'Button', nil), true); end;
Windows Gezginini istediğiniz bir klasorle acma uses kısmına Shellapi unitini ekleyin. Kod:
ShellExecute(0, 'explore', 'C:\WINDOWS', //acmak istediğiniz dizin nil, nil, SW_SHOWNORMAL);
Duvar kağıdını değiştirmek Kod:
var s: string; begin s := 'c:\windows\athena.bmp'; SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, PChar(s),0);
Form'un arka kısmına bir resmi doşemek Kod:
Bitmap: TBitmap; procedure TForm1.FormCreate(Sender: TObject); begin Bitmap := TBitmap.Create; Bitmap.LoadFromFile('C:\WINDOWS\cars.BMP'); end;
Kod:
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ı calıştırmak Control Panel uygulamaları Windows\System klasoru altında bulunur. *.CPL uzantılı dosyalardır. Bu uygulamaları Control.Exe programı ile calıştırabilirsiniz. Bazı Control Panel uygulamaları Windows\System klasorunde bulunmaz. Bunların ismini vererek calıştırabilirsiniz. Kod:
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ı virgullerle yazmak Sayı windows'unuz ayarına gore 12.345.678 veya 12,345,678 şeklinde gosterilir. Kod:
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 icin SetLocalTime fonksiyonunu kullanabilirsiniz. Kod:
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 gostermek Kod:
try Screen.Cursor := crHourGlass; finally Screen.Cursor := crDefault; end; Application.ProcessMessages;
Ekran Goruntusunu Aktarma Belirttiğiniz sınırlar dahilinde ekranın belli bir alanını formunuzun uzerine koymak isterseniz. Formunuza image1 adlı bir resim objesi ekleyin ve daha sonra formunuzun create olayına şu kodu yazın. Kod:
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 Gosterme Windows programlarında bir alttaki alana gecmek icin TAB tuşu kullanılır.Ancak DOS programlarından gelen alışkanlıkla kullanıcılar hep Enter ile alt alana gecmek ister ve bu bir tik olmuştur. Delphide Enter tuşu ile bir alt alana gecmek icin bir yontem; • Formun Keypreview olayını True yapılır. • Form uzerinde herhangiki tum bileşenlere Default false yaplır. • formun onKeypres olayına aşağıdaki function ilave edilir. Kod:
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. Kod:
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 kac 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 gore polgon hesaplanır. Hesaplanan Handle ile herhangi bir form'a bu polyon şekli verilebilir. Polgon dışında kalan grafikler yarım veya hic gozukmez. İmlecin o anda ekranın neresinde olduğunu bulan ufak bir kod parcası Kod:
procedure TForm1.Button1Click(Sender: TObject); var Yer:TPoint; begin if Assigned(ActiveControl) then begin Yer:=Point(0,0); ActiveControl.ClientToScreen(Yer); SetCursorPos(Yer.X,Yer.Y); end; end;
__________________
Delphi Bazı Yararlı Kodlar
Delphi0 Mesaj
●54 Görüntüleme
- ReadBull.net
- Programlama ve Yazılım
- Programlama Dilleri
- Delphi
- Delphi Bazı Yararlı Kodlar