Как использовать Shell API SHBrowseForFolder?
Как использовать Shell API SHBrowseForFolder?
Статья из рассылки "Мастера DELPHI. Новости мира компонент, FAQ, статьи...".
Как использовать функцию Shell API SHBrowseForFolder чтобы позволить пользователю выбрать каталог?
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;
Источник: Дельфи. Вокруг да около.
Вариант от Анатолия (SAVwa@eleks.lviv.ua)
threadvar myDir: string;
function BrowseCallbackProc(hwnd: HWND; uMsg: UINT; lParam: LPARAM; lpData:
LPARAM): integer; stdcall;
begin
Result := 0;
if uMsg = BFFM_INITIALIZED then begin
SendMessage(hwnd, BFFM_SETSELECTION, 1, LongInt(PChar(myDir)))
end;
end;
function SelectDirectory(const Caption: string; const Root: WideString;
var Directory: string): Boolean;
var
WindowList: Pointer;
BrowseInf!
o: TBrowseInfo;
Buffer: PChar;
RootItemIDList, ItemIDList: PItemIDList;
ShellMalloc: IMalloc;
IDesktopFolder: IShellFolder;
Eaten, Flags: LongWord;
begin
myDir := Directory;
Result := False;
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;
lpfn := @BrowseCallbackProc;
lParam := Integer(PChar(Directory));
lpszTitle := PChar(Caption);
ulFlags := BIF_RETURNONLYFSDIRS or $0040 or BIF_EDITBOX or
BIF_STATUSTEXT;
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;
Взято с Vingrad.ru