Форум: "Начинающим";
Текущий архив: 2011.05.08;
Скачать: [xml.tar.bz2];
Вниз
Диалог выбора папки 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 - установить текущую папку
← →
KilkennyCat © (2011-02-03 17:32) [5]здесь более понятно:
http://www.rsdn.ru/article/qna/ui/getfldr.xml
← →
Conflict © (2011-02-03 19:14) [6]KilkennyCat, спасибо! То, что надо!
Страницы: 1 вся ветка
Форум: "Начинающим";
Текущий архив: 2011.05.08;
Скачать: [xml.tar.bz2];
Память: 0.47 MB
Время: 0.004 c
