Gönderen Konu: Delphi Örnekler 2  (Okunma sayısı 1639 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 2
« : 10.06.2008-21:50:53 »
          

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

Duvar kağıdını değiştirmek
var
  s: string;
begin
  s := 'c:\windows\athena.bmp';
  SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, PChar(s),0);

 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;

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

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;

 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;

 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',
                                 'Kemal GÖK'));
  Memo1.Lines.Add(reg.ReadString('USER INFO',
                                 'DefCompany',
                                 'Bilgisayar Programcısı'));
  reg.free;
end;

 Speakerdan Beep sesi çıkartma
MessageBeep(word(-1));

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

Windows'u kapatmak veya yeniden başlatmak(reboot)

  ExitWindowsEx(EWX_SHUTDOWN,0);     //yeniden başlatmak için EWX_REBOOT

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

Ekran kartım kaç rengi destekliyor
Ekran kartınızın kaç rengi desteklediğini aşağıdaki kodla bulabilirsiniz.
(1 shl (GetDeviceCaps(Form1.Canvas.Handle, BITSPIXEL) *  
          GetDeviceCaps(Form1.Canvas.Handle, PLANES)));

 Windows Gezginini istediğiniz bir klasörle açma
uses kısmına ShellApi unitini ekleyin.
ShellExecute(0,
                  'explore',
                  'C:\WINDOWS',   //buraya açmak istediğiniz klasörü yazın.
                  nil,
                  nil,
                  SW_SHOWNORMAL);

Windows'un Bul (Find File) diyalog penceresini istediğiniz bir klasörle açma
Windows'ta Başlat->Bul->Dosyalar ve Klasörler ile açtığınız Bul diyalog penceresini Delphi içerisinden hem de istediğiniz yolu vererek çalıştırabilirsiniz.
uses kısmına ddeman unitini ekleyin.
procedure TForm1.Button1Click(Sender: TObject);
begin
  with TDDEClientConv.Create(Self) do begin
    ConnectMode := ddeManual;
    ServiceApplication := 'explorer.exe';
    SetLink( 'Folders', 'AppProperties');
    OpenLink;
    ExecuteMacro('[FindFolder(, C:\DOWNLOAD)]', False);  //diyalog açıldığında konum kısmında
    CloseLink;                                                             //olmasını istediğiniz klasör.
    Free;
  end;
end;

Pencerenin kapatma düğmesini etkisiz hale getirme
Pencerenin başlık çubuğunda bulunan kapatma düğmesini (X) etkisiz hale getirebilirsiniz. Aynı zamanda sistem menüsündeki Kapat(Close) seçeneğide kaybolur. Bunun için aşağıdaki gibi bir kod yazmalısınız.
procedure TForm1.Button1Click(Sender: TObject);
var
  hwndHandle : THANDLE;
  hMenuHandle : HMENU;
begin
  hwndHandle := FindWindow(nil, 'Form1');  //Form1 pencerenin başlığını göstermektedir.
  if (hwndHandle <> 0) then begin             //Burayı uygulamanıza göre değiştirin
    hMenuHandle := GetSystemMenu(hwndHandle, FALSE);
    if (hMenuHandle <> 0) then
      DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND);
  end;
end;

 Uygulamam Windows her açıldığında otomatik çalışsın
uses kısmına Registry unitini ekleyin.
{$IFNDEF WIN32}
const MAX_PATH = 144;
{$ENDIF}

procedure TForm1.Button1Click(Sender: TObject);
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  reg.LazyWrite := false;
  reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run',false);
  reg.WriteString('Uygulamam', uygulamanızın_yolu_ve_adı);
  reg.CloseKey;
  reg.free;
end;

Klasöre Gözat diyalogunu kullanarak bir klasörü seçme
uses kısmına ShellAPI ve ShlObj unitlerini ekleyin.
procedure TForm1.Button1Click(Sender: TObject);
var
  TitleName : string;
  lpItemID : PItemIDList;
  BrowseInfo : TBrowseInfo;
  DisplayName : array[0..MAX_PATH] of char;
  TempPath : array[0..MAX_PATH] of char;
begin
  FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
  BrowseInfo.hwndOwner := Form1.Handle;
  BrowseInfo.pszDisplayName := @DisplayName;
  TitleName := 'Lütfen bir klasör seçin';
  BrowseInfo.lpszTitle := PChar(TitleName);
  BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
  lpItemID := SHBrowseForFolder(BrowseInfo);
  if lpItemId <> nil then begin
    SHGetPathFromIDList(lpItemID, TempPath);
    ShowMessage(TempPath);
    GlobalFreePtr(lpItemID);
  end;
end;

