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

#delphi #delphi_7

Как вызвать точно такое же окно выбора папки?

Использовал эту функцию:

var
  chosenDirectory: string;

SelectDirectory('Выберите папку', '', chosenDirectory);


Как сюда добавить кнопку создания папки?


    

Ответы

Ответ 1

Для 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;


Ответ 2

не уверен на счет 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;


Ответ 3

Как минимум, начиная с 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;