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);
AssignFile(ToF, ToFile);
Rewrite(ToF, 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);
AssignFile(ToFile, ToFileName);
Reset(FromFile);
try
Rewrite(ToFile);
try
if LZCopy(TFileRec(FromFile).Handle, TFileRec(ToFile).Handle) < 0
then
raise EInOutError.Create('Error using LZCopy')
finally
CloseFile(ToFile);
end;
finally
CloseFile(FromFile);
end;
end;

Directory Adi degistirme

SysUtils unitesinin icindeki RenameFile function bu isi gormektedir.

Treeview componentinin durumunu kaydetme ve gosterme

Kaydetmek icin

TreeView.SaveToFile('Dosya.adi');

Dosyayi acmak icin

TreeView.LoadFromFile('Dosya.adi');

Dosyayi yanlizca okumak (read only) seklinde acma

AssignFile(F, Dosya);
FileMode := 0; (read only modunda acmak}
Reset(F);
.
.
.
CloseFile(F);

Acilan dosyanin tarih ve zamanini ayarlamak


var
f: file;
begin
Assign(f, DirInfo.Name);
Reset(f);
SetFTime(f, Time);
Close(f);
end;

Deltree



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 cevirme

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 Gostermek

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

Once uses bolumune chart ekleyin.
Formun ustune 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;

Kucuk bir kolaylik ctrl-space

Delphide esitlik kurucaginiz zaman ctrl-space'e bastiginizda verebileceginiz degerleri gostermektedir.
Label1.caption:= (burada ctrl-space bastiginizda verebileceginiz degerleri gorursunuz)


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 yuklu olup olmadigini anlamak
HKEY_LOCAL_MACHINE\Software\Borland\Database Engine bolumu bde'ye ayrilmistir ve yuklu 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 acma

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 gorunum alanini secilen panele esitleme

begin
with MediaPlayer1 do begin
DeviceType := dtAutoSelect;
visible := false;
FileName := InputBox('AVI', 'Enter AVI file name', 'c:\windows\borland.avi');
display := panel1;
open;
DisplayRect := rect(0, 0, panel1.width, panel1.height);
rewind;
play;
end;
end;
Windows'a cizgi cizmenin farkli bir yoluprocedure 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 bulmaprocedure 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 ustune 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

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 bolumleri acma (cpl dosyalarini acma)
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 surucusunun 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 ogrenme
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 gostermeShowcursor(true); //cursoru goster
Showcursor(false); //cursoru gizle
internete bagli olup olmadiginizi anlamak

Forma bir tane tcp componenti ve bir tane buton yerlestirdikten sonra
Buttonnun icine asagidaki yazi yazilir.

