Вызов диалога “Обзор папок”

Как вызвать точно такое же окно выбора папки?
Использовал эту функцию:
var chosenDirectory: string;
SelectDirectory('Выберите папку', '', chosenDirectory);
Как сюда добавить кнопку создания папки?

Ответ

Для Delphi 7 находится вот такое (не очень красивое) решение:
uses ShlObj, ActiveX;
//global variables var lg_StartFolder: String;
//functions //no need to declare these anywhere at the top of the unit function BrowseForFolderCallBack(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer stdcall; begin if uMsg = BFFM_INITIALIZED then SendMessage(Wnd,BFFM_SETSELECTION, 1, Integer(@lg_StartFolder[1])); result := 0; end;
function BrowseForFolder(const browseTitle: String; const initialFolder: String =''): String; var browse_info: TBrowseInfo; folder: array[0..MAX_PATH] of char; find_context: PItemIDList; begin FillChar(browse_info, SizeOf(browse_info), #0); lg_StartFolder := initialFolder; browse_info.pszDisplayName := @folder[0]; browse_info.lpszTitle := PChar(browseTitle); browse_info.ulFlags := BIF_RETURNONLYFSDIRS or BIF_EDITBOX or $40; browse_info.hwndOwner := Application.Handle;
if initialFolder <> '' then browse_info.lpfn := BrowseForFolderCallBack; find_context := SHBrowseForFolder(browse_info); if Assigned(find_context) then begin if SHGetPathFromIDList(find_context,folder) then result := folder else result := ''; GlobalFreePtr(find_context); end else result := ''; end;
Пример использования:
procedure TForm4.Button3Click(Sender: TObject); begin BrowseForFolder('Select Dir', 'C:\'); end;