?? browsefolder.pas
字號:
unit BrowseFolder;
interface
uses Windows, Forms, Classes, ShlObj;
type
TBrowseForFolderDialog = class(TComponent)
private
bi: TBROWSEINFO;
str: Array[0..MAX_PATH] of Char;
pIDListItem: PItemIDList;
pStr: PChar;
procedure SetTitle(Title: String);
function GetTitle: String;
function GetPath: String;
public
property Title: string read GetTitle write SetTitle;
function Execute: Boolean;
property Path: string read GetPath;
end;
Function GetSelectedDir(Title:string; var Path:String):Boolean;
procedure register;
implementation
procedure register;
begin
RegisterComponents('Samples',[TBrowseForFolderDialog]);
end;
procedure TBrowseForFolderDialog.SetTitle(Title: String);
begin
bi.lpszTitle := PChar(Title);
end;
function TBrowseForFolderDialog.GetTitle: String;
begin
Result := bi.lpszTitle;
end;
function TBrowseForFolderDialog.GetPath: String;
begin
Result := pStr;
end;
function TBrowseForFolderDialog.Execute: Boolean;
begin
bi.hwndOwner := GetActiveWindow;
bi.pidlRoot := nil;
bi.pszDisplayName := @str;
bi.ulFlags := BIF_RETURNONLYFSDIRS;
bi.lpfn := nil;
pIDListItem := SHBrowseForFolder(bi);
if pIDListItem <> nil then
begin
pStr := @Str;
SHGetPathFromIDList(pIDListItem, pStr);
// CoTaskMemFree(pIDListItem);
Result := True;
end
else
Result := False;
end;
Function GetSelectedDir(Title:string; var Path:String):Boolean;
var
bi: TBROWSEINFO;
str: Array[0..MAX_PATH] of Char;
pIDListItem: PItemIDList;
pStr: PChar;
begin
bi.hwndOwner := GetActiveWindow;
bi.pidlRoot := nil;
bi.pszDisplayName := @str;
bi.ulFlags := BIF_RETURNONLYFSDIRS;
bi.lpfn := nil;
if Title='' then bi.lpszTitle:='請選擇一個目錄:' else bi.lpszTitle:=PChar(Title);
pIDListItem := SHBrowseForFolder(bi);
if pIDListItem <> nil then
begin
pStr := @Str;
SHGetPathFromIDList(pIDListItem, pStr);
Result := True;
end
else
Result := False;
Path:=pStr;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -