DeLPHi Yararlı KodLaR!...

~~*MeLeK*~~ · 28-01-2008, 12:11

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; 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.*******; 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.*******; 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_MACHINE\Software\Borland\Database 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;

28-01-2008, 12:11	#1 (permalink)
~~MeLeK~~ Banlandı Üyelik tarihi: 22-11-2007 Nerden: napıcan ziyaretemi geLcen!! Mesajlar: 0 Konular: 2724 Üye No: 11416 Ruh halim: Rep Gücü : 0 Rep Puanı : 0 Rep Seviyesi :	DeLPHi Yararlı 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; 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.*****; 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.*****; 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_MACHINE\Software\Borland\Database 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;

Konu Araçları
Yazdırılabilir şekli göster Sayfayı E-Mail olarak gönder
Stil
Normal Hybrid-şeklinde gösterime geç Ağaç şeklinde gösterime geç

Benzer Konular
Konu	Konuyu Başlatan	Forum	Cevaplar	son Mesaj
Delphi Kod Arşivi 1.1	GhostShip	Delphi	0	24-08-2008 16:34
{Adminler İiçin} Çok yaRarlı Kodlar	UND€RTaK€R	Private Serverler	6	14-08-2008 15:18
Çok..Yararlı..QA..Kodları..	xt985	Private Serverler	1	23-06-2008 21:02
DELphi MEnüleri	MeLeK	Delphi	0	28-01-2008 11:05
Facebook Yararlı mı Zararlı mı?	wanted	FaceBook	0	24-01-2008 01:06