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

Question

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

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

?

Answer 1

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

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

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

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

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

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

Answer 2

Просто для дополнения отличного ответа от @Rob.

Посмотрите этот код.

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);