Обзор папок!, Как сделать? Опции

[Артемий]

Как создать обзор папок на примере картинки в комплекте?

Сообщение отредактировано: volvo - 7.12.2006 15:34

[volvo]

Uses
  ..., ShlObj, ComObj, ActiveX;

...
function GetDirectory: string;
var
  TitleName : string;
  lpItemID : PItemIDList;
  BrowseInfo : TBrowseInfo;
  DisplayName : array[0..MAX_PATH] of char;
  TempPath : array[0..MAX_PATH] of char;
begin
  result := '';
  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);
    result := TempPath;
    GlobalFreePtr(lpItemID);
  end;
end;


procedure TForm1.Button3Click(Sender: TObject);
begin
  label1.Caption := GetDirectory;
end;