Диалог выбора папки ShBrowseForFolder с определенной директории

← →
Conflict © (2011-02-03 16:12) [0]

Добры день. Подскажите пожалуйста, как сделать, что бы при открытии диалога, он переходил к определенной папке (например, брал из Edit), а не с самого корня всех устройств (дисков, сетевого окружения и п.р.)? Сейчас это получается, но при этом корневой папкой верхнего уровня становится именно нужная папка, а все остальные директории выше уровнем просто не доступны. А хочется как в стандартном окне выбора в Windows. Для наглядности:
1. Как должно быть: http://s2.ipicture.ru/uploads/20110202/SqA6JCyK.jpg
2. Как получается: http://s2.ipicture.ru/uploads/20110202/otXbACr1.jpg
Вот код:
function AdvSelectDirectory(const Caption: string; const Root: WideString; var Directory: string; EditBox: Boolean = False; ShowFiles: Boolean = False; AllowCreateDirs: Boolean = True): Boolean; 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); 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(Directory) then Directory := ""; 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; OleInitialize(nil); with BrowseInfo do begin hwndOwner := Application.Handle; pidlRoot := RootItemIDList; pszDisplayName := Buffer; lpszTitle := PChar(Caption); ulFlags := BIF_RETURNONLYFSDIRS or BIF_USENEWUI or BIF_EDITBOX * Ord(EditBox) or BIF_BROWSEINCLUDEFILES * Ord(ShowFiles) or BIF_NOCREATEDIRS * Ord(not AllowCreateDirs); lpfn := @SelectDirCB; if Directory <> "" then lParam := Integer(PChar(Directory)); 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; //Вызов диалога procedure TForm1.Button4Click(Sender: TObject); var s:string; begin if (AdvSelectDirectory("TestDialog",dir1,s,true, False, True)) then begin if s<>"" then memo1.Text:=s else showmessage(s); dir1:=s; end end;

← →
Anatoly Podgoretsky © (2011-02-03 16:27) [1]

Ты видимо устанавливаешь pidlRoot

Pointer to an item identifier list (an ITEMIDLIST structure) specifying the location of the "root" folder to browse from. Only the specified folder and its subfolders appear in the dialog box. This member can be NULL, and in that case, the name space root (the desktop folder) is used.

← →
Conflict © (2011-02-03 16:34) [2]

Ну да. Так и есть. Просто не могу понять, как по другому мне перейти к нужной папке. Ведь должно быть решение, а ничего не могу придумать.
Вот обратился за помощью.

← →
KilkennyCat © (2011-02-03 17:28) [3]

http://www.rsdn.ru/forum/winapi/1711676.flat.aspx

← →
KilkennyCat © (2011-02-03 17:30) [4]

lParam - установить текущую папку

здесь более понятно:
http://www.rsdn.ru/article/qna/ui/getfldr.xml

KilkennyCat, спасибо! То, что надо!

Диалог выбора папки ShBrowseForFolder с определенной директории Найти похожие ветки