Basit Delphi Kodlari

Gönderi tarihi: 20 Mart , 2005 20 yıl

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 Adi degistirme

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

Treeview componentinin durumunu kaydetme ve gösterme

Kaydetmek için

TreeView.SaveToFile(’Dosya.adi’);

Dosyayi açmak için

TreeView.LoadFromFile(’Dosya.adi’);

Dosyayi yanlizca okumak (read only) seklinde açma

AssignFile(F, Dosya);

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

Reset(F);

.

CloseFile(F);

Açilan dosyanin tarih ve zamanini 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 degistirmek

randomize;

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

ComboBox’in asagiya listelemesinin farkli bir yolu (DropComboBox)

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

Basligi 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,

bsSizeable : SetWindowLong(form1.Handle,gwl_Style,Save or ws_Caption or

ws_border);

bsDialog : SetWindowLong(form1.Handle,gwl_Style,Save or ws_Caption or

ds_modalframe or ws_dlgframe);

End;

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

form1.Refresh;

End;

end;

GradientFill (eyimli renk) kullanimi

Önce uses bölümüne chart ekleyin.

Formun üstüne bir tane image componenti yerlestirin ve formun create olayina asagidaki kodu yazin.

procedure TForm1.FormCreate(Sender: TObject);

begin

GradientFill(Image1.Canvas,Image1.ClientRect,clred,clblue,false);

end;

Küçük bir kolaylik ctrl-space

Delphide esitlik kurucaginiz zaman ctrl-space’e bastiginizda verebileceginiz degerleri göstermektedir.

Label1.caption:= (burada ctrl-space bastiginizda verebileceginiz degerleri görürsünüz)

Dbf dosyasini pack etmek (silinen dosyalari diskten silmek)

Table1.Exclusive := True;

Table1.Active := True;

Error := DbiPackTable(Table1.DBHandle, Table1.Handle, nil, szdBASE, True);

Table1.Active := False;

Table1.Exclusive := False;

BDE’ nin yüklü olup olmadigini anlamak

HKEY_LOCAL_MACHINESoftwareBorlandDatabase Engine bölümü bde’ye ayrilmistir ve yüklü olup olmadigini asagidaki degerleri kontrol ederek bulabilirsiniz.

DLLPATH

CONFIGFILE01

Clipboard’a kopyalama ve yapistirma (copy,past)

procedure CopyButtonClick(Sender: TObject);

begin

If ActiveControl is TMemo then TMemo(ActiveControl).CopyToClipboard;

If ActiveControl is TDBMemo then TDBMemo(ActiveControl).CopyToClipboard;

If ActiveControl is TEdit then TEdit(ActiveControl).CopyToClipboard;

If ActiveControl is TDBedit then TDBedit(ActiveControl).CopyToClipboard;

end;

procedure PasteButtonClick(Sender: TObject);

begin

If ActiveControl is TMemo then TMemo(ActiveControl).PasteFromClipboard;

If ActiveControl is TDBMemo then TDBMemo(ActiveControl).PasteFromClipboard;

If ActiveControl is TEdit then TEdit(ActiveControl).PasteFromClipboard;

If ActiveControl is TDBedit then TDBedit(ActiveControl).PasteFromClipboard;

end;

TStringgrid’i kaydetme ve açma

Procedure SaveGrid;

var

f:textfile;

x,y:integer;

begin

assignfile (f,’Filename’);

rewrite (f);

writeln (f,stringgrid.colcount);

writeln (f,stringgrid.rowcount);

For X:=0 to stringgrid.colcount-1 do

For y:=0 to stringgrid.rowcount-1 do

writeln (F, stringgrid.cells[x,y]);

closefile (f);

end;

Procedure LoadGrid;

var

f:textfile;

temp,x,y:integer;

tempstr:string;

begin

assignfile (f,’Filename’);

reset (f);

readln (f,temp);

stringgrid.colcount:=temp;

readln (f,temp);

stringgrid.rowcount:=temp;

For X:=0 to stringgrid.colcount-1 do

For y:=0 to stringgrid.rowcount-1 do begin

readln (F, tempstr);

