| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

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

Conflict ©   (2011-02-03 16:12:00) 

Добры день. Подскажите пожалуйста, как сделать, что бы при открытии диалога, он переходил к определенной папке (например, брал из 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;

---

Conflict   (2011-02-03 19:14:00) [1]

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

---

KilkennyCat   (2011-02-03 17:32:00) [2]

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

---

KilkennyCat   (2011-02-03 17:30:00) [3]

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

---

KilkennyCat   (2011-02-03 17:28:00) [4]

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

---

Conflict   (2011-02-03 16:34:00) [5]

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

---

Anatoly Podgoretsky   (2011-02-03 16:27:00) [6]

Ты видимо устанавливаешь 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.

---

Наверх