uses ShellApi;
function CopyDir(const fromDir, toDir: string): Boolean;
var fos: TSHFileOpStruct;
begin
ZeroMemory(@fos, SizeOf(fos));
with fos do begin
wFunc := FO_COPY;
fFlags := FOF_FILESONLY;
pFrom := PChar(fromDir + #0);
pTo := PChar(toDir)
end;
Result := (0 = ShFileOperation(fos));
end;
function MoveDir(const fromDir, toDir: string): Boolean;
var fos: TSHFileOpStruct;
begin
ZeroMemory(@fos, SizeOf(fos));
with fos do begin
wFunc := FO_MOVE;
fFlags := FOF_FILESONLY;
pFrom := PChar(fromDir + #0);
pTo := PChar(toDir)
end;
Result := (0 = ShFileOperation(fos));
end;
function DelDir(dir: string): Boolean;
var fos: TSHFileOpStruct;
begin
ZeroMemory(@fos, SizeOf(fos));
with fos do begin
wFunc := FO_DELETE;
fFlags := FOF_SILENT or FOF_NOCONFIRMATION;
pFrom := PChar(dir + #0);
end;
Result := (0 = ShFileOperation(fos));
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if cCopyDir('d:\download', 'e:\') = True then
ShowMessage('Directory copied.');
end;
5 Şubat 2012 Pazar
Cut-Copy-Paste
Kesme, Kopyalama ve Yapıştırma işlemlerini, Klavye kullanılarak yapmak oldukça kolaydır. Bu işlemler menü elemanları vasıtasıyla da yapılabilir. Şayet bileşen, bu komutları aldığında ne yapacağını biliyorsa, Windows mesajlarını kullanmak en uygun hareket tarzıdır.
Kesme;
if GetFocus <> 0 then { Seçili bir pencere varmı? }
SendMessage( GetFocus, WM_CUT, 0, 0
Kopyalama;
if GetFocus <> 0 then { Seçili bir pencere varmı? }
SendMessage( GetFocus, WM_COPY, 0, 0
Yapıştırma;
if GetFocus <> 0 then { Seçili bir pencere varmı? }
SendMessage( GetFocus, WM_PASTE, 0, 0);
Kesme;
if GetFocus <> 0 then { Seçili bir pencere varmı? }
SendMessage( GetFocus, WM_CUT, 0, 0
Kopyalama;
if GetFocus <> 0 then { Seçili bir pencere varmı? }
SendMessage( GetFocus, WM_COPY, 0, 0
Yapıştırma;
if GetFocus <> 0 then { Seçili bir pencere varmı? }
SendMessage( GetFocus, WM_PASTE, 0, 0);
Copy-Cut-Past-Delete Edit uygulaması
*- COPY CUT PAST DELETE UNDO
edit1.perform(wm_copy,0,0); // edit1 deki metni panoya kopyalar.
edit1.perform(wm_cut,0,0); // Kes işlemini yapar.
edit1.perform(wm_paste,0,0); // Panodaki metni edit1 e yapıştırır.
edit1.perform(wm_clear,0,0); // edit1.clear 'de aynı işi görür.
Edit1.perform(em_undo,0,0); // Yapılan son işlemi geri alır.
Bu kodları memo, listbox, combobox, richtext bileşenleri içinde kullanabilirsiniz.
edit1.perform(wm_copy,0,0); // edit1 deki metni panoya kopyalar.
edit1.perform(wm_cut,0,0); // Kes işlemini yapar.
edit1.perform(wm_paste,0,0); // Panodaki metni edit1 e yapıştırır.
edit1.perform(wm_clear,0,0); // edit1.clear 'de aynı işi görür.
Edit1.perform(em_undo,0,0); // Yapılan son işlemi geri alır.
Bu kodları memo, listbox, combobox, richtext bileşenleri içinde kullanabilirsiniz.
Copy-Delete-Move Function
uses ShellApi;
function CopyDir(const fromDir, toDir: string): Boolean;
var fos: TSHFileOpStruct;
begin
ZeroMemory(@fos, SizeOf(fos));
with fos do begin
wFunc := FO_COPY;
fFlags := FOF_FILESONLY;
pFrom := PChar(fromDir + #0);
pTo := PChar(toDir)
end;
Result := (0 = ShFileOperation(fos));
end;
function MoveDir(const fromDir, toDir: string): Boolean;
var fos: TSHFileOpStruct;
begin
ZeroMemory(@fos, SizeOf(fos));
with fos do begin
wFunc := FO_MOVE;
fFlags := FOF_FILESONLY;
pFrom := PChar(fromDir + #0);
pTo := PChar(toDir)
end;
Result := (0 = ShFileOperation(fos));
end;
function DelDir(dir: string): Boolean;
var fos: TSHFileOpStruct;
begin
ZeroMemory(@fos, SizeOf(fos));
with fos do begin
wFunc := FO_DELETE;
fFlags := FOF_SILENT or FOF_NOCONFIRMATION;
pFrom := PChar(dir + #0);
end;
Result := (0 = ShFileOperation(fos));
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if cCopyDir('d:\download', 'e:\') = True then
ShowMessage('Directory copied.');
end;
function CopyDir(const fromDir, toDir: string): Boolean;
var fos: TSHFileOpStruct;
begin
ZeroMemory(@fos, SizeOf(fos));
with fos do begin
wFunc := FO_COPY;
fFlags := FOF_FILESONLY;
pFrom := PChar(fromDir + #0);
pTo := PChar(toDir)
end;
Result := (0 = ShFileOperation(fos));
end;
function MoveDir(const fromDir, toDir: string): Boolean;
var fos: TSHFileOpStruct;
begin
ZeroMemory(@fos, SizeOf(fos));
with fos do begin
wFunc := FO_MOVE;
fFlags := FOF_FILESONLY;
pFrom := PChar(fromDir + #0);
pTo := PChar(toDir)
end;
Result := (0 = ShFileOperation(fos));
end;
function DelDir(dir: string): Boolean;
var fos: TSHFileOpStruct;
begin
ZeroMemory(@fos, SizeOf(fos));
with fos do begin
wFunc := FO_DELETE;
fFlags := FOF_SILENT or FOF_NOCONFIRMATION;
pFrom := PChar(dir + #0);
end;
Result := (0 = ShFileOperation(fos));
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if cCopyDir('d:\download', 'e:\') = True then
ShowMessage('Directory copied.');
end;
Copy File or Directory
uses ShellAPI;
function CopyAllFiles(sFrom, sTo: string; Protect: boolean): boolean;
{ Copies files or directory to another directory. }
var F: TShFileOpStruct; ResultVal: integer; tmp1, tmp2: string;
begin
FillChar(F, SizeOf(F), #0);
Screen.Cursor := crHourGlass;
try
F.Wnd := 0;
F.wFunc := FO_COPY;
{ Add an extra null char }
tmp1 := sFrom + #0;
tmp2 := sTo + #0;
F.pFrom := PChar(tmp1);
F.pTo := PChar(tmp2);
if Protect then
F.fFlags := FOF_RENAMEONCOLLISION or FOF_SIMPLEPROGRESS
else
F.fFlags := FOF_SIMPLEPROGRESS;
F.fAnyOperationsAborted := False;
F.hNameMappings := nil;
Resultval := ShFileOperation(F);
Result := (ResultVal = 0);
finally
Screen.Cursor := crDefault;
end;
end;
function CopyAllFiles(sFrom, sTo: string; Protect: boolean): boolean;
{ Copies files or directory to another directory. }
var F: TShFileOpStruct; ResultVal: integer; tmp1, tmp2: string;
begin
FillChar(F, SizeOf(F), #0);
Screen.Cursor := crHourGlass;
try
F.Wnd := 0;
F.wFunc := FO_COPY;
{ Add an extra null char }
tmp1 := sFrom + #0;
tmp2 := sTo + #0;
F.pFrom := PChar(tmp1);
F.pTo := PChar(tmp2);
if Protect then
F.fFlags := FOF_RENAMEONCOLLISION or FOF_SIMPLEPROGRESS
else
F.fFlags := FOF_SIMPLEPROGRESS;
F.fAnyOperationsAborted := False;
F.hNameMappings := nil;
Resultval := ShFileOperation(F);
Result := (ResultVal = 0);
finally
Screen.Cursor := crDefault;
end;
end;
Copy File - Windows Apileri kullanarak
Function CopyFiles(const Source,Destination: String): Boolean;
var
SHFileOpStruct : TSHFileOpStruct;
begin
if FileExists(Source) then
begin
FillChar(SHFileOpStruct,SizeOf (TSHFileOpStruct),#0);
with SHFileOpStruct do begin
Wnd:=Application.Handle;
wFunc:=FO_COPY;
fFlags:=FOF_ALLOWUNDO;
hNameMappings:=nil;
pFrom:=PChar(Source+#0+#0);
pTo:=PChar(Destination+#0+#0);
end;
Result := ShFileOperation(SHFileOpStruct ) = 0;
end else Result := False;
end;
// Kullanımı:
procedure TForm1.Button1Click(Sender: TObject);
begin
if not CopyFiles('C:\\windows\\notepad. exe', 'C:\\sil\\notepad.exe') then
showmessage('Kopyalama islemi basarisiz');
end;
var
SHFileOpStruct : TSHFileOpStruct;
begin
if FileExists(Source) then
begin
FillChar(SHFileOpStruct,SizeOf (TSHFileOpStruct),#0);
with SHFileOpStruct do begin
Wnd:=Application.Handle;
wFunc:=FO_COPY;
fFlags:=FOF_ALLOWUNDO;
hNameMappings:=nil;
pFrom:=PChar(Source+#0+#0);
pTo:=PChar(Destination+#0+#0);
end;
Result := ShFileOperation(SHFileOpStruct ) = 0;
end else Result := False;
end;
// Kullanımı:
procedure TForm1.Button1Click(Sender: TObject);
begin
if not CopyFiles('C:\\windows\\notepad. exe', 'C:\\sil\\notepad.exe') then
showmessage('Kopyalama islemi basarisiz');
end;
Copy File Örnekleri
COPY FILE
Uses ShellApi, ShlObj;
procedure CopyFiles(const FromFolder: string; const ToFolder: string);
var Fo : TSHFileOpStruct; buffer : array[0..4096] of char; p : pchar;
begin
FillChar(Buffer, sizeof(Buffer), #0);
p := @buffer;
StrECopy(p, PChar(FromFolder)); //this is folder that you want to copy
FillChar(Fo, sizeof(Fo), #0);
Fo.Wnd := Application.Handle;
Fo.wFunc := FO_COPY;
Fo.pFrom := @Buffer;
Fo.pTo := PChar(ToFolder); //this is where the folder will go
Fo.fFlags := 0;
if ((SHFileOperation(Fo) <> 0) or (Fo.fAnyOperationsAborted <> false)) then
ShowMessage('File copy process cancelled')
end;
CopyFiles('Kopyalamak istediğin klasörün yolu ve adı','Kopyalamak istediğin dizin ve ad yani hedef');
***YADA***
Hedef dizin, c:\deneme\ olsun . Proğramı otomatik olarak bulur ve hedef dizine koyalar.
CopyFile(pchar(ExtractFileName(Application.ExeName)),pchar('C:\deneme\' + ExtractFileName(Application.ExeName)), True);
***YADA***
CopyFile('C:\\Autoexec.bat', 'A:\\Backup\\Autoexec.bat', False);
CopyFile(PChar(Edit1.Text), PChar(Edit2.Text), False);
***YADA***
uses ShellAPI;
function CopyAllFiles(sFrom, sTo: string; Protect: boolean): boolean;
{ Copies files or directory to another directory. }
var F: TShFileOpStruct; ResultVal: integer; tmp1, tmp2: string;
begin
FillChar(F, SizeOf(F), #0);
Screen.Cursor := crHourGlass;
try
F.Wnd := 0;
F.wFunc := FO_COPY;
{ Add an extra null char }
tmp1 := sFrom + #0;
tmp2 := sTo + #0;
F.pFrom := PChar(tmp1);
F.pTo := PChar(tmp2);
if Protect then
F.fFlags := FOF_RENAMEONCOLLISION or FOF_SIMPLEPROGRESS
else
F.fFlags := FOF_SIMPLEPROGRESS;
F.fAnyOperationsAborted := False;
F.hNameMappings := nil;
Resultval := ShFileOperation(F);
Result := (ResultVal = 0);
finally
Screen.Cursor := crDefault;
end;end;
Uses ShellApi, ShlObj;
procedure CopyFiles(const FromFolder: string; const ToFolder: string);
var Fo : TSHFileOpStruct; buffer : array[0..4096] of char; p : pchar;
begin
FillChar(Buffer, sizeof(Buffer), #0);
p := @buffer;
StrECopy(p, PChar(FromFolder)); //this is folder that you want to copy
FillChar(Fo, sizeof(Fo), #0);
Fo.Wnd := Application.Handle;
Fo.wFunc := FO_COPY;
Fo.pFrom := @Buffer;
Fo.pTo := PChar(ToFolder); //this is where the folder will go
Fo.fFlags := 0;
if ((SHFileOperation(Fo) <> 0) or (Fo.fAnyOperationsAborted <> false)) then
ShowMessage('File copy process cancelled')
end;
CopyFiles('Kopyalamak istediğin klasörün yolu ve adı','Kopyalamak istediğin dizin ve ad yani hedef');
***YADA***
Hedef dizin, c:\deneme\ olsun . Proğramı otomatik olarak bulur ve hedef dizine koyalar.
CopyFile(pchar(ExtractFileName(Application.ExeName)),pchar('C:\deneme\' + ExtractFileName(Application.ExeName)), True);
***YADA***
CopyFile('C:\\Autoexec.bat', 'A:\\Backup\\Autoexec.bat', False);
CopyFile(PChar(Edit1.Text), PChar(Edit2.Text), False);
***YADA***
uses ShellAPI;
function CopyAllFiles(sFrom, sTo: string; Protect: boolean): boolean;
{ Copies files or directory to another directory. }
var F: TShFileOpStruct; ResultVal: integer; tmp1, tmp2: string;
begin
FillChar(F, SizeOf(F), #0);
Screen.Cursor := crHourGlass;
try
F.Wnd := 0;
F.wFunc := FO_COPY;
{ Add an extra null char }
tmp1 := sFrom + #0;
tmp2 := sTo + #0;
F.pFrom := PChar(tmp1);
F.pTo := PChar(tmp2);
if Protect then
F.fFlags := FOF_RENAMEONCOLLISION or FOF_SIMPLEPROGRESS
else
F.fFlags := FOF_SIMPLEPROGRESS;
F.fAnyOperationsAborted := False;
F.hNameMappings := nil;
Resultval := ShFileOperation(F);
Result := (ResultVal = 0);
finally
Screen.Cursor := crDefault;
end;end;
ConfirmChange Kullanımı
Procedure TForm1.FileChange(Sender: TObject);
private
procedure ConfirmChange(const ACaption, FromFile, ToFile: string);
end;
procedure TForm1.ConfirmChange(const ACaption, FromFile, ToFile: string);
begin
if MessageDlg(Format('%s %s to %s?', [ACaption, FromFile, ToFile]),
mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
if ACaption = 'Move' then
MoveFile(FromFile, ToFile)
else if ACaption = 'Rename' then
RenameFile(FromFile, ToFile);
FileListbox1.Update;
end;end;
procedure TForm1.FileChange(Sender: TObject);
begin
with ChangeDlg do
begin
if Sender = Move1 then Caption := 'Move'
else if Sender = Rename1 then Caption := 'Rename'
else Exit;
CurrentDir.Caption := DirectoryListbox1.Directory;
FromFileName.Text := FileListbox1.FileName;
ToFileName.Text := '';
if (ShowModal <> mrCancel) and (ToFileName.Text <> '') then
ConfirmChange(Caption, FromFileName.Text, ToFileName.Text);
end;end;
private
procedure ConfirmChange(const ACaption, FromFile, ToFile: string);
end;
procedure TForm1.ConfirmChange(const ACaption, FromFile, ToFile: string);
begin
if MessageDlg(Format('%s %s to %s?', [ACaption, FromFile, ToFile]),
mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
if ACaption = 'Move' then
MoveFile(FromFile, ToFile)
else if ACaption = 'Rename' then
RenameFile(FromFile, ToFile);
FileListbox1.Update;
end;end;
procedure TForm1.FileChange(Sender: TObject);
begin
with ChangeDlg do
begin
if Sender = Move1 then Caption := 'Move'
else if Sender = Rename1 then Caption := 'Rename'
else Exit;
CurrentDir.Caption := DirectoryListbox1.Directory;
FromFileName.Text := FileListbox1.FileName;
ToFileName.Text := '';
if (ShowModal <> mrCancel) and (ToFileName.Text <> '') then
ConfirmChange(Caption, FromFileName.Text, ToFileName.Text);
end;end;
Componentlere anlamlı adlar vermek
Bildiginiz gibi delphi'ye new application komutu verildiginde default olarak project1 isminde bir proje ve Form1 isminde ana formu yaratiyor. Yapacagimiz programin ozelligine gore form'larin uzerine belki yuzlerce component yerlestiriyoruz. Onlara da delphi varsayilan isimler veriyor.Peki formlarda ve component'lerde delphi'nin verdigi default isimleri kullanmali miyiz. Asagidaki ornege bakalim.
***************************************
Button1.Caption = 'Giris';
if i = 5 then
Button5.Caption = '12'
else Button7.Caption = '0';
Label3.Caption = 'Sil'
Shape1.Enabled = False
Form7.Tag = 12
**************************************
Programcilikta en cok dikkat edilmesi ve gerek zaman gerekse harcanan efor acisindan en aza indirilmesi gereken konularin basinda belki programin bakimi yer alir. Elbetteki bakim masraflarini en aza indirmenin yollarindan birisi de programin olabildigince anlasilir yazilmis olmasidir. Yukardaki ornekteki programin bir baskasi tarafindan nasil anlasildigi ile asagidaki kodu kiyaslayin.
btnGiris.Caption = 'Giris';
if ToplamGiris = 5 then
btnKayit.Caption = '12'
else btnSilinen.Caption = '0';
lblSil.Caption = 'Sil'
shpReklam.Enabled = False
FmSiparisler.Tag = 12
Yukardaki niteliklere sahip bir isimlendirme hem sizin, hem de baskalarinin programinizi daha kolay anlamasini saglayacak, modifikasyon sirasinda ortaya cikabilecek hatalari azaltacaktir.
Ben kisisel olarak isimlendirme konusunda kendime gore bir yontem gelistirdim. Formlara "Fm" ile baslayan, butonlara "btn" ile baslayan ve diger componentlere de tipleri ile uyumlu isimler veriyorum. Label'larin caption'i
eger calisma aninda degismiyorsa isimlendirmeyi tercih etmiyorum.
Siz de kendinize gore bir isimlendirme yontemi bulun ve tum yazdiginiz programlarda, component'larda bu isimlendirmeye uymaya calisin. Unutmayin yapilacak is programin bir sekilde yazilip bitmesiyle kesinlikle bitmez, kalitesiz yazilmis bir program her zaman sizin icin problem olmaya devam edecektir.
Alıntı,yazarı bilinmiyor
***************************************
Button1.Caption = 'Giris';
if i = 5 then
Button5.Caption = '12'
else Button7.Caption = '0';
Label3.Caption = 'Sil'
Shape1.Enabled = False
Form7.Tag = 12
**************************************
Programcilikta en cok dikkat edilmesi ve gerek zaman gerekse harcanan efor acisindan en aza indirilmesi gereken konularin basinda belki programin bakimi yer alir. Elbetteki bakim masraflarini en aza indirmenin yollarindan birisi de programin olabildigince anlasilir yazilmis olmasidir. Yukardaki ornekteki programin bir baskasi tarafindan nasil anlasildigi ile asagidaki kodu kiyaslayin.
btnGiris.Caption = 'Giris';
if ToplamGiris = 5 then
btnKayit.Caption = '12'
else btnSilinen.Caption = '0';
lblSil.Caption = 'Sil'
shpReklam.Enabled = False
FmSiparisler.Tag = 12
Yukardaki niteliklere sahip bir isimlendirme hem sizin, hem de baskalarinin programinizi daha kolay anlamasini saglayacak, modifikasyon sirasinda ortaya cikabilecek hatalari azaltacaktir.
Ben kisisel olarak isimlendirme konusunda kendime gore bir yontem gelistirdim. Formlara "Fm" ile baslayan, butonlara "btn" ile baslayan ve diger componentlere de tipleri ile uyumlu isimler veriyorum. Label'larin caption'i
eger calisma aninda degismiyorsa isimlendirmeyi tercih etmiyorum.
Siz de kendinize gore bir isimlendirme yontemi bulun ve tum yazdiginiz programlarda, component'larda bu isimlendirmeye uymaya calisin. Unutmayin yapilacak is programin bir sekilde yazilip bitmesiyle kesinlikle bitmez, kalitesiz yazilmis bir program her zaman sizin icin problem olmaya devam edecektir.
Alıntı,yazarı bilinmiyor
Comboboxa item eklemek
procedure TFormMain.BitBtn1Click(Sender: TObject);
var
Str : String;
begin
Str :=Edit1.Text;
if Str='' then exit else
if ComboBox1.Items.IndexOf(Str) = -1 then
begin
ComboBox1.Items.Add(Str);
ComboBox1.Items.SaveToFile('Deneme.Txt');
end;
end;
var
Str : String;
begin
Str :=Edit1.Text;
if Str='' then exit else
if ComboBox1.Items.IndexOf(Str) = -1 then
begin
ComboBox1.Items.Add(Str);
ComboBox1.Items.SaveToFile('Deneme.Txt');
end;
end;
CheckBox örneği
procedure TForm1.CheckBox100Click(Sender: TObject);
begin
if CheckBox100.checked=false then begin
Form1.ClientWidth:=540;
Form1.ClientHeight:=330;
Panel1.visible:=true;
senderButton.Visible:=true;
end else
if CheckBox100.checked=true then begin
Form1.ClientWidth:=540;
Form1.ClientHeight:=480; //467
Panel1.visible:=false;
senderButton.Visible:=false;
end;end;
begin
if CheckBox100.checked=false then begin
Form1.ClientWidth:=540;
Form1.ClientHeight:=330;
Panel1.visible:=true;
senderButton.Visible:=true;
end else
if CheckBox100.checked=true then begin
Form1.ClientWidth:=540;
Form1.ClientHeight:=480; //467
Panel1.visible:=false;
senderButton.Visible:=false;
end;end;
Case Of
Case ......Of
Case RadioGroup1.ItemIndex Of
0:begin //ad'a göre
table1.locate('ADI',edit1.Text,[LoCaseInsensetive,LoPartialKey]);
end;
1:begin //Soyad'a göre
table1.locate('SOYADI',edit1.Text,[LoCaseInsensetive,LoPartialKey]);
end;
2:begin //sehir'e göre
table1.locate('SEHIR',edit1.Text,[LoCaseInsensetive,LoPartialKey]);
end;
Case RadioGroup1.ItemIndex Of
0:begin //ad'a göre
table1.locate('ADI',edit1.Text,[LoCaseInsensetive,LoPartialKey]);
end;
1:begin //Soyad'a göre
table1.locate('SOYADI',edit1.Text,[LoCaseInsensetive,LoPartialKey]);
end;
2:begin //sehir'e göre
table1.locate('SEHIR',edit1.Text,[LoCaseInsensetive,LoPartialKey]);
end;
Animated kursör kullanmak
const
crMyCursor = 1;
procedure TForm1.FormCreate(Sender: TObject);
begin
Screen.Cursors[crMyCursor] := LoadCursorFromFile('c:\mystuff\mycursor.ani');
Cursor := crMyCursor;
end;
crMyCursor = 1;
procedure TForm1.FormCreate(Sender: TObject);
begin
Screen.Cursors[crMyCursor] := LoadCursorFromFile('c:\mystuff\mycursor.ani');
Cursor := crMyCursor;
end;
Parlayan buton yapma
Procedure ....(Sender:TObjcet);
var c:TColor;
begin
c.label1.color;
label1.color:=label1.font.color;
label1.font.color:=c;
end;
var c:TColor;
begin
c.label1.color;
label1.color:=label1.font.color;
label1.font.color:=c;
end;
Buton üzerine çok satırlı yazı yazma
procedure TForm1.Button1Click(Sender: TObject);
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';
end;
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';
end;
Browse folder uygulaması
uses ShellAPI, ShlObj;
function SHBrowseForFolder (var BrowseInfo: TBrowseInfo): PItemIDList; stdcall;
function BrowseDialog (const Title: string; const Flag: integer): string;
var
lpItemID : PItemIDList;
BrowseInfo : TBrowseInfo;
DisplayName : array[0..MAX_PATH] of char;
TempPath : array[0..MAX_PATH] of char;
begin
Result:='';
FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
with BrowseInfo do begin
hwndOwner := Application.Handle;
pszDisplayName := @DisplayName;
lpszTitle := PChar(Title);
ulFlags := Flag;
end;
lpItemID := SHBrowseForFolder(BrowseInfo);
if lpItemId <> nil then begin
SHGetPathFromIDList(lpItemID, TempPath);
Result := TempPath;
GlobalFreePtr(lpItemID);
end;end;
procedure TfrMain.btnBrowseClick(Sender: TObject);
var sTitle, sFolder: string;
iFlag : integer;
begin
sTitle:='Choose a ' + rgBrowseFor.Items[rgBrowseFor.ItemIndex];
case rgBrowseFor.ItemIndex of
0: iFlag := BIF_RETURNONLYFSDIRS;
1: iFlag := BIF_BROWSEINCLUDEFILES;
2: iFlag := BIF_BROWSEFORCOMPUTER;
3: iFlag := BIF_BROWSEFORPRINTER;
end;
sFolder := BrowseDialog(sTitle, iFlag);
if sFolder <> '' then
edSelected.text := sFolder
else
edSelected.text := 'Nothing selected';
end;
Resim1.jpg
***YADA***
uses ShellAPI, ShlObj;
procedure TForm1.Button1Click(Sender: TObject);
var
TitleName : string;
lpItemID : PItemIDList;
BrowseInfo : TBrowseInfo;
DisplayName : array[0..MAX_PATH] of char;
TempPath : array[0..MAX_PATH] of char;
begin
FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
BrowseInfo.hwndOwner := Form1.Handle;
BrowseInfo.pszDisplayName := @DisplayName;
TitleName := 'Please specify a directory';
BrowseInfo.lpszTitle := PChar(TitleName);
BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
lpItemID := SHBrowseForFolder(BrowseInfo);
if lpItemId <> nil then begin
SHGetPathFromIDList(lpItemID, TempPath);
ShowMessage(TempPath);
GlobalFreePtr(lpItemID);
end; end;
function SHBrowseForFolder (var BrowseInfo: TBrowseInfo): PItemIDList; stdcall;
function BrowseDialog (const Title: string; const Flag: integer): string;
var
lpItemID : PItemIDList;
BrowseInfo : TBrowseInfo;
DisplayName : array[0..MAX_PATH] of char;
TempPath : array[0..MAX_PATH] of char;
begin
Result:='';
FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
with BrowseInfo do begin
hwndOwner := Application.Handle;
pszDisplayName := @DisplayName;
lpszTitle := PChar(Title);
ulFlags := Flag;
end;
lpItemID := SHBrowseForFolder(BrowseInfo);
if lpItemId <> nil then begin
SHGetPathFromIDList(lpItemID, TempPath);
Result := TempPath;
GlobalFreePtr(lpItemID);
end;end;
procedure TfrMain.btnBrowseClick(Sender: TObject);
var sTitle, sFolder: string;
iFlag : integer;
begin
sTitle:='Choose a ' + rgBrowseFor.Items[rgBrowseFor.ItemIndex];
case rgBrowseFor.ItemIndex of
0: iFlag := BIF_RETURNONLYFSDIRS;
1: iFlag := BIF_BROWSEINCLUDEFILES;
2: iFlag := BIF_BROWSEFORCOMPUTER;
3: iFlag := BIF_BROWSEFORPRINTER;
end;
sFolder := BrowseDialog(sTitle, iFlag);
if sFolder <> '' then
edSelected.text := sFolder
else
edSelected.text := 'Nothing selected';
end;
Resim1.jpg
***YADA***
uses ShellAPI, ShlObj;
procedure TForm1.Button1Click(Sender: TObject);
var
TitleName : string;
lpItemID : PItemIDList;
BrowseInfo : TBrowseInfo;
DisplayName : array[0..MAX_PATH] of char;
TempPath : array[0..MAX_PATH] of char;
begin
FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
BrowseInfo.hwndOwner := Form1.Handle;
BrowseInfo.pszDisplayName := @DisplayName;
TitleName := 'Please specify a directory';
BrowseInfo.lpszTitle := PChar(TitleName);
BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
lpItemID := SHBrowseForFolder(BrowseInfo);
if lpItemId <> nil then begin
SHGetPathFromIDList(lpItemID, TempPath);
ShowMessage(TempPath);
GlobalFreePtr(lpItemID);
end; end;
Belgeler mesüsü uygulaması
SHAddToRecentDocs(SHARD_PATH, nil);
-------------------------------------------------
BELGELER KLASORUNU TEMIZLEME
Uses ShlOBJ;
procedure TForm1.Button1Click(Sender: TObject);
begin
SHAddToRecentDocs(SHARD_PATH, nil);
showmessage('Temizlendi');
end;
--- YADA ---
Belgeler menüsüne bir dosya ekleme
uses kısmına ShlOBJ unitini ekleyin;
procedure TForm1.Button1Click(Sender: TObject);
var
s : string;
begin
s := 'C:\DownLoad\deneme.html';
SHAddToRecentDocs(SHARD_PATH, pChar(s));
end;
Belgeler menüsünü temizleme
uses kısmına ShlOBJ unitini ekleyin;
SHAddToRecentDocs(SHARD_PATH, nil);
-------------------------------------------------
BELGELER KLASORUNU TEMIZLEME
Uses ShlOBJ;
procedure TForm1.Button1Click(Sender: TObject);
begin
SHAddToRecentDocs(SHARD_PATH, nil);
showmessage('Temizlendi');
end;
--- YADA ---
Belgeler menüsüne bir dosya ekleme
uses kısmına ShlOBJ unitini ekleyin;
procedure TForm1.Button1Click(Sender: TObject);
var
s : string;
begin
s := 'C:\DownLoad\deneme.html';
SHAddToRecentDocs(SHARD_PATH, pChar(s));
end;
Belgeler menüsünü temizleme
uses kısmına ShlOBJ unitini ekleyin;
SHAddToRecentDocs(SHARD_PATH, nil);
Başlat menüsü proğramlarını tesbit etme
Code:
{Forma bir ListBox, bir Buton, birde DDEClientConv nesnesi ekleyip, Service ve Topic özelli?ini "Progman" olarak giriniz.}
var
B:Pchar;
procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Items.clear;
B := DDEClientConv1.RequestData('Gr oups');
ListBox1.Items.SetText(B);
StrDispose(B);
end;
{Forma bir ListBox, bir Buton, birde DDEClientConv nesnesi ekleyip, Service ve Topic özelli?ini "Progman" olarak giriniz.}
var
B:Pchar;
procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Items.clear;
B := DDEClientConv1.RequestData('Gr oups');
ListBox1.Items.SetText(B);
StrDispose(B);
end;
Giriş
Yeni açmış olduğum bloğumda bu güne kadar farklı şekilde kullandığım on kategoride sınıflandırdığım kodlar bulunmaktadır.
Mkstyle
Kaydol:
Kayıtlar (Atom)