stringgrid.cells[x,y]:=tempstr;

end;

closefile (f);

Avi dosyasinin görünüm alanini seçilen panele esitleme

begin

with MediaPlayer1 do begin

DeviceType := dtAutoSelect;

visible := false;

FileName := InputBox(’AVI’, ’Enter AVI file name’, ’c:windowsorland.avi’);

display := panel1;

open;

DisplayRect := rect(0, 0, panel1.width, panel1.height); {This is it!}

rewind;

play;

end;

Alıntı

Gönderi tarihi: 20 Mart , 2005 20 yıl

Yazar

Windows’a çizgi çizmenin farkli bir yolu

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

var dc:hdc;

begin

dc:=getdc(0);

Windows.LineTo(dc,x,y);

end;

end.

Memo componentindeki cursorun pozisyonunu bulma

procedure TForm1.Button1Click(Sender: TObject);

var

Row, Col: Integer;

begin

Row := SendMessage(Memo1.Handle, EM_LINEFROMCHAR, Memo1.SelStart, 0);

Col := Memo1.SelStart - SendMessage(Memo1.Handle, EM_LINEINDEX, Row, 0);

Label1.caption := ’Row= ’ + IntToStr(Row+1) + ’ Col= ’ + IntToStr(Col+1);

end;

Form üstüne dbclick yapilinca maximisize (tam ekran) olmasi

type

TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);

begin

inherited;

if M.Result = htClient then

M.Result := htCaption;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Close;

end;

end.

Control paneldeki bölümleri açma (cpl dosyalarini açma)

unit open_cpl;

interface

function RunControlPanelApplet( sAppletFileName : string) : integer;

implementation

uses Windows;

function RunControlPanelApplet( sAppletFileName : string) : integer;

begin

Result := WinExec( PChar(’rundll32.exe shell32.dll,’+ ’Control_RunDLL ’+sAppletFileName), SW_SHOWNORMAL);

end;

end.

access.cpl: Accessibility Properties

appwiz.cpl: Add/Remove Programs Properties

desk.cpl: Display Properties

intl.cpl: Regional Settings Properties

joy.cpl: Joystick Properties

main.cpl: Mouse Properties

mmsys.cpl: Multimedia Properties

modem.cpl: Modems Properties

sysdm.cpl: System Properties

timedate.cpl: Time/Date Properties

Kullanilan printer adi

uses Printers;

function GetDefaultPrinterName : string;

begin GetDefaultPrinterName := Printer.Printers[ Printer.PrinterIndex ];

end;

Cd sürücüsünün seri numarasi

function GetDiskVolSerialID( cDriveName : char ) : DWord;

var dwTemp1, dwTemp2 : DWord;

begin GetVolumeInformation( PChar( cDriveName + ’:’ ), Nil, 0, @Result, dwTemp2, dwTemp2, Nil, 0 );

end;

MessageDlg( ’Serial number: ’ + Format( ’%X’, [ GetDiskVolSerialID( ’E’ ) ] ),

mtInformation, [mbOk], 0 );

Capslock’un durumunu ögrenme

function IsCapsLockOn : boolean;

begin Result := 0 <> (GetKeyState(VK_CAPITAL) and $01);

end;

Renklerin hex degerlerini bulma

function

TColorToHex( Color : TColor ) : string;

begin

Result := IntToHex( GetRValue( Color ), 2 ) + IntToHex( GetGValue( Color ), 2 ) + IntToHex( GetBValue( Color ), 2 );

end;

Cursor’u gizleyip tekrar gösterme

Showcursor(true); //cursoru göster

Showcursor(false); //cursoru gizle

internete bagli olup olmadiginizi anlamak

Forma bir tane tcp componenti ve bir tane buton yerlestirdikten sonra

Buttonnun içine asagidaki yazi yazilir.

if TCP1.LocalIp = ’0.0.0.0’ then

ShowMessage(’Bagli degilsiniz!’);

Html Sayfasini printerden çikarma

uses Printers;

var

EskCur: TCursor;

begin

EskCur := Screen.Cursor;

with Printer do begin

BeginDoc;

HTML1.AutoPrint(handle);