Bir web adresini açma
uses kısmına Shellapi unitini ekleyin;
ShellExecute(Handle,
                   'open',
                   'http://www.sanalpusula.net',
                    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. *)

 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. *)

 Bir menü öğesine 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;

Ağ ortamında makinenin ismini bulma
procedure TForm1.Button1Click(Sender: TObject);
var
  Makine_ismi:array[0..255] of char;
  BufferSize:DWORD;
begin
  BufferSize:=SizeOf(Makine_ismi);
  GetComputerName(@Makine_ismi,BufferSize);
  Showmessage(Makine_ismi);
end;

Ağ ortamında login olmuş kullanıcı ismini bulma
procedure TForm1.Button1Click(Sender: TObject);
var
  Kullanici_ismi:array[0..255] of char;
  BufferSize:DWORD;
begin
  BufferSize:=SizeOf(Kullanici_ismi);
  GetUserName(@Kullanici_ismi,BufferSize);
  Showmessage(Kullanici_ismi);
end;

Ekran çözünürlüğünü nasıl öğrenirim
Screen.Width   //yatay çözünürlük
Screen.Height  //dikey çözünürlük
MessageDlg('Şu anda ' + IntToStr( Screen.Width ) +' x '+
                                 IntToStr( Screen.Height )+' çözünürlükte çalışıyorsunuz',
                 mtInformation, [mbOk], 0 );

Taskbar'ın (Görev çubuğu) AutoHide özelliği açık mı, kapalı mı?
uses kısmına ShellAPI unitini ekleyin.
procedure TForm1.Button1Click(Sender: TObject);
var
  ABData : TAppBarData;
begin
  ABData.cbSize := sizeof(ABData);
  if (SHAppBarMessage(ABM_GETSTATE, ABData) and ABS_AUTOHIDE) > 0 then
     Showmessage('Autohide özelliği açık');
end;

Programım biraz beklesin
Bazı işlemlerden sonra diğer bir işlemi çalıştırmadan önce bir süre beklemek istersiniz. Bu gibi durumlarda Sleep komutunu kullanabilirsiniz. Burada verilen değer milisaniye cinsindendir. (1 saniye=1000 milisaniye)
Sleep(10000)    //10 saniye bekler

Caps lock tuşu açık mı, kapalı mı?
if (GetKeyState(VK_CAPITAL) and $01)<>0 then
    Showmessage ('caps lock açık');

İmleci (cursor) gizleyip, tekrar gösterme
ShowCursor(False) //imleci gizler
ShowCursor(True)  //imleci tekrardan gösterir.

Ekran görüntüsünü alın
procedure TForm1.Button1Click(Sender: TObject);
var
  DCDesk: HDC;
begin
  DCDesk:=GetWindowDC(GetDesktopWindow);
  BitBlt(Form1.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,DCDesk, 0, 0,SRCCOPY);
  ReleaseDC(GetDesktopWindow, DCDesk);
end;
Not: Yukarıdaki kod ekran görünütüsünü form üstüne alır. Image bileşeni içine ekran görüntüsünü almak için form üzerine bir image bileşeni yerleştirin ve  Form1.Canvas.Handle yerine Image1.Canvas.Handle yazın.

Map Network Drive diyalogunu açma
WNetConnectionDialog ( 0, RESOURCETYPE_DISK );

Bir dosyayı bağlantılı olduğu uygulama ile açma
uses kısmına shellapi unitini ekleyin.
shellexecute(0,'open', 'c:\test\2.avi','','',SW_NORMAL);

Temp klasörünü bulma

procedure TForm1.Button1Click(Sender: TObject);
var
  temp_klasor: array[0..MAX_PATH] of char;
begin
  GetTempPath(SizeOf(temp_klasor), @temp_klasor);
  ShowMessage(temp_klasor);
end;

Ekran koruyucuyu çalıştırmak

PostMessage(GetDesktopWindow, WM_SYSCOMMAND, SC_SCREENSAVE, 0);

Güç koruma modunda (Power Safe Mode) çalışan monitörü kapatıp açma
Monitörü kapatmak için :
SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0);
Monitörü açmak için :
SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, -1);

Windows Tarih/Saat Özellikleri (Date/Time Properties) iletişim kutusunu açma
Winexec('Control.exe Date/Time',sw_shownormal);

Çevrimdışı By £ditör

  • Süper Moderator
  • *****
  • İleti: 209
  • Konu Sayısı: 80
  • Toplam Puanı: 48
  • Cinsiyet: Bay
    • Sanalpusula Editörü

Ynt: Delphi Örnekler 2
« Yanıtla #1 : 02.10.2008-17:14:24 »
Çok güzel kaynak blue. İşe yarar örnekler paylaşım için sağol.


SanalPusula.Net - Etiketler
Delphi Örnekler 2,