выбор папки с кнопкой "создать"

← →
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. никакой кнопки Создать нету.

4.72.3612.1700

я так думаю, нужна не ниже 5

выбор папки с кнопкой "создать" Найти похожие ветки