Programlama yapalım ve Öğrenelim.

Bir Denetim Masası uygulamasını çalıştırmak

Control Panel uygulamaları WindowsSystem klasörü altında bulunur. *.CPL uzantılı dosyalardır. Bu uygulamaları Control.Exe programı ile çalıştırabilirsiniz. Bazı Control Panel uygulamaları WindowsSystem klasöründe bulunmaz. Bunların ismini vererek çalıştırabilirsiniz.

WinExec('C:WINDOWSCONTROL.EXE TIMEDATE.CPL', sw_ShowNormal);

WinExec('C:WINDOWSCONTROL.EXE MOUSE', sw_ShowNormal);

WinExec('C:WINDOWSCONTROL.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,

nil,

0);

//açmak için

SystemParametersInfo(SPI_SETSCREENSAVEACTIVE,

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,

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;

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;

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('SoftwareMicrosoftWindowsCurrentVersionRun',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;

Bir web adresini açma

uses kısmına Shellapi unitini ekleyin;

ShellExecute(Handle,

'open',

'http://www.geocities.com/siliconvalley/campus/4958/',

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:denemeturkey.bmp');

SetMenuItemBitmaps( deneme1.Handle,

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;

rogramı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:test2.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);

******************************************

DLL Uygulaması

Selamlar ;

Bir aksaklık olmazsa bundan böyle Delphi çerçevesinde programcılık hakkında yazılarımla, sizlerle olacağım. Yani yazılarımız Delphi üzerine olmasına karşın, programcılığa da değineceğiz.

İlk cümlem bu olmadı ama şunu da dikkate almanızı dilerim, Delphi de uzman bir programcı değilim, Delphi’nin ne kadarını bildiğimi de bilmiyorum, Programcılıkta ne seviye de olduğumuda onun için bir şey iddia etmiyorum, bilgiyi paylaşalım diyorum.

Ben Delphi’ye yavaşça girecektim ama arkadaşlarla yaptığımız tartışmalarda, direk uygulama yazmaya karar verdim (Aslında arkadaşlar haklı, ben de haklıyım ama onlar daha haklı). Yani herkesin Delphi’yi kullanmayı bildiği ve birçok kavrama aşina olduğu varsayılarak yazılarımı yazacağım.

İlk uygulamamız DLL uygulaması olsun, ama sonuna kadar da incelemeden bırakmayalım. Her bi saçma gelen ayrıntıyı bile inceliyelim.

Di-El-El, nedir DLL, sizler için gittim olayi M$ fabrikasında inceledim, Amerikalıların icad ettiği ve bütün dünyadan da kabul gören (çok da iyi bir şey) kısatmalardan bir tanesi, hemen açalım yoksa anlayamıyacaz olayı; Dynamic Link Library (Dinamik Bağlantılı Kütüphaneler) bi sorunumuz var tabii açılmışı da açmak gerekiyor. Onu da açıklarsak Dinamik, hareket halinde olan, enerjik faal, durağan olmayan anlamlarına geliyor. Link te bildiğimiz bağlantı. Birleştirelim, Bağlantısı durağan olması gerekmeyen, dilediğimiz zaman bağlanıp işimiz bittikten sonra kopabileceğimiz kütüphane oluyor, Di-El-El. DLL lerin rutinleri başka programlar tarafından çağrılabilir ve programa derleme sırasında bağlanmazlar, program çalışırken istediğimiz bir anda DLL’e iş yaptırabilir.

DLL sayesinde bir çok program tarafından kullanılan işlemler tekbir DLL de bir sefer yazılabilir ve tüm programlar diledikleri anda DLL’e bu işleri yaptırabilirler, böylece fazla kodlamadan ve kargaşadan kurtulunmuş olur. Windows’un DLL ler üzerine kurulmuş olduğunu, ve DLL’in windows için herşey gibi bir şey olduğunu söylesem yalan olmaz. Bunu dikkate alın ve DLL ruhunu kavrarsanız Windows’a hakim olmaya başlıyorsunuz demektir. Hadi başlayalım.

Öncelikle Delphi nasıl DLL yapar ?

Delphi bir yazıyı derlemeden önce ilk satırı olan,

Program Project1;

Library Project1;

Unit Project1;

Gibi satırlara bakarak ona göre derleme yapar, zeki olanlar hemen anladılar tabii. Evet Bir DLL yapmak için

1-) Delphi’yi açalım, her zamanki gibi New Application diyelim bize Form ve Üzerinde Unit Unit1; yazılı kod penceremiz gelecektir. View ve Project Source dediğimizde bize Unit1 den başka ile düzey yazılarımızda da kullandığımz Proje kodları gelir. Burada

program Project1; ve diğer kodlaro göreceksiniz. program Project1; yazısının yerine Library Project1; yazarsanız ve Derlerseniz programınızın Exe değil DLL uzantısı ile derlendiğini göreceksiniz. İşte bir DLL yaptınız.

2-) Delphi’yi açalım sadece New diyelim, karşımıza Yeni oluşturabileceğimiz bir çok şey çıkacaktır biz şimdilik bunlardan DLL ile ilgilendiğimiz için DLL’i seçin (soldan 4.cü). Proje kod ekranı karşımıza çıkıyor save as deyip kaydedelim ve yine bir DLL oluşturdunuz.

Şimdi, oluşturduğumuz DLL ler hiçbir şey yapmıyor sadece oluşturmayı öğrendik. DLL’in içine ne yazarız ne yapabiliriz buna bakalım.

Baştan başlayalım, Delphi deyiz, New, ve oradan DLL yi seçelim. Kod pencersindeyiz.

library Project1;

uses

SysUtils,

Classes;

begin

end.

Yazıyor.

library Project1;

uses

SysUtils,

Classes;

function trscene:integer;export;

begin

result:=9;

KODLAR

Dosya Kopyalama (1)

Procedure FileCopy( Const sourcefilename, targetfilename: String );

Var

S, T: TFileStream;

Begin

S := TFileStream.Create( sourcefilename, fmOpenRead );

try

T := TFileStream.Create( targetfilename,

fmOpenWrite or fmCreate );

try

T.CopyFrom(S, S.Size ) ;

finally

T.Free;

end;

finally

S.Free;

end;

End;

DOSYA KOPYALAMA 2

procedure FileCopy(const FromFile, ToFile: string);

var

FromF, ToF: file;

NumRead, NumWritten: Word;

Buf: array[1..2048] of Char;

begin

AssignFile(FromF, FromFile);

Reset(FromF, 1); { Record size = 1 }

AssignFile(ToF, ToFile); { Open output file }

Rewrite(ToF, 1); { Record size = 1 }

repeat

BlockRead(FromF, Buf, SizeOf(Buf), NumRead);

BlockWrite(ToF, Buf, NumRead, NumWritten);

until (NumRead = 0) or (NumWritten <> NumRead);

CloseFile(FromF);

CloseFile(ToF);

end;

Dosya Kopyalama (3)

procedure CopyFile(FromFileName, ToFileName: string);

var

FromFile, ToFile: File;

begin

AssignFile(FromFile, FromFileName); { Assign FromFile to FromFileName }

AssignFile(ToFile, ToFileName); { Assign ToFile to ToFileName }

Reset(FromFile); { Open file for input }

try

Rewrite(ToFile); { Create file for output }

try

if LZCopy(TFileRec(FromFile).Handle, TFileRec(ToFile).Handle) < 0

then

raise EInOutError.Create('Error using LZCopy')

finally

CloseFile(ToFile); { Close ToFile }

end;

finally

CloseFile(FromFile); { Close FromFile }

end;

Directory Adı değiştirme

SysUtils unitesinin içindeki RenameFile function bu işi görmektedir.

Treeview componentinin durumunu kaydetme ve gösterme

Kaydetmek için

TreeView.SaveToFile('Dosya.adı');

Dosyayı açmak için

TreeView.LoadFromFile('Dosya.adı');

Dosyayı yanlızca okumak (read only) şeklinde açma

AssignFile(F, Dosya);

FileMode := 0; (read only modunda açmak}

Reset(F);

CloseFile(F);

Açılan dosyanın tarih ve zamanını ayarlamak

var

f: file;

begin

Assign(f, DirInfo.Name);

Reset(f);

SetFTime(f, Time);

Close(f);

end;

Deltree

{$I-} {$I+}

procedure delTree (DirName: string);

var

FileSearch: SearchRec;

begin

chDir (DirName);

FindFirst ('*.*', Directory, FileSearch);

while (DosError = 0) do begin

if (FileSearch.name <> '.') AND (FileSearch.name <> '..') AND

( (FileSearch.attr AND Directory) <> 0)

then begin

if DirName[length(DirName)] = '' then

delTree (DirName+FileSearch.Name)

else

delTree (DirName+''+FileSearch.Name);

ChDir (DirName);

end;

FindNext (FileSearch)

end;

FindFirst ('*.*', AnyFile, FileSearch);

while (DosError = 0) do begin

if (FileSearch.name <> '.') AND (FileSearch.name <> '..') then

Remove (workdir);

end;

FindNext (FileSearch)

end;

rmDir (DirName)

end;

Dbgrid'de (Ctrl-Del diyince) dosya silmesini engelleme

if (ssctrl in shift) and (key=vk_delete) then

begin

key:=0;

end;

String'i renk'e renk'i stringe çevirme

Uses graphics;

form1.Color:=stringtocolor('121');

label1.caption:= ColorToString(form1.color);

Mouse'un yerini değiştirmek

randomize;

SetCursorPos(random(100),random(100));

ComboBox'ın aşağıya listelemesinin farklı bir yolu (DropComboBox)

SendMessage(ComboBox1.handle , 1039, 1, 0);

Başlığı Gizlemek ve Göstermek

Procedure HideTitlebar;

Var

Save : LongInt;

Begin

If form1.BorderStyle=bsNone then Exit;

Save:=GetWindowLong(form1.Handle,gwl_Style);

If (Save and ws_Caption)=ws_Caption then Begin

Case form1.BorderStyle of

bsSingle,

bsSizeable : SetWindowLong(form1.Handle,gwl_Style,Save and

(Not(ws_Caption)) or ws_border);

bsDialog : SetWindowLong(form1.Handle,gwl_Style,Save and

(Not(ws_Caption)) or ds_modalframe or ws_dlgframe);

End;

form1.Height:=form1.Height-getSystemMetrics(sm_cyCaption);

form1.Refresh;

End;

end;

Procedure ShowTitlebar;

Var

Save : LongInt;

begin

If form1.BorderStyle=bsNone then Exit;

Save:=GetWindowLong(form1.Handle,gwl_Style);

If (Save and ws_Caption)<>ws_Caption then Begin

Case form1.BorderStyle of

bsSingle,

cLabel1.Caption := 'Control'

else

if HiWord(GetKeyState(VK_MENU)) <> 0 then

Label1.Caption := 'Alt'

else

Label1.Caption := 'None';

end;

Formu taskbardan gizleme

ShowWindow(Application.Handle, SW_HIDE);

Silinmiş Dosyaları gösterme (DBF);

type

TForm1 = class(TForm)

Table1: TTable;

DataSource1: TDataSource;

DBGrid1: TDBGrid;

DBNavigator1: TDBNavigator;

CheckBox1: TCheckBox;

procedure CheckBox1Click(Sender: TObject);

public

procedure ShowDeleted(Table: TTable; ShowDeleted: Boolean);

end;

var

Form1: TForm1;

implementation

uses DBITYPES, DBIERRS, DBIPROCS;

{$R *.DFM}

procedure TForm1.ShowDeleted(Table: TTable; ShowDeleted: Boolean);

var

rslt: DBIResult;

szErrMsg: DBIMSG;

begin

Table.DisableControls;

try

Check(DbiSetProp(hDBIObj(Table.Handle), curSOFTDELETEON,

LongInt(ShowDeleted)));

finally

Table.EnableControls;

end;

Table.Refresh;

end;

procedure TForm1.CheckBox1Click(Sender: TObject);

begin

ShowDeleted(Table1, CheckBox1.Checked);

end;

end.

Form hakkında kısa bilgi

Form1.Show; {Formu göster}

Form1.Showmodal { Formu showmodal olarak göster (Showmodal iken başka hiçbir forma ulaşılamaz) }

myForm.Hide; {Formmu gizle }

myForm.Free; {Formu sil }

Formu şeffaf hale getirilmesi

OnCreate olayına Brush.Style:=bsClear; yazmanız yeterli.

ESC tuşuyla programdan çıkma

OnKeyPress olayına if Key = #27 then halt; yazın.

Bir Resim Dosyası Açıp İçine Çizim Yapma

var

Resim: TBitmap;

Resim := TBitmap.Create;

with Resim do

try

Width := 100;

Height := 100;

with Canvas do

begin

Rectangle(0, 0, 100, 100);

MoveTo(0, 0);

LineTo(100, 100);

MoveTo(0, 100);

LineTo(100, 0);

end;

SaveToFile('test.bmp')

finally

Free;

end;

Asla Yazı Kutusundan Çıkamazsın

procedure TForm1.Edit1Exit(Sender: TObject);

begin

showmessage('Asla yazı kutusundan çıkamassın');

postmessage(handle,WM_NEXTDLGCTL,0,0);

postmessage(handle,WM_NEXTDLGCTL,1,0);

end;

Formun Boyutlarını Sabitleme

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type

TForm1 = class(TForm)

private

{ Private declarations }

public

procedure WMGetMinMaxInfo( var Message :TWMGetMinMaxInfo ); message WM_GETMINMAXINFO;

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMGetMinMaxInfo( var Message :TWMGetMinMaxInfo );

begin

with Message.MinMaxInfo^ do

begin

ptMaxSize.X := 200;

ptMaxSize.Y := 200;

ptMaxPosition.X := 99;

ptMaxPosition.Y := 99;

ptMinTrackSize.X := 100;

ptMinTrackSize.Y := 100;

ptMaxTrackSize.X := 300;

ptMaxTrackSize.Y := 300;

end;

Message.Result := 0;

inherited;

end;

end.

Windows'a True Type Font Ekleme

uses Registry;

procedure TForm1.Button1Click(Sender: TObject);

var

reg: TRegistry;

b : bool;

begin CopyFile('C:DOWNLOADFP000100.TTF', 'C:WINDOWSFONTSFP000100.TTF', b);

reg := TRegistry.Create; reg.RootKey := HKEY_LOCAL_MACHINE;

reg.LazyWrite := false; reg.OpenKey('SoftwareMicrosoftWindowsCurrentVersionFonts', false); reg.WriteString('TESTMICR (TrueType)','FP000100.TTF');

reg.CloseKey; reg.free;

AddFontResource('c:windowsfontsFP000100.TTF'); SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);

