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(&#8217;Error using LZCopy’)

finally

CloseFile(ToFile); { Close ToFile }

end;

finally

CloseFile(FromFile); { Close FromFile }

end;

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(&#8217;Dosya.adı’);

 
Dosyayı açmak için

 
TreeView.LoadFromFile(&#8217;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;

SetFTime(f, Time);

Close;

end;

 
Deltree

 
{$I-} {$I+}

 
procedure delTree (DirName: string);

var

FileSearch: SearchRec;

begin

 
chDir (DirName);

FindFirst (&#8217;*.*’, Directory, FileSearch);

while (DosError = 0) do begin

if (FileSearch.name <> &#8217;.’) AND (FileSearch.name <> ’..’) AND

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

then begin

if DirName[length(DirName)] = &#8217;\’ then

delTree (DirName+FileSearch.Name)

else

delTree (DirName+&#8217;\’+FileSearch.Name);

ChDir (DirName);

end;

FindNext (FileSearch)

end;

 
 
FindFirst (&#8217;*.*’, AnyFile, FileSearch);

while (DosError = 0) do begin

if (FileSearch.name <> &#8217;.’) AND (FileSearch.name <> ’..’) then

Remove (workdir);

end;

FindNext (FileSearch)

end;

rmDir (DirName)

end;

 
Dbgrid&#8217;de (Ctrl-Del diyince) dosya silmesini engelleme

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

begin

key:=0;

end;

 
String&#8217;i renk’e renk’i stringe çevirme

 
Uses graphics;

form1.Color:=stringtocolor(&#8217;121’);

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

 
Mouse&#8217;un yerini değiştirmek

 
randomize;

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

 
ComboBox&#8217;ı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,

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

form1.Refresh;

End;

end;

 
GradientFill (eyimli renk) kullanımı

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

Formun üstüne bir tane image componenti yerleştirin ve formun create olayına aşağıdaki kodu yazın.

 
procedure TForm1.FormCreate(Sender: TObject);

begin

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

end;

 
Küçük bir kolaylık ctrl-space

 
Delphide eşitlik kurucağınız zaman ctrl-space&#8217;e bastığınızda verebileceğiniz değerleri göstermektedir.

Label1.caption:= (burada ctrl-space bastığınızda verebileceğiniz değerleri görürsünüz)

 
 
Dbf dosyasını pack etmek (silinen dosyaları diskten silmek)

 
Table1.Exclusive := True;

Table1.Active := True;

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

Table1.Active := False;

Table1.Exclusive := False;

 
BDE&#8217; nin yüklü olup olmadığını anlamak

HKEY_LOCAL_MACHINE\Software\Borland\Database Engine bölümü bde&#8217;ye ayrılmıştır ve yüklü olup olmadığını aşağıdaki değerleri kontrol ederek bulabilirsiniz.

 
DLLPATH

CONFIGFILE01

 
Clipboard&#8217;a kopyalama ve yapıştırma (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&#8217;i kaydetme ve açma

 
Procedure SaveGrid;

var

f:textfile;

x,y:integer;

begin

assignfile (f,&#8217;Filename’);

rewrite;

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;

end;

 
Procedure LoadGrid;

var

f:textfile;

temp,x,y:integer;

tempstr:string;

begin

assignfile (f,&#8217;Filename’);

reset;

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;

 
Avi dosyasının görünüm alanını seçilen panele eşitleme

 
begin

with MediaPlayer1 do begin

DeviceType := dtAutoSelect;

visible := false;

FileName := InputBox(&#8217;AVI’, ’Enter AVI file name’, ’c:\windows\borland.avi’);

display := panel1;

open;

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

rewind;

play;

end;

end;

Windows&#8217;a çizgi çizmenin farklı 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 := &#8217;Row= ’ + IntToStr(Row+1) + ’ Col= ’ + IntToStr(Col+1);

end;

Form üstüne dbclick yapılınca maximisize (tam ekran) olması

 
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 dosyalarını açma)

 
unit open_cpl;

 
interface

 
function RunControlPanelApplet( sAppletFileName : string) : integer;

 
implementation

 
uses Windows;

 
function RunControlPanelApplet( sAppletFileName : string) : integer;

begin

Result := WinExec( PChar(&#8217;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

Kullanılan printer adı

 
uses Printers;

function GetDefaultPrinterName : string;

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

end;