[Lie]

Как с посощью OpenDialog или какого-нибудь другого компонента (только не DirectoryListBox1) выбирать и открывать только директории.
Чтобы FileName был допустим "C:\Games"

[4kusNick]

В uses добавь ActiveX и ShlObj, ComObj (или один из этих модулей, я просто не помню точно...)

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91

// функция показа диалога для выбора папки function AdvBrowseDirectory(sCaption: String; wsRoot: WideString; var sDirectory: String; bEditBox: Boolean = False; bShowFiles: Boolean = False; bAllowCreateDirs: Boolean = True; bRootIsMyComp: Boolean = False): Boolean;     // callback функция, которая вызывается при инициализации диалога   // или когда создается новая папка     function SelectDirCB(Wnd: HWND; uMsg: UINT; lParam, lpData: lParam): Integer; stdcall;     //var         //PathName: array[0..MAX_PATH] of Char;   begin     case uMsg of       BFFM_INITIALIZED: SendMessage(Wnd, BFFM_SETSELECTION, Ord(True), Integer(lpData));       // включите этот код, если хотите реагировать на выбор новой папки       {BFFM_SELCHANGED:       begin         SHGetPathFromIDList(PItemIDList(lParam), @PathName);         // папка "PathName" была выбрана       end;}      end;      Result := 0;    end; var   WindowList: Pointer;   BrowseInfo: TBrowseInfo;   Buffer: PChar;   RootItemIDList, ItemIDList: PItemIDList;   ShellMalloc: IMalloc;   IDesktopFolder: IShellFolder;   Eaten, Flags: LongWord;   const   BIF_USENEWUI = $0040;   BIF_NOCREATEDIRS = $0200;   begin   Result := False;   if not DirectoryExists(sDirectory) then sDirectory := '';   FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);   if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then   begin     Buffer := ShellMalloc.Alloc(MAX_PATH);     try       RootItemIDList := nil;       if wsRoot <> '' then       begin         SHGetDesktopFolder(IDesktopFolder);         IDesktopFolder.ParseDisplayName(Application.Handle, nil,         POleStr(wsRoot), Eaten, RootItemIDList, Flags);             end             else             begin                   if bRootIsMyComp then                     SHGetSpecialFolderLocation(0, CSIDL_DRIVES, RootItemIDList);               end;       OleInitialize(nil);       with BrowseInfo do       begin         hwndOwner := Application.Handle;                 pidlRoot := RootItemIDList;         pszDisplayName := Buffer;                 lpszTitle := PChar(sCaption);         // определяет то, как диалог будет появляться:         ulFlags :=           BIF_RETURNONLYFSDIRS or           BIF_USENEWUI or                     BIF_EDITBOX * Ord(bEditBox) or                     BIF_BROWSEINCLUDEFILES * Ord(bShowFiles) or                     BIF_NOCREATEDIRS * Ord(not bAllowCreateDirs);         lpfn    := @SelectDirCB;         if sDirectory <> '' then lParam := Integer(PChar(sDirectory));       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);         sDirectory := Buffer;       end;     finally       ShellMalloc.Free(Buffer);     end;   end; end;

Пример использования:

Код:

1 2 3 4 5 6 7 8 9 10

//... var   sSelectedDir: String; //... begin //...   AdvBrowseDirectory('Выбор папки с файлами','',sSelectedDir);   // теперь в sSelectedDir у нас выбранная папка //... end;

[<<D>>]

Может быть, я ошибаюсь, но, по-моему, так легче:

Uses ...FileCtrl;

...

var
S: string;
begin
S := '';
if SelectDirectory('Select Directory', '', S) then
path:=s;
end;