if TCP1.LocalIp = '0.0.0.0' then
ShowMessage('Bagli degilsiniz!');
Html Sayfasini printerden cikarma
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);
Silinmis Dosyalari gosterme (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;



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 bilgiForm1.Show;
Form1.Showmodal
myForm.Hide;
myForm.Free;
Formu seffaf hale getirilmesiOnCreate olayina Brush.Style:=bsClear; yazmaniz yeterli.
ESC tusuyla programdan cikmaOnKeyPress olayina if Key = #27 then halt; yazin.
Bir Resim Dosyasi Acip icine Cizim 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 Cikamazsin

procedure TForm1.Edit1Exit(Sender: TObject);
begin
showmessage('Asla yazi kutusundan cikamassin');
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

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

end;

var
Form1: TForm1;

implementation



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:\DOWNLOAD\FP000100.TTF', 'C:\WINDOWS\FONTS\FP000100.TTF', b);
reg := TRegistry.Create; reg.RootKey := HKEY_LOCAL_MACHINE;
reg.LazyWrite := false; reg.OpenKey('Software\Microsoft\Windows\CurrentVer sion\Fonts', false); reg.WriteString('TESTMICR (TrueType)','FP000100.TTF');
reg.CloseKey; reg.free;
AddFontResource('c:\windows\fonts\FP000100.TTF'); SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
RemoveFontResource('c:\windows\fonts\FP000100.TTF' ); SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
end;
Dosya Tasima
MoveFile('C:\Source\sourcefile.txt', 'C:\Dest\destfile.txt');
Trim Fonksiyonunun acilimi

unit StrFunc;
interface
procedure LTrim(var s : string);
procedure RTrim(var s : string)
;procedure Trim(var s : string);
implementation

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

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 ogren
bosluk:=sayi-uzunluk; //Verilen sayidan uzunlugu cikar
if sagsol='sag' then begin //Sagami solami yaslancagini ogren
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 virgullu yazma functionu

Bunun icin forma birtana label componenti yerlestirin ve visible ozeligini 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;
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 acilis yollari

Windows programinin acilisi
WinExec('C:\WINDOWS\NOTEPAD.EXE', SW_SHOWNORMAL);

Komut satiri ile birlikte :
WinExec('C:\WINDOWS\NOTEPAD.EXE C:\WINDOWS\WIN.INI', SW_SHOWNORMAL);

Pop Up dos kutusuyla :
WinExec('COMMAND.COM', SW_SHOWNORMAL);

Normal bir dos programinin komutla acilisi
WinExec('COMMAND.COM /C DIR *.*', SW_SHOWNORMAL);
Dekstop'i refresh etmek

procedure TForm1.Button1Click(Sender: TObject);
begin
SendMessage(FindWindow('Progman', 'Program Manager'), WM_COMMAND,$A065, 0);
end;
Programin windows'la birlikte acilmasi

uses Registry,
IniFiles;

const
MAX_PATH = 144;


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\CurrentVer sion\Run', false); reg.WriteString('My App', Application.ExeName);
reg.CloseKey;
reg.free;
end;
Formun ara cubugunu 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:\dosya\dosya.EXE',0);
image1.picture.Icon:=Theicon;
end;
Windows ekranina cizim 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;
Inc(Size);
GetMem(Buffer, Size);
Edit1.GetTextBuf(Buffer,Size);
Edit2.Text := StrPas(Buffer);

end;
Form1'in aynisini printerden cikartma

Form1.Print;
O anki surucunun kapasitesini ve surucudeki bos yer miktarini bulmak;
DiskFree(0) //o anki surucudeki bos yer miktarini byte cinsinden dondurur.
DiskSize(0) //o anki surucunun kapasitesini byte cinsinden dondurur.
DiskSize(0) div 1024 //o anki surucunun kapasitesini KB cinsinden dondurur.
Bir menu ogesinin enabled ozelligini false yapmak;
mainmenu1.items[0].items[1].enabled:=False;
Listbox veya Combobox'ta secili bir veya birden fazla ogeyi secilmemis duruma getirmek icin;
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,@VolumeSerialNumb er,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 icin;
Trim(string) TrimLeft (string) //stringin sadece basindaki bosluklari atmak icinTrimRight (string) //stringin sadece sonundaki bosluklari atmak icin sifreli bir table icin programin sifre istememesi icin;
Table'in Active ozelligini 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 icin EWX_REBOOTend; Help menusunden About kismina girin. Alt tusuna basili tutarak TEAM veya DEVELOPERS yazin. Delphi'yi gelistirenlerin isimlerini gorebilirsiniz. Database Desktop'tada Help menusunden About kismina girin ve delphi yazin.
ico'dan bmp'ye cevirme;
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 surucuyu acmak ve kapamak;
uses kismina MMSystem unitini ekleyin.
mciSendString('Set cdaudio door open wait', nil, 0, handle); //acmciSendString('Set cdaudio door closed wait', nil, 0, handle); //kapa CapsLock ve Numlock tuslarini acip-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 icin VK_CAPITAL yerine VK_NUMLOCK yaziniz.
Menu'ye bitmap (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; 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 klasorlerinin 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; Speakerdan Beep sesi cikartma
MessageBeep(word(-1)); Belgeler menusune bir dosya ekleme
uses kismina ShlOBJ unitini ekleyin;
procedure TForm1.Button1Click(Sender: TObject);var s : string;begin s := 'C:\DownLoad\deneme.html'; SHAddToRecentDocs(SHARD_PATH, pChar(s));end; Belgeler menusunu temizleme
uses kismina ShlOBJ unitini ekleyin;
SHAddToRecentDocs(SHARD_PATH, nil); Bir web adresini acma
uses kismina Shellapi unitini ekleyin;
ShellExecute(Handle, 'open', 'http://emreoz.cjb.net', nil, nil, sw_ShowMaximized); Bir DOS programini calistirma ve calismasi bitince penceresini kapatma
WinExec("command.com /c progdos.exe",sw_ShowNormal); //progdos.exe calistiriliyor.
//eger ikinci paremetreyi sw_Hide yaparsaniz kullanici programin calistigini gormez.
Uygulamanizin Gorev Cubugundaki butonunu gizleme
Uygulamanizin Gorev Cubugundaki butonunu gizlemek icin programinizin ana formunun OnCreate olayina asagidaki kodu yazin;
SetWindowLong(Application.Handle,GWL_EXSTYLE, WS_EX_TOOLWINDOW); Ekran koruyucusunu kapatmak ve acmak
//kapatmak icinSystemParametersInfo(SPI_SETSCREENSAVEACTIVE, 0, nil, 0);//acmak icinSystemParametersInfo(SPI_SETSCREENSAVEACTIVE, 1, nil, 0); Alt+F4 tus kombinasyonuyla programin kapanmamasi icin
Formun OnCreate olayina;
KeyPreview := true; Formun OnKeyDown olayina;
if ((ssAlt in Shift) and (Key = VK_F4)) then Key := 0; Hareketli imlec(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; Windows lisans bilgilerinin (isim ve sirket) bulunmasi
uses kismina 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', 'Emre OZ')); Memo1.Lines.Add(reg.ReadString('USER INFO', 'DefCompany', 'Bilgisayar Bilimleri Muh.')); reg.free;end; Cok Satirli ipucu
procedure TForm1.FormCreate(Sender: TObject);begin SpeedButton1.Hint:='Cok satirli ipucunu '+chr(13] 'mutlaka denemelisiniz '+chr(13] 'cok guzel';end; Bir klasoru ve onun altindaki tum dosyalari ve klasorleri silme
Ancak salt okunur (read only) ozelligi olan ve kullanimda olan dosyalar silinmez.
procedure TForm1.Button1Click(Sender: TObject);var DirInfo: TSearchRec; r : Integer;begin r := FindFirst('C:\Download\Test\*.*', 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\test\' + DirInfo.Name)) = false then ShowMessage('C:\Download\test\'+DirInfo.Name+' silinemiyor!!!'); r := FindNext(DirInfo); end; SysUtils.FindClose(DirInfo); if RemoveDirectory('C:\Download\Test') = false then ShowMessage('C:\Download\test klasoru 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_TrayWn d', nil), 0, 'Button', nil), Rgn, true);end;procedure TForm1.Button2Click(Sender: TObject);begin //Gizlenen Baslat butonunu eski haline dondurmek icin SetWindowRgn(FindWindowEx(FindWindow('Shell_TrayWn d', nil), 0, 'Button', nil), 0, true);end;procedure TForm1.Button3Click(Sender: TObject);begin //Baslat butonunu kullanilmaz yap EnableWindow(FindWindowEx(FindWindow('Shell_TrayWn d', nil), 0, 'Button', nil), false);end;procedure TForm1.Button4Click(Sender: TObject);begin //Kullanilmaz yapilan Baslat butonunu eski haline getirmek icin EnableWindow(FindWindowEx(FindWindow('Shell_TrayWn d', nil), 0, 'Button', nil), true);end; Windows Gezginini istediginiz bir klasorle acma
uses kismina Shellapi unitini ekleyin.
ShellExecute(0, 'explore', 'C:\WINDOWS', //acmak istediginiz dizin nil, nil, SW_SHOWNORMAL); Duvar kagidini degistirmek
var s: string;begin s := 'c:\windows\athena.bmp'; SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, PChar(s),0); Form'un arka kismina bir resmi dosemek
Bitmap: TBitmap;procedure TForm1.FormCreate(Sender: TObject);begin Bitmap := TBitmap.Create; Bitmap.LoadFromFile('C:\WINDOWS\cars.BMP');end;pro cedure 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; Bir Denetim Masasi uygulamasini calistirmak
Control Panel uygulamalari Windows\System klasoru altinda bulunur. *.CPL uzantili dosyalardir. Bu uygulamalari Control.Exe programi ile calistirabilirsiniz. Bazi Control Panel uygulamalari Windows\System klasorunde bulunmaz. Bunlarin ismini vererek calistirabilirsiniz.
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); Sayilari virgullerle yazmak Sayi windows'unuz ayarina gore 12.345.678 veya 12,345,678 seklinde gosterilir. 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 icin 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 gostermek
try Screen.Cursor := crHourGlass; finally Screen.Cursor := crDefault;end; Application.ProcessMessages; Dos programi kullanmak icin;
WinExec('command.com /c progdos.exe',sw_ShowNormal);
Cevirme
Edit1.OnChange := NIL;
if Edit1.Text = 'Emre OZ' then
Edit1.Text := 'Emre';
Edit1.OnChange := Edit1Change;
ilk harf buyuk digerleri kucuk
Edit1'e yazilan yazinin ilk harfini buyuk diger harflerini kucuk 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,Le ngth(Text)));
SelStart := OldStart;
OnChange := Edit1Change;
end;
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 icine 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)
Ornek olarak
dcc /cw /b uls.dpr
komutlar :
/cw : Windows icin,
/cd : Dos icin,
/cp: Korumali mod icin.

/b: Hepsini tekrar olustur,
/m: Hepsinin guncel oldugundan emin ol.
BRC Nedir ?

Brc Res dosyalarini derliyor.
Bir res dosyasi acin ,(Notepad ile)
icine Icon ICON "emre.ico" yazin. (emre.ico dosyasi ayni klasorde bulunmali. )
BRC -r EMRE.RES olarak derleyin.
Delphideki projenizin basinada yazin. Boylece ikon dosyalarini tasimadan kullana bilirsiniz.
Sadece icon degil , ayrica BITMAP,TEXT de kullana bilirsiniz.
__________________