Как вызвать точно такое же окно выбора папки?
Использовал эту функцию:
var
chosenDirectory: string;
SelectDirectory('Выберите папку', '', chosenDirectory);
Как сюда добавить кнопку создания папки?
Stack Overflow на русском — это сайт вопросов и ответов для программистов. Присоединяйтесь! Регистрация займёт не больше минуты.
Присоединиться к сообществуДля 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;
не уверен на счет Delphi-7, но в более поздних версиях можно было использовать класс StdActns.TBrowseForFolder
:
procedure TForm1.ChooseDirButtonClick(Sender: TObject);
var bff : TBrowseForFolder;
begin
bff := TBrowseForFolder.create(nil);
try
bff.Caption := 'Выберите папку';
bff.BrowseOptions := [bifNewDialogStyle];
if bff.Execute() then begin
if bff.Folder <> '' then
showMessage(bff.Folder);
end;
finally
bff.Free();
end;
end;
Как минимум, начиная с Delphi 2007 (про Delphi 7 не уверен), в юните FileCtrl
есть функция SelectDirectory
, которая имеет вот такое описание:
function SelectDirectory(
const Caption: string;
const Root: WideString;
var Directory: string;
Options: TSelectDirExtOpts = [sdNewUI];
Parent: TWinControl = nil
): Boolean; overload;
Соответственно, передав опцию sdNewFolder
в параметре Options
можно добиться того, что вам нужно:
uses
FileCtrl;
...
if SelectDirectory('Выберите папку', '', chosenDirectory, [sdNewFolder, sdNewUI, sdShowEdit, sdShowShares]) then begin
...
end;
selectdirectory
?