Gönderen Konu: Delphi Örnekler  (Okunma sayısı 2045 defa)

0 Üye ve 1 Ziyaretçi konuyu incelemekte.

Çevrimdışı Blue

  • Aktif Üye
  • ***
  • İleti: 248
  • Konu Sayısı: 135
  • Toplam Puanı: 45
  • Cinsiyet: Bay
    • www.sanalpusula.net

Delphi Örnekler
« : 10.06.2008-21:43:21 »
          

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

Memo içinde imlecin hangi satır ve kolonda olduğunu bulma
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);

ListBox veya ComboBox'ta seçili bir veya birden fazla öğeyi seçilmemiş hale getirme
ListBox1.ItemIndex:=-1;
Combobox1.ItemIndex:=-1;

Bir menü öğesini kullanılamaz hale getirmek
MainMenu1.Items[0].Items[1].Enabled:=False;  //ilk menünün, ikinci elemanı

Edit'e sadece sayı girilsin
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;
NOT: Kullanıcı Edit'e rakamların dışında karakter giremez, ancak Paste ile Edit'e bir metni kopyalayabilir. Bunuda Edit'in OnExit olayında kontrol edip, girilen değerin istediğiniz şekilde olup olmadığını kontrol edebilirsiniz.

Bir Popup menüyü kod ile gösterme

PopupMenu1.Popup(Form1.Left+60,Form1.Top+140);

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;

Sayıları virgüllerle yazmak
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));

  Edit'e girilen metnin ilk harfini büyük harf yapma
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);

Fareyi meşgul şekilde göstermek
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;

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

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;

 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;

 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 form üzerindeki tüm bileşenleri read only(salt okunur) yapma
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;

Dikdörtgen olmayan Edit'ler 
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);

Bir klasörün boyutunu öğrenmek
Bir klasördeki dosyaların kaç byte yer kapladığını öğrenmek için
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;

Bir dosyanın özelliklerini gösterme
procedure TForm1.Button1Click(Sender: TObject);
var
  sei : TShellExecuteInfo;
begin
  FillChar(sei,SizeOf(sei),#0);
  sei.cbSize:=SizeOf(sei);
  sei.lpFile:=PChar('c:\windows\notepad.exe');
  sei.lpVerb:='properties';
  sei.fMask:=SEE_MASK_INVOKEIDLIST;
  ShellExecuteEx(@sei);
end;

Programım hangi klasörde çalışıyor
procedure TForm1.Button1Click(Sender: TObject);
var
  path: string;
begin
  Path := ExtractFilePath(ParamStr(0));
  Showmessage (path);
end;

Bir doyayı geri dönüşüm kutusuna (recyle bin) atmak

uses kısmına shellapi unitini ekleyin.
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:\test\2.avi');
      fFlags:=FOF_ALLOWUNDO;
    end;
  SHFileOperation(T);
end;

Bir dosyanın boyutunu bulmak
procedure TForm1.Button1Click(Sender: TObject);
var
  srFileSR: TSearchRec;
  sFileName, sFileSize: string;
begin
  sFileName := 'c:\test\2.avi';
  FindFirst(sFileName,faAnyFile,srFileSR);
  sFileSize := IntToStr(srFileSR.Size);
  Showmessage(sFileSize);
end;

Bmp dosyasını JPEG'e dönüştürme

uses kısmına jpeg unitini ekleyin.
procedure TForm1.Button1Click(Sender: TObject);
var
  MyJPEG : TJPEGImage;
  MyBMP : TBitmap;
begin
  MyBMP := TBitmap.Create;
  with MyBMP do
    try
      LoadFromFile('c:\winnt\ACD Wallpaper.bmp');
      MyJPEG := TJPEGImage.Create;
      with MyJPEG do begin
        Assign(MyBMP);
        SaveToFile('c:\winnt\ACD Wallpaper.JPEG');
        Free;
      end;
  finally
    Free;
  end;
end;    


SanalPusula.Net - Etiketler
Delphi Örnekler,