Форум: "Основная";
Текущий архив: 2004.01.20;
Скачать: [xml.tar.bz2];

Вниз

Как задать путь по умолчанию для диалога выбора папки?   Найти похожие ветки 

← →
Tahion2   (2004-01-01 17:18) [0]

Использую такой код для того, чтоб показать диалог выбора папок:

procedure TMainForm.SelectDirClick(Sender: TObject);
var
TitleName: string;
lpItemID: PItemIDList;
BrowseInfo: TBrowseInfo;
DisplayName: array[0..MAX_PATH] of char;
TempPath: array[0..MAX_PATH] of char;
begin
FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
BrowseInfo.hwndOwner:=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);
edt_Path.Text:=TempPath; //Записываем результат выбора
GlobalFreePtr(lpItemID);
end;
end;

При этом в диалоге выбора папки сразу после его открытия выбран "Мой компьютер". Подскажите, как задать свою попку по умолчанию для этого диалога?
Подскажите, как можно

---

← →
Tahion2   (2004-01-01 21:18) [1]

ниужели никто не знает?

---

← →
jack128   (2004-01-01 21:25) [2]

function SelectDirectory(const Caption: string; const Root: WideString; out Directory: string): Boolean; overload;

---

← →
Tahion2   (2004-01-02 20:23) [3]

Не, это уродливое делфийское окно для выбора папки в стиле Windows 3.11 мне совсем не нравится. Хочу стандартное а-ля Windows XP.
В Вышеприведенном коде оно и вызывается. Только как в нем задать папку по умолчанию?

---

← →
jack128   (2004-01-02 21:00) [4]

> Не, это уродливое делфийское окно для выбора папки в стиле
> Windows 3.11 мне совсем не нравится. Хочу стандартное а-ля
> Windows XP.
??? То есть??
Смотрим исходники и видим
function SelectDirectory(const Caption: string; const Root: WideString;
out Directory: string): Boolean;
var
...
begin
...
try
ItemIDList := ShBrowseForFolder(BrowseInfo);
finally
EnableTaskWindows(WindowList);
end;
...
end;
Что - то ты не то говоришь..

---

← →
Tahion2   (2004-01-03 13:56) [5]

Это я нэлпа начитался:
const
SELDIRHELP = 1000;
procedure TForm1.Button2Click(Sender: TObject);
var
Dir: string;
begin
Dir := "C:\MYDIR";
if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],SELDIRHELP) then
Label1.Caption := Dir;
end;

Если сделать так:
procedure TForm1.Button1Click(Sender: TObject);
var
Directory :string;
begin
SelectDirectory("111", "d:\Folder", Directory);
Label1.Caption := Directory;
end;
То отображается тот диалог, который нужен, вот только "d:\Folder" является верхним уровнем. Т.е. пользователь не может выбрать папку, которая находится на на пределами "d:\Folder".

А нужно задать папку по умолчанию, при этом чтоб были доступны все остальные папки.

---

← →
jack128   (2004-01-03 14:04) [6]

Видимо SHBrowseForFolder не поддерживает такое поведение, какое ты хочешь..
По крайней мере в хелпе написано так
BROWSEINFO

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.

---

← →
Tahion2   (2004-01-06 14:11) [7]

Ок. Тогда, может, кто знает компоненты-заменители стандартного диалога выбора папки?

---

← →
Романов Р.В.   (2004-01-06 14:18) [8]

const
BIF_NEWDIALOGSTYLE = $0040;
{$R *.dfm}

// CallBack процедура диалога выбора папки
function BrCbProc(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer stdcall;
const
_left = 60;
_top = 150;
var
R: TRect;
Path: array [0..MAX_PATH] of Char;
begin
Result := 0;
// Установка положения окна при инициализации
if uMsg = BFFM_INITIALIZED then
begin
GetWindowRect(Wnd, R);
SetWindowPos(Wnd, 0, _left, _top, R.Right - R.Left, R.Bottom - R.Top,
SWP_NOZORDER + SWP_NOACTIVATE);
end;
// Открытие заданного каталога
if (uMsg = BFFM_INITIALIZED) and (lpData <> 0) then
SendMessage(Wnd, BFFM_SETSELECTION, Integer(True), lpdata);
// Отключение кнопки OK при выборе папки
if uMsg = BFFM_SELCHANGED then
begin
if (lParam <> 0) then
begin
if SHGetPathFromIDList(PItemIDlist(lParam), Path) and (Path <> "") and DirectoryExists(Path) then
Windows.SendMessage(Wnd, BFFM_ENABLEOK, 0, 1)
else
Windows.SendMessage(Wnd, BFFM_ENABLEOK, 0, 0);
end
else
Windows.SendMessage(Wnd, BFFM_ENABLEOK, 0, 0);
end;

end;

// Модернизированный диалог выбора папки
// В параметре Directory задается каталог который нужно открыть
function SelectDirectory(const Caption: string; const Root: WideString;
var Directory: string): Boolean;
var
WindowList: Pointer;
BrowseInfo: TBrowseInfo;
Buffer: PChar;
RootItemIDList, ItemIDList: PItemIDList;
ShellMalloc: IMalloc;
IDesktopFolder: IShellFolder;
Eaten, Flags: LongWord;
begin
Result := False;
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;
with BrowseInfo do
begin
hwndOwner := Application.Handle;
pidlRoot := RootItemIDList;
pszDisplayName := Buffer;
lpszTitle := PChar(Caption);
ulFlags := BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE;
lpfn := BrCbProc;
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;

---

← →
[lamer]Barmaglot   (2004-01-06 14:40) [9]

У меня наверно попроще для понимания и переделывать меньше... :-)


function BrowseCallbackProc(DialogHWND: THandle;NINT: Integer; PARAM1: lParam; PARAM2: lParam): integer; stdcall;
var
s: String;
begin
if NInt = BFFM_INITIALIZED then
begin
s:="d:\";
SendMessage(DialogHWND,BFFM_SETSELECTION,1,integer(PChar(s)));
end;
result:=0;
end;

procedure SelectDirClick(Sender: TObject);
var
TitleName: string;
lpItemID: PItemIDList;
BrowseInfo: TBrowseInfo;
DisplayName: array[0..MAX_PATH] of char;
TempPath: array[0..MAX_PATH] of char;
begin
FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
BrowseInfo.hwndOwner:=Form1.handle;
BrowseInfo.lpfn:=@BrowseCallbackProc;
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);
Form1.Edit1.Text:=TempPath; //Записываем результат выбора
GlobalFreePtr(lpItemID);
end;
end;


p.s. Пока разбирался уже опередили...

---

← →
Dimka Maslov   (2004-01-06 15:12) [10]

http://endimus.com/oldcontent/files/index_en.php?page=tbrowseforfolder.htm

Устанавливаешь компонент и кидаешь на форму, а дальше всё само работает

---

← →
Tahion2   (2004-01-07 09:34) [11]

Работает. Всем спасибо :)

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2004.01.20;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.48 MB
Время: 0.012 c