Как диалог SelectDirectory в Delphi может динамически проверять выделенную папку?

Question

Есть ли способ включить / отключить кнопку Ok в диалоге SelectDirectory на основе правила проверки, например:

• включить кнопку ОК, если имя выделенной папки - «config»
• включить кнопку ОК, если выделенная папка содержит файл с именем .project и папку с именем .settings

Answer 1

Вы можете сделать это, если используете функцию API ShBrowseForFolder. Я думаю, что Delphi поставляется с SelectDirectory версией, которая обертывает эту функцию, хотя обертка может не обеспечивать достаточного доступа для того, что вам нужно с ней делать. Вам необходимо включить функцию обратного вызова для параметра lpfn с этой подписью:

function BrowseCallbackProc(Wnd: HWnd; uMsg: UInt; lParam, lpData: LParam): Integer; stdcall;

Когда выбор изменяется, диалоговое окно вызывает функцию, которую вы указали с bffm_SelChanged в качестве параметра uMsg. Третьим параметром будет PIDL, представляющий текущий выбор, поэтому вам может потребоваться вызвать ShGetPathFromIDList, чтобы определить имя строки. Вы можете управлять кнопкой ОК, отправляя сообщения обратно на дескриптор окна диалогового окна в параметре Wnd. Например:

SendMessage(Wnd, bffm_EnableOK, 0, 0); // disable the button
SendMessage(Wnd, bffm_EnableOK, 0, 1); // enable the button

Не забудьте повторно включить кнопку для хороших выборов после того, как вы отключили ее для недействительных выборов.

Если критерием правильности выбора является то, что каталог должен содержать файл с определенным именем, обязательно включите флаг bif_BrowseIncludeFiles, чтобы люди могли видеть, какие файлы там есть.

Answer 2

Просто для дополнения отличный ответ @ Роб.

См. Этот код.

uses  ShlObj;

function BrowseCallbackProc(hwnd: HWND; MessageID: UINT; lParam: LPARAM; lpData: LPARAM): Integer; stdcall;
var
    DirName:  array[0..MAX_PATH] of Char;
    pIDL   :  pItemIDList;
begin
  case  MessageID    of
    BFFM_INITIALIZED:SendMessage(hwnd, BFFM_SETSELECTION, 1, lpData);
    BFFM_SELCHANGED :begin
                        pIDL := Pointer(lParam);
                        if  Assigned(PIDL) then
                        begin
                          SHGetPathFromIDList(pIDL, DirName);
                          if DirectoryExists(DirName) then
                           if (ExtractFileName(DirName)='config') then    //you can add more validations here
                            SendMessage(hwnd, BFFM_ENABLEOK, 0, 1) //enable the ok button
                           else
                            SendMessage(hwnd, BFFM_ENABLEOK, 0, 0) //disable the ok button
                          else
                          SendMessage(hwnd, BFFM_ENABLEOK, 0, 0);
                        end
                        else
                          SendMessage(hwnd, BFFM_ENABLEOK, 0, 0);
                     end;
  end;

  Result := 0;
end;

function SelectFolderDialogExt(Handle: Integer; var SelectedFolder: string): Boolean;
var
  ItemIDList: PItemIDList;
  JtemIDList: PItemIDList;
  DialogInfo: TBrowseInfo;
  Path: PAnsiChar;
begin
  Result := False;
  Path   := StrAlloc(MAX_PATH);
  SHGetSpecialFolderLocation(Handle, CSIDL_DRIVES, JtemIDList);
  with DialogInfo do
  begin
    pidlRoot      := JtemIDList;
    //ulFlags       := BIF_RETURNONLYFSDIRS;     //only select directories
    hwndOwner     := GetActiveWindow;
    SHGetSpecialFolderLocation(hwndOwner, CSIDL_DRIVES, JtemIDList);
    pszDisplayName := StrAlloc(MAX_PATH);
    lpszTitle       := PChar('Select a folder');
    lpfn            := @BrowseCallbackProc;
    lParam            := LongInt(PChar(SelectedFolder));
  end;

  ItemIDList := SHBrowseForFolder(DialogInfo);

  if (ItemIDList <> nil) then
    if SHGetPathFromIDList(ItemIDList, Path) then
    begin
      SelectedFolder := Path;
      Result         := True;
    end;
end;

выполнить

if SelectFolderDialogExt(Handle, SelectedDir) then
  ShowMessage(SelectedDir);