Форум: "Основная";
Текущий архив: 2004.11.21;
Скачать: [xml.tar.bz2];
Вниз
выбор папки с кнопкой "создать" Найти похожие ветки
← →
heady (2004-11-04 19:27) [0]Hi, All!
нашел в факе (http://www.delphimaster.ru/cgi-bin/faq.pl?look=1&id=988622138&n=15)- диалог выбора каталога, как ни искал на yandex"e - все время наткаюсь имеенно на эту процедуру... Подскажите пожалуйста, как вызвать этот же диалог, но с кнопкой "Создать папку". Зарание благодарен
← →
KisaNetik (2004-11-05 04:02) [1]А что не понятно??? В подавляющем большинстве прог с использованием таких диалогов кнопки создать папку нет, путь встраивается в едит, где юзверь может дописать папку и она создастся...
← →
КаПиБаРа © (2004-11-05 08:25) [2]heady (04.11.04 19:27)
uses IniFiles, ShlObj, ActiveX, Registry;
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;
← →
ssk © (2004-11-05 09:25) [3]для Win 98 работать не будет. что делать?
← →
КаПиБаРа © (2004-11-05 09:42) [4]ssk © (05.11.04 9:25) [3]
для Win 98 работать не будет.
Не будет или не работает?
функция ShBrowseForFolder, которая обображает диалог выбора папки находится в библиотеке shell32.dll
У меня в w2k версия библиотеки 5.0.3900.6975
← →
ssk © (2004-11-05 09:55) [5]>КаПиБаРа © (05.11.04 09:42) [4]
Не будет или не работает?
этот код в [2] работает как стандартный SelectDirectory. никакой кнопки Создать нету.
← →
КаПиБаРа © (2004-11-05 10:01) [6]ssk © (05.11.04 9:55) [5]
Версия Shell32 какая?
← →
ssk © (2004-11-05 10:10) [7]4.72.3612.1700
← →
ssk © (2004-11-05 10:11) [8]я так думаю, нужна не ниже 5
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2004.11.21;
Скачать: [xml.tar.bz2];
Память: 0.47 MB
Время: 0.041 c
