Как использовать Shell API SHBrowseForFolder?

Материал из DRKB


Статья из рассылки "Мастера 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;


Source: Дельфи. Вокруг да около.
ID: 03187



Вариант от Анатолия (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;


Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 03188