Kod:
3 Boyutlu Kup Orneği Kod:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Gauges, ExtCtrls; type TForm1 = class(TForm) Timer1: TTimer; procedure Timer1Timer(Sender: TObject); private public end; var Form1: TForm1; x,y,x1,y1:integer; aci:real; p1,p2,p3,p4,p5,p6,p7,p8:tpoint; implementation procedure TForm1.Timer1Timer(Sender: TObject); begin aci:=aci+2*pi/360; p1.X:=200; p1.Y :=200; p2.X :=p1.X +100; p2.Y :=p1.Y ; p3.X :=p1.X +100; p3.Y :=p1.Y +100; p4.X :=p1.X ; p4.Y :=p1.Y +100; p5.X :=p1.X +round(sin(aci)*50); p5.Y :=p1.X +round(cos(aci)*50); p6.X :=p5.X +100; p6.Y :=p5.Y ; p7.X :=p5.X +100; p7.Y :=p5.Y +100; p8.X :=p5.X ; p8.Y :=p5.Y+100 ; canvas.Pen.Color :=clblack; canvas.Pen.Style:=psdot; canvas.Pen.Width :=1; canvas.MoveTo(p1.X ,p1.y); canvas.LineTo(p2.X ,p2.Y); canvas.LineTo(p3.X ,p3.Y); canvas.LineTo(p4.X ,p4.Y); canvas.LineTo(p1.X ,p1.Y); canvas.Pen.Style :=pssolid; canvas.Pen.Width:=3; canvas.LineTo(p5.X ,p5.Y); canvas.LineTo(p6.X ,p6.Y); canvas.LineTo(p7.X ,p7.Y); canvas.LineTo(p8.X ,p8.Y); canvas.LineTo(p5.X,p5.Y); canvas.MoveTo(p2.X,p2.Y); canvas.LineTo(p6.X ,p6.y); canvas.MoveTo(p3.X,p3.Y); canvas.LineTo(p7.X ,p7.y); canvas.MoveTo(p4.X,p4.Y); canvas.LineTo(p8.X ,p8.y); sleep(1); canvas.Pen.Color :=form1.Color; canvas.MoveTo(p1.X ,p1.y); canvas.LineTo(p2.X ,p2.Y); canvas.LineTo(p3.X ,p3.Y); canvas.LineTo(p4.X ,p4.Y); canvas.LineTo(p1.X ,p1.Y); canvas.LineTo(p5.X ,p5.Y); canvas.LineTo(p6.X ,p6.Y); canvas.LineTo(p7.X ,p7.Y); canvas.LineTo(p8.X ,p8.Y); canvas.LineTo(p5.X,p5.Y); canvas.MoveTo(p2.X,p2.Y); canvas.LineTo(p6.X ,p6.y); canvas.MoveTo(p3.X,p3.Y); canvas.LineTo(p7.X ,p7.y); canvas.MoveTo(p4.X,p4.Y); canvas.LineTo(p8.X ,p8.y); end; end.


Kod:
Alt + Tab İptal Etmek Kod:
procedure DisableAltTab; var iTemp: Integer; begin iTemp := 0; SystemParametersInfo(SPI_SETFASTTASKSWITCH, 1, @iTemp, 0); end;
FormCreate ye Kod:
DisableAltTab;


Kod:
Bilgisayar Ne Zamandır Acık? Kod:
function Uptime: string; var count, days, min, hours, seconds : longint; begin Count := GetTickCount(); Count := Count div 1000; Days := Count div (24 * 3600); if Days > 0 then Count := Count - (24 * 3600 * Days); Hours := Count div 3600; if Hours > 0 then Count := Count - (3600 * Hours); Min := Count div 60; Seconds := Count mod 60; Result := IntToStr(Days]' Gun '+IntToStr(Hours] ' Saat '+IntToStr(Min]' Dakika '+ IntToStr(seconds) +' Saniye '; end;
Kullanımı Kod:
Edit1.Text:=Uptime;