Title := HTML1.URL;

EndDoc;

end;

Screen.Cursor := EskCur;

end;

Menu’ye clicklenirken hangi tusla basildigini algilama (Control,Shift,Alt)

procedure TForm1.Menu1Click(Sender: TObject);

begin

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

Label1.Caption := ’Shift’

else

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

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

Alıntı

Gönderi tarihi: 20 Mart , 2005 20 yıl

Yazar

Silinmis Dosyalari 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 hakkinda kisa bilgi

Form1.Show; {Formu göster}

Form1.Showmodal { Formu showmodal olarak göster (Showmodal iken baska hiçbir forma ulasilamaz) }

myForm.Hide; {Formmu gizle }

myForm.Free; {Formu sil }

Formu seffaf hale getirilmesi

OnCreate olayina Brush.Style:=bsClear; yazmaniz yeterli.

ESC tusuyla programdan çikma

OnKeyPress olayina if Key = #27 then halt; yazin.

Bir Resim Dosyasi Açip iç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 Yazi Kutusundan Çikamazsin

procedure TForm1.Edit1Exit(Sender: TObject);

begin

showmessage(’Asla yazi kutusundan çikamassin’);

postmessage(handle,WM_NEXTDLGCTL,0,0);

postmessage(handle,WM_NEXTDLGCTL,1,0);

end;

Formun Boyutlarini 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’, ;

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 Tasima

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

Trim Fonksiyonunun açilimi

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 Programi (Ekran Çalma)

Bir tane image componenti eklemek zorundasiniz.

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;

Saga yada Sola hizalama function’u

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

var

i,bosluk,uzunluk:integer;

begin

trim(yer); //Bosluklari temizle

uzunluk:=length(yer); //Verilen stringin uzunlugunu ögren

bosluk:=sayi-uzunluk; //Verilen sayidan uzunlugu çikar

if sagsol=’sag’ then begin //Sagami solami yaslancagini ögren

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

yer:=’ ’+yer; //Bosluk 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;

Sayiyi virgüllü yazma functionu

Bunun için forma birtana label componenti yerlestirin ve visible özeligini false yapin.

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 degerindeki bir sayiyi string yapma

function Comp2Str(N: Comp): String;

var

TS: String;

begin

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

end;

Dosya açilis yollari

Windows programinin açilisi

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

Komut satiri ile birlikte :

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

Pop Up dos kutusuyla :

WinExec(’COMMAND.COM’, SW_SHOWNORMAL);

Normal bir dos programinin komutla açilisi

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

Alıntı

Gönderi tarihi: 20 Mart , 2005 20 yıl

Yazar

Dekstop’i refresh etmek

procedure TForm1.Button1Click(Sender: TObject);

begin

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

end;

Programin windows’la birlikte açilmasi

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 çubugunu 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’in handle sayisi

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

Exe yada Dll’deki iconlarin alinmasi

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 ekranina ç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 yaziyi 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 aynisini printerden çikartma

Form1.Print;

O anki sürücünün kapasitesini ve sürücüdeki bos yer miktarini bulmak;

DiskFree(0) //o anki sürücüdeki bos yer miktarini 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ü ögesinin enabled özelligini false yapmak;

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

Listbox veya Combobox’ta seçili bir veya birden fazla ögeyi seçilmemis 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 numarasinin bulunmasi;

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 basindaki ve sonundaki bosluklari atmak için;

Trim(string)

TrimLeft (string) //stringin sadece basindaki bosluklari atmak için

TrimRight (string) //stringin sadece sonundaki bosluklari atmak için

sifreli bir table için programin sifre istememesi için;

Table’in Active özelligini False yapin ve Form’un OnCreate olayina asagidaki kodu ekleyin

Session.AddPassword(’sifre’);

Table1.Active:=True;

Pencereyi minimize etmek;

Application.Minimize; //taskbar’a minimize

CloseWindow(handle)

WindowState := wsMinimized;

Windows’u kapatmak veya yeniden baslatmak(reboot);

var

i:dword;

begin

ExitWindowsEx(EWX_SHUTDOWN); //yeniden baslatmak için EWX_REBOOT

