一个得到目录对话框的函数【Delphi】

一个得到目录对话框的函数：

要uses shlobj,ActiveX这两个单元

function TForm1.SelectDirectory(handle: hwnd; 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(Handle, nil, POleStr(Root), Eaten, RootItemIDList, Flags);

 

end;

 

with BrowseInfo do

 

begin

 

hwndOwner := Handle;

 

pidlRoot := RootItemIDList;

 

pszDisplayName := Buffer;

 

lpszTitle := PChar(Caption);

 

ulFlags := BIF_RETURNONLYFSDIRS+64;

 

lpfn := nil;

 

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;

 

if Directory[Length(Directory)] <> '/' then

 

Directory := Directory + '/';

 

end;

 

finally

 

ShellMalloc.Free(Buffer);

 

end;

 

end;

 

end;