Kod:
Butona Cok Satırlı Yazı Kod:
var i : integer; begin i:=GetWindowLong(Button1.Handle,GWL_STYLE ); SetWindowLong (Button1.Handle,GWL_STYLE , i or BS_MULTILINE); Button1.Caption := 'satır1'#13#10'satır2';


Kod:
Exe Şifreleme 1 OpenDialog 2 Radio Button 1 Button Kod:
procedure TForm1.Button1Click(Sender: TObject); var header : array [0..4] of char; thefile : tfilestream; Checkheader : string; begin OpenDialog1.Filter :='Exe Dosyası (*.exe)|*.exe'; if OpenDialog1.Execute then begin thefile :=tfilestream.Create(OpenDialog1.FileName , fmopenreadwrite); if radiobutton1.Checked = true then begin thefile.Seek(0,sofrombeginning); thefile.Read(header,sizeof(header)); if header[0]=chr(05) then begin messagebox(form1.Handle , 'Secdiğiniz Dosya Daha Onceden Zaten Şifrelenmiş','Uyarı',mb_iconexclamation + mb_ok); thefile.Free; exit; end; thefile.Seek(0,sofrombeginning); thefile.Write(chr(05) + chr(05) + chr(05) + chr(05),4); thefile.Seek(-5,sofromend); thefile.Write(header,sizeof(header)); thefile.Free; Showmessage('Dosya Kilitlendi'); end else if radiobutton2.Checked = true then begin thefile.Seek(-5,sofromend); thefile.Read(header,sizeof(header)); thefile.Seek(0,sofrombeginning); thefile.Write(header,sizeof(header)); thefile.Free; showmessage('Dosya Cozuldu'); end; end; end;


Kod:
Forma İstediğin Şekli Ver Kod:
procedure TForm1.FormCreate(Sender: TObject); var Bmp: TBitmap; begin Bmp := TBitmap.Create; try Bmp.LoadFromFile('1000.bmp'); FRegion := CreateRegion(Bmp); SetWindowRGN(Handle, FRegion, True); finally Bmp.Free; end; end;
Not : 1000.bmp Adındaki Dosyayı Paint ile yapabilirsiniz. Ama Formda Transparan (Saydam) Olmasını İstediğiniz Yerler paintteki Arka fon rengi ile Aynı olması lazım. (Arka taraftaki Koyu Gri Olan Renk)

Kod:
Harddiskte Nekadar Boş Yer Var? Kod:
var bos_alan:Integer; begin bos_alan:=DiskFree(3); showmessage(IntToStr(bos_alan));
Harddiskin Toplam Kapasitesi? Kod:
var alan:Integer; begin alan:=DiskSize(3); showmessage(IntToStr(alan));
Not : DiskFree(3) ve DiskSize(3) komutundaki 3 yazan yeri 4 yaparsanız D diskine bakar yani alfabetik sıraya gore. A = 1 B = 2 C = 3 D = 4 .....

Kod:
Rastgele Harf Uretme Kod:
var harf : char; begin for harf := 'Z' DownTo 'A' do ShowMessage('Harfiniz = '+harf);
Not : for harf := 'Z' DownTo 'A' do G ile A arasında bir Harf Uretir! Bunu değiştirebilirsiniz.

Kod:
İşlemcinin Hızını Oğrenme! Bunlar Ekleyeceğiniz Fonksiyonlar Kod:
function RDTSC : Int64; assembler; asm db $0F, $31 end; function RDQPC : Int64; begin QueryPerformanceCounter(result); end; function CPUSpeed : Integer; var f,tsc,pc : Int64; begin if QueryPerformanceFrequency(f) then begin Sleep(0); pc := RDQPC; tsc := RDTSC; Sleep(100); pc := RDQPC-pc; tsc := RDTSC-tsc; result := round(tsc*f/(pc*1000000)); end else result := -1; end;
Kullanımı Kod:
showmessage(Format('%d Mhz', [CPUSpeed]));