end;

Help menüsünden About kismina girin. Alt tusuna basili tutarak TEAM veya DEVELOPERS yazin. Delphi’yi gelistirenlerin isimlerini görebilirsiniz. Database Desktop’tada Help menüsünden About kismina girin ve delphi yazin.

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 kismina 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 tuslarini açip-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 tusu için VK_CAPITAL yerine VK_NUMLOCK yaziniz.

Menü’ye bitmap (resim) ekleme;

procedure TForm1.FormCreate(Sender: TObject);

var

Bmp1 : TPicture;

begin

Bmp1 := TPicture.Create;

Bmp1.LoadFromFile(’c:deneme urkey.bmp’);

SetMenuItemBitmaps( deneme1.Handle,

0,

MF_BYPOSITION,

Bmp1.Bitmap.Handle,

Bmp1.Bitmap.Handle);

end;

Alt + Tab ve Ctrl + Esc tuslarinin kullanilmaz hale getirilmesi;

var

OldVal : LongInt;

begin

SystemParametersInfo (97, Word (True), @OldVal, 0)

//Word(False) ile kullanirsaniz tuslari tekrar kullanabilirsiniz.

Windows ve System klasörlerinin bulunmasi

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;

Alıntı

Gönderi tarihi: 20 Mart , 2005 20 yıl

Yazar

Speakerdan Beep sesi çikartma

MessageBeep(word(-1));

--------------------------------------------------------------------------------

Belgeler menüsüne bir dosya ekleme

uses kismina 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 kismina ShlOBJ unitini ekleyin;

SHAddToRecentDocs(SHARD_PATH, nil);

--------------------------------------------------------------------------------

Bir web adresini açma

uses kismina Shellapi unitini ekleyin;

ShellExecute(Handle,

’open’,

’http://emreoz.cjb.net’,

nil,

sw_ShowMaximized);

--------------------------------------------------------------------------------

Bir DOS programini çalistirma ve çalismasi bitince penceresini kapatma

WinExec("command.com /c progdos.exe",sw_ShowNormal); //progdos.exe çalistiriliyor.

//eger ikinci paremetreyi sw_Hide yaparsaniz kullanici programin çalistigini görmez.

--------------------------------------------------------------------------------

Uygulamanizin Görev Çubugundaki butonunu gizleme

Uygulamanizin Görev Çubugundaki butonunu gizlemek için programinizin ana formunun OnCreate olayina asagidaki kodu yazin;

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 tus kombinasyonuyla programin kapanmamasi için

Formun OnCreate olayina;

KeyPreview := true;

Formun OnKeyDown olayina;

if ((ssAlt in Shift) and (Key = VK_F4)) then

Key := 0;

--------------------------------------------------------------------------------

Hareketli imleç(animated cursor)leri kullanma

procedure TForm1.Button1Click(Sender:TObject);

var

h : THandle;

begin

h := LoadImage(0,

’C:TheWallMagic.ani’,

IMAGE_CURSOR,

0,

LR_DEFAULTSIZE or

LR_LOADFROMFILE);

if h = 0 then ShowMessage(’Cursor not loaded’) else begin

Screen.Cursors[1] := h;

Form1.Cursor := 1;

end;

--------------------------------------------------------------------------------

Windows lisans bilgilerinin (isim ve sirket) bulunmasi

uses kismina Registry unitini ekleyin;

procedure TForm1.Button1Click(Sender:TObject);

var

reg: TRegIniFile;

begin

reg := TRegIniFile.create(’SOFTWAREMICROSOFTMS SETUP (ACME)’);

Memo1.Lines.Add(reg.ReadString(’USER INFO’,

’DefName’,

’Emre ÖZ’));

Memo1.Lines.Add(reg.ReadString(’USER INFO’,

’DefCompany’,

’Bilgisayar Bilimleri Müh.’));

reg.free;

end;

--------------------------------------------------------------------------------

Çok Satirli ipucu

procedure TForm1.FormCreate(Sender: TObject);

begin

SpeedButton1.Hint:=’Çok satirli ipucunu ’+chr(13)+

