|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
||||
|
||||
Как открыть системный диалог "выбор папки"
Как вызвать этот диалог?
в Win7 он выглядит так: Функции типа: Код:
procedure TForm1.Button4Click(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.pszDisplayName := @DisplayName; TitleName := 'Выбор директории...'; BrowseInfo.lpszTitle := PChar(TitleName); BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS; lpItemID := SHBrowseForFolder(BrowseInfo); if lpItemId <> nil then begin SHGetPathFromIDList(lpItemID, TempPath); showmessage(String(TempPath)); GlobalFreePtr(lpItemID); end; end; Код:
procedure TForm1.Button5Click(Sender: TObject); var chosenDirectory : string; begin if SelectDirectory('Выберите каталог', 'C:\', chosenDirectory) then ShowMessage('Выбранный каталог = '+chosenDirectory); end; Код:
function BrowseCallbackProc(hwnd: HWND; uMsg: UINT; lParam: LPARAM; lpData: LPARAM): Integer; stdcall; begin if (uMsg = BFFM_INITIALIZED) then SendMessage(hwnd, BFFM_SETSELECTION, 1, lpData); BrowseCallbackProc := 0; end; function GetFolderDialog(Handle: Integer; Caption: string; var strFolder: string): Boolean; const BIF_STATUSTEXT = $0004; BIF_NEWDIALOGSTYLE = $0040; BIF_RETURNONLYFSDIRS = $0080; BIF_SHAREABLE = $0100; BIF_USENEWUI = BIF_EDITBOX or BIF_NEWDIALOGSTYLE; var BrowseInfo: TBrowseInfo; ItemIDList: PItemIDList; JtemIDList: PItemIDList; Path: PAnsiChar; begin Result := False; Path := StrAlloc(MAX_PATH); SHGetSpecialFolderLocation(Handle, CSIDL_DESKTOP, JtemIDList); with BrowseInfo do begin hwndOwner := GetActiveWindow; pidlRoot := JtemIDList; SHGetSpecialFolderLocation(hwndOwner, CSIDL_DESKTOP, JtemIDList); { return display name of item selected } pszDisplayName := StrAlloc(MAX_PATH); { set the title of dialog } lpszTitle := PChar(Caption); //'Select the folder'; { flags that control the return stuff } ulFlags := ulFlags or BIF_NEWDIALOGSTYLE or BIF_RETURNONLYFSDIRS; //ulFlags := ulFlags or BIF_RETURNONLYFSDIRS; lpfn := @BrowseCallbackProc; { extra info that's passed back in callbacks } lParam := LongInt(PChar(strFolder)); end; ItemIDList := SHBrowseForFolder(BrowseInfo); if (ItemIDList <> nil) then if SHGetPathFromIDList(ItemIDList, Path) then begin strFolder := Path; Result := True end; end; procedure TForm1.Button3Click(Sender: TObject); var s: string; begin if GetFolderDialog(handle, 'Select folder', s) then showmessage(s); end; Вызывают диалог типа: Как вызвать системный диалог сохранения и открытия файлов - понятно... а вот выбор папки - ну никак не соображу как. Кто знает, поделитесь. Мне просто интересно каким образом это делается. Програмистами не рождаются, ими становятся! |