uses
... ShlObj, Forms, ActiveX;
function SelectDir(Owner: THandle; const Caption, InitialDir: string; const Root:
WideString; ShowStatus: Boolean; out Directory: string): Boolean;
function BrowseCallbackProc(hwnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer; stdcall;
var
Path: array[0..MAX_PATH] of Char;
begin
case uMsg of
BFFM_INITIALIZED:
begin
SendMessage(hwnd, BFFM_SETSELECTION, 1, lpData);
SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, lpData);
end;
BFFM_SELCHANGED:
begin
if SHGetPathFromIDList(Pointer(lParam), Path) then
begin
SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, Integer(@Path));
end;
end;
end;
Result := 0;
end;
function SelectDir(Owner: THandle; const Caption, InitialDir: string; const Root:
WideString; ShowStatus: Boolean; out Directory: string): Boolean;
var
BrowseInfo: TBrowseInfo;
Buffer: PChar;
RootItemIDList,
ItemIDList: PItemIDList;
ShellMalloc: IMalloc;
IDesktopFolder: IShellFolder;
Eaten, Flags: LongWord;
Windows: Pointer;
Path: string;
begin
Result := False;
Directory := '';
Path := InitialDir;
if (Length(Path) > 0) and (Path[Length(Path)] = '\') then
begin
Delete(Path, Length(Path), 1);
end;
FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
begin
Buffer := ShellMalloc.Alloc(MAX_PATH);
try
SHGetDesktopFolder(IDesktopFolder);
IDesktopFolder.ParseDisplayName(Owner, nil, PWideChar(Root), Eaten, RootItemIDList, Flags);
with BrowseInfo do
begin
hwndOwner := Owner;
pidlRoot := RootItemIDList;
pszDisplayName := Buffer;
lpszTitle := PChar(Caption);
ulFlags := BIF_RETURNONLYFSDIRS;
if ShowStatus then
begin
ulFlags := ulFlags or BIF_STATUSTEXT;
end;
lParam := Integer(PChar(Path));
lpfn := BrowseCallbackProc;
iImage := 0;
end;
Windows := DisableTaskWindows(Owner);
try
ItemIDList := ShBrowseForFolder(BrowseInfo);
finally
EnableTaskWindows(Windows);
end;
Result := ItemIDList <> nil;
if Result then
begin
ShGetPathFromIDList(ItemIDList, Buffer);
ShellMalloc.Free(ItemIDList);
Directory := Buffer;
end;
finally
ShellMalloc.Free(Buffer);
end;
end;
end;
