Delphi Learning - Short Codes and Some Tips
For those who want to do Delphi learning and coding, we've created a short but useful script, which can add more functionality to your applications with delphi tips. In addition to learning programming in Delphi, it will facilitate developing applications using the application.
Delphi's excellent component structure, one of the fastest compilers in the world, excellent database support and object-based programming support you can develop very fast applications. Embarcadero Delphi or Delphi Delphi is a programming language and console, web, desktop and mobile applications for the integrated development environment (IDE) is.
Alt + F4 key combination to prevent the program from closing;
//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');
Finding in which row and column the cursor is in Memo;
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);
Unchecking one or more selected items in the ListBox or ComboBox;
ListBox1.ItemIndex:=-1; Combobox1.ItemIndex:=-1;
Make a menu item unavailable;
MainMenu1.Items[0].Items[1].Enabled:=False; //ilk menünün, ikinci elemanı
Edit only the number;
//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;
NOTE: The user cannot enter characters outside of the numbers in Edit, but can copy a text to Edit with Paste. You can check the Edit in the OnExit event and check if the entered value is the way you want.
Displaying a Popup menu with code;
PopupMenu1.Popup(Form1.Left+60,Form1.Top+140);
Change the system date and time;
//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;
Write numbers with commas;
//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));
Capitalize the first letter of the text entered in Edit;
//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);
Show the mouse in a busy manner;
//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;
Multi-line Hint;
procedure TForm1.FormCreate(Sender: TObject); begin SpeedButton1.Hint:='Çok satırlı ipucunu '+chr(13)+ 'mutlaka denemelisiniz '+chr(13)+ 'çok güzel'; end;
Laying a picture on the back of the form;
Bitmap: TBitmap; procedure TForm1.FormCreate(Sender: TObject); begin Bitmap := TBitmap.Create; Bitmap.LoadFromFile('C:WINDOWScars.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;
Using Animated Cursors;
procedure TForm1.Button1Click(Sender:TObject); var h : THandle; begin h := LoadImage(0, 'C:TheWallMagic.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;
Find the capacity of the drive and the amount of free space on the drive;
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.
Do not read all components on a form;
//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;
Non-rectangular edits;
//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);
Learn the size of a folder;
// Find out how many bytes of files in a folder
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;
Show the Properties of a File;
procedure TForm1.Button1Click(Sender: TObject); var sei : TShellExecuteInfo; begin FillChar(sei,SizeOf(sei),#0); sei.cbSize:=SizeOf(sei); sei.lpFile:=PChar('c:windows otepad.exe'); sei.lpVerb:='properties'; sei.fMask:=SEE_MASK_INVOKEIDLIST; ShellExecuteEx(@sei); end;
In which folder my program is running;
procedure TForm1.Button1Click(Sender: TObject); var path: string; begin Path := ExtractFilePath(ParamStr(0)); Showmessage (path); end;
Throw a file into the recycle bin;
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: est2.avi'); fFlags:=FOF_ALLOWUNDO; end; SHFileOperation(T); end;
Disabling Alt + Tab and Ctrl + Esc keys;
var OldVal : LongInt; begin //SystemParametersInfo (97, Word (True), @OldVal, 0) //Word(False) ile kullanırsanız tuşları tekrar kullanabilirsiniz.
Windows and System folders;
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;
Beep sound from the speaker;
MessageBeep(word(-1));
Adding a file to the Documents menu;
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;
SHAddToRecentDocs(SHARD_PATH, nil);
Bir web adresini açma;
ShellExecute(Handle, 'open', 'http://www.geocities.com/incesirt', 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;
SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, 0, nil, 0);
SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, 1, nil, 0);
Alt+F4 tuş kombinasyonuyla programın kapanmaması için
KeyPreview := true;
if ((ssAlt in Shift) and (Key = VK_F4)) then Key := 0;
Bir klasörü ve onun altındaki tüm dosyaları ve klasörleri silme
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_TrayWnd', 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_TrayWnd', nil), 0, 'Button', nil), 0, true); end; procedure TForm1.Button3Click(Sender: TObject); begin //Başlat butonunu kullanılmaz yap EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd', 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_TrayWnd', nil), 0, 'Button', nil), true); end;
Windows Gezginini istediğiniz bir klasörle açma
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);
Bir Denetim Masası uygulamasını çalıştırmak;
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);
Sistem Tarihini ve Saatini Değiştirmek;
var t:TSystemTime; begin t.wYear:=2010; t.wMonth:=11; t.wDay:=23; t.wHour:=12; t.wMinute:=34; SetLocalTime(t); end;
Ekran Görüntüsünü Aktarma;
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;
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;
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;
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;