’mutlaka denemelisiniz ’+chr(13)+

’çok güzel’;

end;

--------------------------------------------------------------------------------

Bir klasörü ve onun altindaki tüm dosyalari ve klasörleri silme

Ancak salt okunur (read only) özelligi olan ve kullanimda olan dosyalar silinmez.

procedure TForm1.Button1Click(Sender: TObject);

var

DirInfo: TSearchRec;

r : Integer;

begin

r := FindFirst(’C:DownloadTest*.*’, 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 est’ + DirInfo.Name))

= false then

ShowMessage(’C:Download est’+DirInfo.Name+’ silinemiyor!!!’);

r := FindNext(DirInfo);

end;

SysUtils.FindClose(DirInfo);

if RemoveDirectory(’C:DownloadTest’) = false then

ShowMessage(’C:Download est klasörü silinemiyor!!!’);

end;

--------------------------------------------------------------------------------

Baslat butonunu gizlemek veya kullanilmaz hale getirmek

procedure TForm1.Button1Click(Sender: TObject);

var

Rgn : hRgn;

begin

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

//Baslat butonunu kullanilmaz yap

EnableWindow(FindWindowEx(FindWindow(’Shell_TrayWnd’, nil),

0,

’Button’,

nil),

false);

end;

procedure TForm1.Button4Click(Sender: TObject);

begin

//Kullanilmaz yapilan Baslat butonunu eski haline getirmek için

EnableWindow(FindWindowEx(FindWindow(’Shell_TrayWnd’, nil),

0,

’Button’,

nil),

true);

end;

--------------------------------------------------------------------------------

Windows Gezginini istediginiz bir klasörle açma

uses kismina Shellapi unitini ekleyin.

ShellExecute(0,

’explore’,

’C:WINDOWS’, //açmak istediginiz dizin

nil,

SW_SHOWNORMAL);

--------------------------------------------------------------------------------

Duvar kagidini degistirmek

var

s: string;

begin

s := ’c:windowsathena.bmp’;

SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, PChar(s),0);

--------------------------------------------------------------------------------

Form’un arka kismina bir resmi dösemek

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;

Alıntı

Gönderi tarihi: 20 Mart , 2005 20 yıl

Yazar

Bir Denetim Masasi uygulamasini çalistirmak

Control Panel uygulamalari WindowsSystem klasörü altinda bulunur. *.CPL uzantili dosyalardir. Bu uygulamalari Control.Exe programi ile çalistirabilirsiniz. Bazi Control Panel uygulamalari WindowsSystem klasöründe bulunmaz. Bunlarin ismini vererek çalistirabilirsiniz.

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

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

WinExec(’C:WINDOWSCONTROL.EXE PRINTERS’, sw_ShowNormal);

--------------------------------------------------------------------------------

Sayilari virgüllerle yazmak

Sayi windows’unuz ayarina göre 12.345.678 veya 12,345,678 seklinde gösterilir.

procedure TForm1.Button1Click(Sender: TObject);

var

i : integer;

begin

i := 12345678;

