3

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

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

var
  chosenDirectory: string;

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

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

Диалог

1
  • откуда эта selectdirectory ?
    – teran
    14 июн 2017 в 8:50

3 ответа 3

2

Для 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
  • Спасибо! Сейчас подобное нашел что-то))
    – r03a
    14 июн 2017 в 9:24
  • да нормальное решение вроде, напрямую с winapi. хотел его к своему ответу дописать, а не успел :)
    – teran
    14 июн 2017 в 10:55
1

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

Как минимум, начиная с 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;
1
  • Пытался, ругается при компиляции
    – r03a
    14 июн 2017 в 9:11

Ваш ответ

By clicking “Отправить ответ”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками или задайте свой вопрос.