RemoveFontResource('c:windowsfontsFP000100.TTF'); SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);

end;

Dosya Taşıma

MoveFile('C:Sourcesourcefile.txt', 'C:Destdestfile.txt');

Trim Fonksiyonunun açılımı

unit StrFunc;

interface

procedure LTrim(var s : string);

procedure RTrim(var s : string)

;procedure Trim(var s : string);

implementation

{$R *.DFM}

procedure LTrim(var s : string);

begin

while ((length(s) > 0) and (s[1] = #32)) do Delete(s, 1, 1);

end;

procedure RTrim(var s : string);

begin

while ((length(s) > 0) and (s[Length(s)] = #32)) do Delete(s, Length(s), 1);

end;

procedure Trim(var s : string);

begin

LTrim(s); RTrim(s);

end;

Screen Capture Programı (Ekran Çalma)

Bir tane image componenti eklemek zorundasınız.

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;

Sağa yada Sola hizalama function'u

function hiza(sagsol,yer:string;sayi:integer):string;

var

i,bosluk,uzunluk:integer;

begin

trim(yer); //Boşlukları temizle

uzunluk:=length(yer); //Verilen stringin uzunluğunu öğren

bosluk:=sayi-uzunluk; //Verilen sayıdan uzunluğu çıkar

if sagsol='sag' then begin //Sağamı solamı yaslancağını öğren

for i:=1 to bosluk do begin //Fark kadar sağa boşluk ekle

yer:=' '+yer; //Boşluk ekle

end;

result:=yer; //Sonucu bildir

exit;

end;

if sagsol='sol' then

begin

trim(yer);

for i:=1 to bosluk do begin //Fark kadar sola ekle

yer:=yer+' ';

end;

result:=yer; //Sonucu bildir

exit;

end;

Sayıyı virgüllü yazma functionu

Bunun için forma birtana label componenti yerleştirin ve visible özeliğini false yapın.

function frmt(yer:string):string;

var

s:string;

uzunluk:integer;

kalan,k,dgr:integer;

begin

s:='.';

uzunluk:=Length(yer);

dgr:=uzunluk div 3;

kalan:=uzunluk - (dgr*3);

label1.caption:=inttostr(kalan);

if yer='0' then

begin

yer:='0,';

result:=yer;

exit;

end;

if label1.caption<>'0' then

begin

insert(s,yer,kalan+1);

for k:=1 to dgr do begin

if k=dgr then begin

insert(',',yer,(kalan +(k*3)+k+1));

result:=yer;

exit;

end;

insert(s,yer,(kalan +(k*3)+k+1));

end;

Comp değerindeki bir sayıyı string yapma

function Comp2Str(N: Comp): String;

var

TS: String;

begin

Str(N:0:0, TS);Comp2Str := TS;

end;

Dosya açılış yolları

Windows programının açılışı

WinExec('C:WINDOWSNOTEPAD.EXE', SW_SHOWNORMAL);

Komut satırı ile birlikte :

WinExec('C:WINDOWSNOTEPAD.EXE C:WINDOWSWIN.INI', SW_SHOWNORMAL);

Pop Up dos kutusuyla :

WinExec('COMMAND.COM', SW_SHOWNORMAL);

Normal bir dos programının komutla açılışı

WinExec('COMMAND.COM /C DIR *.*', SW_SHOWNORMAL);

Dekstop'ı refresh etmek

procedure TForm1.Button1Click(Sender: TObject);

begin

SendMessage(FindWindow('Progman', 'Program Manager'), WM_COMMAND,$A065, 0);

end;

Programın windows'la birlikte açılması

uses Registry, {For Win32}

IniFiles; {For Win16}

{$IFNDEF WIN32}

const

MAX_PATH = 144;

{$ENDIF}

{For Win32}

procedure TForm1.Button1Click(Sender: TObject);

var

reg: TRegistry;

begin

reg := TRegistry.Create;

reg.RootKey := HKEY_LOCAL_MACHINE;

reg.LazyWrite := false; reg.OpenKey('SoftwareMicrosoftWindowsCurrentVersionRun', false); reg.WriteString('My App', Application.ExeName);

reg.CloseKey;

reg.free;

end;

Formun ara çubuğunu gizleme

procedure TForm1.FormCreate(Sender: TObject);

begin

SetWindowLong(Form1.Handle,GWL_STYLE,GetWindowLong(Handle,GWL_STYLE) and not WS_CAPTION);

Height := ClientHeight;

end;

Flash icon

var Flash : bool;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

FlashWindow(Form1.Handle, Flash);

FlashWindow(Application.Handle, Flash); Flash := not Flash;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

Flash := False;

end;

Taskbar'ın handle sayısı

hTaskbar := FindWindow('Shell_TrayWnd', Nil );

Exe yada Dll'deki iconların alınması

Uses shellapi;

procedure TForm1.FormCreate(Sender: TObject);

var TheIcon: TIcon;

begin TheIcon := TIcon.Create;

TheIcon.Handle := ExtractIcon(hInstance,'C:dosyadosya.EXE',0);

image1.picture.Icon:=Theicon;

end;

Windows ekranına çizim yapma

procedure TForm1.Button1Click(Sender: TObject);

var dc : hdc;

begin dc := GetDc(0);

MoveToEx(Dc, 0, 0, nil);

LineTo(Dc, 300, 300);

ReleaseDc(0, Dc);

end;

Edit1'deki yazıyı edit2'ye GetTextBuf yolluyla aktarma

procedure TForm1.Button1Click(Sender: TObject);

var

Buffer: PChar;

Size: Byte;

begin

Size := Edit1.GetTextLen; {Get length of string in Edit1}

Inc(Size); {Add room for null character}

GetMem(Buffer, Size); {Creates Buffer dynamic variable}

Edit1.GetTextBuf(Buffer,Size); {Puts Edit1.Text into Buffer}

Edit2.Text := StrPas(Buffer); {Converts Buffer to a Pascal-style string]

FreeMem(Buffer, Size); {Frees memory allocated to Buffer}

end;

Form1'in aynısını printerden çıkartma

Form1.Print;

O anki 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 menü öğesinin enabled özelliğini false yapmak;

mainmenu1.items[0].items[1].enabled:=False;

Listbox veya Combobox'ta seçili bir veya birden fazla öğeyi seçilmemiş duruma getirmek için;

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

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;

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

Şifreli bir table için programın şifre istememesi için;

Table'ın Active özelliğini False yapın ve Form'un OnCreate olayına aşağıdaki kodu ekleyin

Session.AddPassword('şifre');

Table1.Active:=True;

Pencereyi minimize etmek;

Application.Minimize; //taskbar'a minimize

CloseWindow(handle)

WindowState := wsMinimized;

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

var

i:dword;

begin

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

end;

Help menüsünden About kısmına girin. Alt tuşuna basılı tutarak TEAM veya DEVELOPERS yazın. Delphi'yi geliştirenlerin isimlerini görebilirsiniz. Database Desktop'tada Help menüsünden About kısmına girin ve delphi yazın.

ico'dan bmp'ye çevirme;

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 sürücüyü açmak ve kapamak;

uses kısmına MMSystem unitini ekleyin.

mciSendString('Set cdaudio door open wait', nil, 0, handle); //aç

mciSendString('Set cdaudio door closed wait', nil, 0, handle); //kapa

CapsLock ve Numlock tuşlarını açıp-kapama;

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 için VK_CAPITAL yerine VK_NUMLOCK yazınız.

Menü'ye bitmap (resim) ekleme;

procedure TForm1.FormCreate(Sender: TObject);

var

Bmp1 : TPicture;

begin

Bmp1 := TPicture.Create;

Bmp1.LoadFromFile('c:denemeturkey.bmp');

SetMenuItemBitmaps( deneme1.Handle,

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.

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;

Speakerdan Beep sesi çıkartma

MessageBeep(word(-1));

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:DownLoaddeneme.html';

SHAddToRecentDocs(SHARD_PATH, pChar(s));

end;

Belgeler menüsünü temizleme

uses kısmına ShlOBJ unitini ekleyin;

SHAddToRecentDocs(SHARD_PATH, nil);