Memo1.Lines.Add(FormatFloat(’#,’, i));

--------------------------------------------------------------------------------

Sistem Tarihini ve Saatini Degistirmek

Sistemin tarihini ve saatini degistirmek 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;

--------------------------------------------------------------------------------

Fareyi mesgul sekilde göstermek

try

Screen.Cursor := crHourGlass;

{buraya kodunuzu yazin...}

finally

Screen.Cursor := crDefault;

end;

Application.ProcessMessages;

--------------------------------------------------------------------------------

Dos programi kullanmak için;

WinExec(’command.com /c progdos.exe’,sw_ShowNormal);

--------------------------------------------------------------------------------

Çevirme

Edit1.OnChange := NIL;

if Edit1.Text = ’Emre ÖZ’ then

Edit1.Text := ’Emre’;

Edit1.OnChange := Edit1Change;

--------------------------------------------------------------------------------

ilk harf büyük digerleri küçük

Edit1’e yazilan yazinin ilk harfini büyük diger harflerini küçük yapiyor.

var

OldStart : Integer;

begin

With Edit1 do

if Text <> ’’ then begin

OnChange := NIL;

OldStart := SelStart;

Text := UpperCase(Copy(Text,1,1))+LowerCase(Copy(Text,2,Length(Text)));

SelStart := OldStart;

OnChange := Edit1Change;

end;

--------------------------------------------------------------------------------

Taskbar gizleme

procedure hideTaskbar;

var

wndHandle : THandle;

wndClass : array[0..50] of Char;

begin

StrPCopy(@wndClass[0], ’Shell_TrayWnd’);

wndHandle := FindWindow(@wndClass[0], nil);

ShowWindow(wndHandle, SW_HIDE);

end;

procedure showTaskbar;

var

wndHandle : THandle;

wndClass : array[0..50] of Char;

begin

StrPCopy(@wndClass[0], ’Shell_TrayWnd’);

wndHandle := FindWindow(@wndClass[0], nil);

ShowWindow(wndHandle, SW_RESTORE);

end;

--------------------------------------------------------------------------------

Ses kaydetme

Bu program mikrofondan sesi alip bir wav dosyasi içine kayit ediyor.

uses

MMSystem,

WinCrt;

function RecordSound(MMSecs: LongInt): LongInt;

var

DeviceID: Word;

Return: LongInt;

MciOpen: TMCI_Open_Parms;

MciRecord: TMCI_Record_Parms;

MciPlay: TMCI_Play_Parms;

MciSave: TMCI_SaveParms;

Result2: LongInt;

Flags: Word;

begin

MciOpen.lpstrDeviceType := ’waveaudio’;

MciOpen.lpstrElementName := ’’;

Flags := Mci_Open_Element or Mci_Open_Type;

Result2 := MciSendCommand(0, MCI_OPEN, Flags, LongInt(@MciOpen));

DeviceID := MciOpen.wDeviceId;

WriteLn(’Kayit’);

MciRecord.dwTo := MMSecs;

Flags := Mci_To or Mci_Wait;

Result2 := MciSendCommand(DeviceID, Mci_Record, Flags, LongInt(@MciRecord));

WriteLn(’Durdur’);

mciPlay.dwFrom := 0;

Flags := Mci_From or Mci_Wait;

MciSendCommand(DeviceId, Mci_Play, Flags, LongInt(@MciPlay));

mciSave.lpfileName := ’Ses.Wav’;

Flags := MCI_Save_File or Mci_Wait;

Result := MciSendCommand(DeviceID, MCI_Save, Flags, LongInt(@MciSave));

MciSendCommand(DeviceID, Mci_Close, 0, LongInt(nil));

end;

begin

WriteLn(’Basla’);

RecordSound(10000);

WriteLn(’Bitir’);

--------------------------------------------------------------------------------

DELPHi NASIL EXE YAPIYOR ?

Delphi , delphi ile birlikte gelen dcc.exe ile projeleri derliyor. (Delphi 3’de dcc32.exe)

Örnek olarak

dcc /CW /b uls.dpr

komutlar :

/CW : Windows için,

/cd : Dos için,

/cp: Korumali mod için.

/b: Hepsini tekrar olustur,

/m: Hepsinin güncel oldugundan emin ol.

--------------------------------------------------------------------------------

BRC Nedir ?

Brc Res dosyalarini derliyor.

Bir res dosyasi açin ,(Notepad ile)

içine Icon ICON "emre.ico" yazin. (emre.ico dosyasi ayni klasörde bulunmali. )

BRC -r EMRE.RES olarak derleyin.

Delphideki projenizin basinada {$ Emre.rc} yazin. Böylece ikon dosyalarini tasimadan kullana bilirsiniz.

Sadece icon degil , ayrica BITMAP,TEXT de kullana bilirsiniz.

Alıntı

Giriş Yap

Basit Delphi Kodlari

Featured Replies

Katılın Görüşlerinizi Paylaşın

Önemli Bilgiler

Account

Navigation

Configure browser push notifications

Chrome (Android)

Chrome (Desktop)

Safari (iOS 16.4+)

Safari (macOS)

Edge (Android)

Edge (Desktop)

Firefox (Android)

Firefox (Desktop)