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

[Артемий]

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

Сообщение отредактировано: 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;

[Артемий]

А я вот надыбал покороче

Код

var
  Root: string;      // корневой каталог
  pwRoot : PWideChar;
begin
  Root := ''; // корневой каталог - папка Рабочий стол
  GetMem(pwRoot, (Length(Root)+1) * 2);
  pwRoot := StringToWideChar(Root,pwRoot,MAX_PATH*2);
  if not SelectDirectory('Выберите папку WINDOWS/FONTS', pwRoot, Dir)
     then Dir :=''
     else Dir := Dir+'\';

Но твой способ не пробовал поэтому что удобнее, а что лучше судить не могу!

Сообщение отредактировано: Артемий2 - 9.09.2006 21:23