Kod:
İşlemcinin Markasını Oğrenmek Kod:
function GetVendorString: string; var aVendor: array[0..2] of DWord; iI, iJ : Integer; begin asm push ebx xor eax, eax dw $A20F // CPUID instruction mov DWord ptr aVendor, ebx mov DWord ptr aVendor[+4], edx mov DWord ptr aVendor[+8], ecx pop ebx end; for iI := 0 to 2 do for iJ := 0 to 3 do Result := Result + Chr((aVendor[iI] and ($000000FF shl (iJ * 8))) shr (iJ * 8)); end;
Kullanımı Kod:
showmessage(GetVendorString);


Kod:
Kes, Kopyala, Yapıştır, Sil, Geri Al Kes Kod:
edit1.perform(wm_cut,0,0);
Kopyala Kod:
edit1.perform(wm_copy,0,0);
Yapıştır Kod:
edit1.perform(wm_paste,0,0);
Sil Kod:
edit1.perform(wm_clear,0,0);
Geri Al Kod:
Edit1.perform(em_undo,0,0);


Kod:
Secilen Klasordeki İstediğin Uzantıdaki Dosyaları Listeler 1 buton 1 listbox Kod:
procedure TForm1.Button1Click(Sender: TObject); var dosya:TSearchRec; begin if FindFirst('c:\Hamal\*.txt', faAnyFile, dosya) = 0 then begin repeat ListBox1.Items.Add(dosya.Name); until FindNext(dosya) 0; FindClose(dosya); end; end;


Kod:
Kullanıcı Ve PC adı alma 1 buton 2 label Kod:
procedure TForm1.Button1Click(Sender: TObject); var u: array[0..127] of Char; c: array[0..127] of Char; KullaniciAdi: string; BilgisayarAdi: string; s: dword; begin s := SizeOf(u); GetUserName(u, s); s := SizeOf(c); GetComputerName(c, s); KullaniciAdi := u; BilgisayarAdi := c; Label1.Caption := u; Label2.Caption := c; end;


Kod:
Masaustune Yazı Yazdırma! Eklenicek Procedurler Kod:
procedure TForm1.YaziYaz(Yazin: string; x,y: Integer; yazitipi: TFont); var Masaustu: HWND; Bdc: HDC; Cizim: TCanvas; begin Masaustu := GetDesktopWindow; Bdc := GetWindowDC(Masaustu); Cizim := TCanvas.Create; Cizim.Handle := Bdc; BeginPath(Cizim.Handle); Cizim.Font:=yazitipi; SetBkMode(Cizim.Handle, TRANSPARENT); EndPath(Cizim.Handle); Cizim.TextOut(x, y, Yazin); end;
Kullanımı 1 tane Font Dialog Ekleyip Yazı tipi ayarlarını yapin Kod:
YaziYaz('Kod Kendi Yapımımdır Cryz4dvl4',100,150,FontDialog1.Font);


Kod:
Programın Calışma Klasoru Ve Bulunduğu Yol Bulunduğu Klasor Kod:
showmessage(GetCurrentDir);
Bulunduğu Yol Kod:
showmessage(GetCommandLine);


Kod:
Aynı Tur Nesnelerin Hepsine Tek Bir Komut Gonderme! Kod:
var nesne: Integer; begin for nesne:=1 to 20 do TEdit(FindComponent('Edit'+inttostr( nesne ))).Text:='Coded ßy Cryz4dvl4'; end;
Not : for nesne:=1 to 20 do // 20 tane nesneye etki eder.


Kod:
Mouse'a Yapışmış Form FormCreate Olayına Kod:
SetWindowLong( Handle,GWL_STYLE,GetWindowLong( Handle, GWL_STYLE )and not WS_CAPTION ); SetWindowLong(Application.Handle,GWL_EXSTYLE, WS_EX_TOOLWINDOW); SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
1 Timer Ekleyin Ve Intervalini 1 yapın. OnTimer Olayına Kod:
Left:=Mouse.CursorPos.X+10; Top:=Mouse.CursorPos.Y+10;


Kodların Bazıları Kendi Yazımımdır.

Kodları Bazılarıda (C)Alıntıdır.

Gule Gule Kullanın.
__________________