Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Делфи _ Обзор папок!

Автор: Артемий2 6.09.2006 18:02

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


Эскизы прикрепленных изображений
Прикрепленное изображение

Автор: volvo 6.09.2006 18:20

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;

Автор: Артемий2 9.09.2006 21:22

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

Код
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+'\';

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