实现windows标准的选择文件夹功能
Delphi里有個函數SelectDiretory,重載了兩種形式: function SelectDirectory(
const Caption: string; const Root: WideString; out Directory: string): Boolean; overload;
function SelectDirectory(
var Directory: string; Options: TSelectDirOpts; HelpCtx: Longint): Boolean; overload;
按第一種方式可以調用Win32的標準選擇目錄對話框,第二種方式彈出的則是Delphi自定義風格的對話框。我們編程常用的是第一種,但我在使用中發現,用該函數不能初始化對話框的起始目錄,如右圖:希望對話框彈出時就定位到某個目錄,是辦不到的。
我從來是單干,自然很久都沒有找到答案,直到有一天終于注冊上了“大富翁論壇”(其實我很久以前就知道大富翁論壇了,只是一直注冊不了),我提出的問題就是“如何指定SelectDirectory的起始目錄”。問題很快得到了解答,答案是由cAkk提供的,如下:
給那個窗口發消息可以設置路徑:
SendMessage(
Hwnd,
BFFM_SETSELECTION,
Ord(TRUE),
Longint(PChar(Path))
);
關鍵是如何得到該窗口的句柄?
Borland在寫SelectDirectory函數時省略了BrowseInfo的lpfn屬性,這個屬性指向一個CallBack函數,可以實現你的程序和該對話框窗口的通訊.該Callback函數聲明為:
int BrowseCallbackProc(
HWND hwnd,
UINT uMsg,
LPARAM lParam,
LPARAM lpData
);
其中,HWND參數就是傳遞過來的該對話框的句柄,得到這個句柄,你就可以 用我前面說的SendMessage設置路徑了。
還有一點,你應該在BrowseCallbackProc函數里判斷當接受到BFFM_INITIALIZED消息時設置路徑,也就是說:uMsg:=BFFM_INITIALIZED的時候。
具體實現如下,需要注意的幾點是:
1、不能再用SelectDirectory函數(要不就修改它的源代碼),需要直接調用API函數ShBrowseForFolder。
2、要把shlobj和AcriveX兩個單元包含進去。
unit Unit1;
interface
uses
……shlobj,ActiveX;
……
var
Form1: TForm1;
Path: string; //起始路徑
implementation
{$R *.DFM}
function BrowseCallbackProc(hwnd: HWND;uMsg: UINT;lParam: Cardinal;lpData: Cardinal): integer; stdcall;
begin
if uMsg=BFFM_INITIALIZED then
result :=SendMessage(Hwnd,BFFM_SETSELECTION,Ord(TRUE),Longint(PChar(Path)))
else
result :=1
end;
function SelDir(const Caption: string; const Root: WideString; out Directory: string): Boolean;
var
WindowList: Pointer;
BrowseInfo: TBrowseInfo;
Buffer: PChar;
RootItemIDList, ItemIDList: PItemIDList;
ShellMalloc: IMalloc;
IDesktopFolder: IShellFolder;
Eaten, Flags: LongWord;
begin
Result := False;
Directory := '';
FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
begin
Buffer := ShellMalloc.Alloc(MAX_PATH);
try
RootItemIDList := nil;
if Root <> '' then begin
SHGetDesktopFolder(IDesktopFolder);
IDesktopFolder.ParseDisplayName(Application.Handle, nil, POleStr(Root), Eaten, RootItemIDList, Flags);
end;
with BrowseInfo do begin
hwndOwner := Application.Handle;
pidlRoot := RootItemIDList;
pszDisplayName := Buffer;
lpszTitle := PChar(Caption);
ulFlags := BIF_RETURNONLYFSDIRS;
lpfn :=@BrowseCallbackProc;
lParam :=BFFM_INITIALIZED;
end;
WindowList := DisableTaskWindows(0);
try
ItemIDList := ShBrowseForFolder(BrowseInfo);
finally
EnableTaskWindows(WindowList);
end;
Result := ItemIDList <> nil;
if Result then begin
ShGetPathFromIDList(ItemIDList, Buffer);
ShellMalloc.Free(ItemIDList);
Directory := Buffer;
end;
finally
ShellMalloc.Free(Buffer);
end;
end;
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
Path1: string;
begin
Path :=Edit1.Text;
SelDir('SelectDirectory Sample','',Path1);
Edit1.Text :=Path1
end;
end.
轉載于:https://www.cnblogs.com/xiaoyayaday/archive/2008/10/01/1302896.html
總結
以上是生活随笔為你收集整理的实现windows标准的选择文件夹功能的全部內容,希望文章能夠幫你解決所遇到的問題。
- 上一篇: 使用 ExtJs Extender Co
- 下一篇: C异常处理实现: setjmp和long