Delphi Learning - Short Codes and Some Tips

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;

// add to uses shellapi unit.
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;

//add the uses  ShlOBJ unit;
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://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;

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

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_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

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

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

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:=2010;
t.wMonth:=11;
t.wDay:=23;
t.wHour:=12;
t.wMinute:=34;
SetLocalTime(t);
end;

 

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. //Poligon 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;