使用 TOpenDialog 选择目录

Question

我真的很想知道使用 TOpenDialog 选择目录的各种方法，无论是下载新组件还是使用 Delphi 提供的内容，但最好使用 Delphi 提供的内容。

在此之前，我一直在使用 SelectDirectory 命令，但我认为对于我的程序的用户来说，查找指定的目录会很困难。

我认为 SelectDirectory 很“弱”，因为搜索所需目录时它可能是一个漫长的过程。例如，您想要导航到应用程序数据目录。导航到那里需要多长时间或有多困难？最终，用户甚至可能无法到达他们想要的目录。

我需要这样的东西，用户可以将目录复制并粘贴到顶部的目录地址栏中。

感谢您的所有回答。

Answer 1

您可以使用

TFileOpenDialog

（在 Vista+ 上）：

with TFileOpenDialog.Create(nil) do
  try
    Options := [fdoPickFolders];
    if Execute then
      ShowMessage(FileName);
  finally
    Free;
  end;

就个人而言，我总是在 Vista+ 上使用

TFileOpenDialog

，并在 XP 上使用

SelectDirectory

（很好的！），如下所示：

if Win32MajorVersion >= 6 then
  with TFileOpenDialog.Create(nil) do
    try
      Title := 'Select Directory';
      Options := [fdoPickFolders, fdoPathMustExist, fdoForceFileSystem]; // YMMV
      OkButtonLabel := 'Select';
      DefaultFolder := FDir;
      FileName := FDir;
      if Execute then
        ShowMessage(FileName);
    finally
      Free;
    end
else
  if SelectDirectory('Select Directory', ExtractFileDrive(FDir), FDir,
             [sdNewUI, sdNewFolder]) then
    ShowMessage(FDir)

Answer 2

您确实知道名为

FileCtrl.SelectDirectory

的两个重载函数会产生完全不同的对话框，对吧？

SelectDirectory(s, [], 0);

SelectDirectory('Select a directory', s, s, []);

Answer 3

只需包含

FileCtrl.pas

var
  sDir:String;
begin
  SelectDirectory('Your caption','',sDir);
end;

如果想查看包括桌面在内的所有目录，只需将第二个参数留空即可。如果您将第二个参数设置为任何有效路径，那么您的对话框将具有指向顶部文件夹的路径，并且您无法导航到该路径之外。

例如：

SelectDirectory('Your caption','C:\',sDir)

不会让您选择

C:\

以外的任何内容，例如

D:\

或

E:\

等。

所以最好将其留空。

Answer 4

刚刚发现下面的代码似乎在 XP 和 Vista、Win7 中运行良好。它为用户提供选择目录的 UI。它使用 TOpenDialog，但会向其发送一些消息来清理外观，以便选择目录。

在经历了 Windows 本身提供的有限功能之后，很高兴能够为我的用户提供熟悉的 UI，让他们可以舒适地浏览和选择文件夹。

我一直在寻找这样的东西很长一段时间所以我想我将其发布在这里以便其他人可以从中受益。

这是 Win 7 中的样子：

//***********************
//** Choose a directory **
//**   uses Messages   **
//***********************
  //General usage here:
  //  http://www.delphipages.com/forum/showthread.php?p=185734
  //Need a class to hold a procedure to be called by Dialog.OnShow:
  type TOpenDir = class(TObject)
  public
    Dialog: TOpenDialog;
    procedure HideControls(Sender: TObject);
  end;
  //This procedure hides de combo box of file types...
  procedure TOpenDir.HideControls(Sender: TObject);
  const
    //CDM_HIDECONTROL and CDM_SETCONTROLTEXT values from:
    //  doc.ddart.net/msdn/header/include/commdlg.h.html
    //  CMD_HIDECONTROL = CMD_FIRST + 5 = (WM_USER + 100) + 5;
    //Usage of CDM_HIDECONTROL and CDM_SETCONTROLTEXT here:
    //  msdn.microsoft.com/en-us/library/ms646853%28VS.85%29.aspx
    //  msdn.microsoft.com/en-us/library/ms646855%28VS.85%29.aspx
    CDM_HIDECONTROL =    WM_USER + 100 + 5;
    CDM_SETCONTROLTEXT = WM_USER + 100 + 4;
    //Component IDs from:
    //  msdn.microsoft.com/en-us/library/ms646960%28VS.85%29.aspx#_win32_Open_and_Save_As_Dialog_Box_Customization
    //Translation into exadecimal in dlgs.h:
    //  www.koders.com/c/fidCD2C946367FEE401460B8A91A3DB62F7D9CE3244.aspx
    //
    //File type filter...
    cmb1: integer  = $470; //Combo box with list of file type filters
    stc2: integer  = $441; //Label of the file type
    //File name const...
    cmb13: integer = $47c; //Combo box with name of the current file
    edt1: integer  = $480; //Edit with the name of the current file
    stc3: integer  = $442; //Label of the file name combo
  var H: THandle;
  begin
    H:= GetParent(Dialog.Handle);
    //Hide file types combo...
    SendMessage(H, CDM_HIDECONTROL, cmb1,  0);
    SendMessage(H, CDM_HIDECONTROL, stc2,  0);
    //Hide file name label, edit and combo...
    SendMessage(H, CDM_HIDECONTROL, cmb13, 0);
    SendMessage(H, CDM_HIDECONTROL, edt1,  0);
    SendMessage(H, CDM_HIDECONTROL, stc3,  0);
    //NOTE: How to change label text (the lentgh is not auto):
    //SendMessage(H, CDM_SETCONTROLTEXT, stc3, DWORD(pChar('Hello!')));
  end;
//Call it when you need the user to chose a folder for you...
function GimmeDir(var Dir: string): boolean;
var
  OpenDialog: TOpenDialog;
  OpenDir: TOpenDir;
begin
  //The standard dialog...
  OpenDialog:= TOpenDialog.Create(nil);
  //Objetc that holds the OnShow code to hide controls
  OpenDir:= TOpenDir.create;
  try
    //Conect both components...
    OpenDir.Dialog:= OpenDialog;
    OpenDialog.OnShow:= OpenDir.HideControls;
    //Configure it so only folders are shown (and file without extension!)...
    OpenDialog.FileName:= '*.';
    OpenDialog.Filter:=   '*.';
    OpenDialog.Title:=    'Chose a folder';
    //No need to check file existis!
    OpenDialog.Options:= OpenDialog.Options + [ofNoValidate];
    //Initial folder...
    OpenDialog.InitialDir:= Dir;
    //Ask user...
    if OpenDialog.Execute then begin
      Dir:= ExtractFilePath(OpenDialog.FileName);
      result:= true;
    end else begin
      result:= false;
    end;
  finally
    //Clean up...
    OpenDir.Free;
    OpenDialog.Free;
  end;
end;

Answer 5

如果您使用JVCL，您可以使用TJvSelectDirectory。这样，您可以通过设置属性在新旧样式之间切换。例如：

Dlg := TJvSelectDirectory.Create(Self);
try
    Dlg.Title := MyTitle;
    Dlg.InitialDir := MyStartDir;
    Dlg.Options := Dlg.Options + [sdAllowCreate, sdPerformCreate];     
    Dlg.ClassicDialog := False;   //switch style
    if Dlg.Execute() then
      NewDir := Dlg.Directory;
finally
    Dlg.Free;
end; 

Answer 6

如果有人仍然感兴趣的话，这是一个简单的文件夹选择器。

代码在源代码中归属于其作者。 我看不到有空了。

请务必将所属表单作为 AOwner 传递，以确保这是一个模式对话框。

unit FolderBrowser;

//by Johnny Mamenko, (c) 1999
//e-mail: [email protected]
//http://attend.to/johnny

interface

uses
  Windows, Messages, SysUtils, Classes, controls, shlobj, DntFunc;


type
  EFolderBrowserException = class(Exception);
  TBrowseFlag = (bfComputersOnly, bfPrintersOnly, bfDirsOnly, bfStatusText);
  TBrowseFlags = set of TBrowseFlag;

  TFolderChangeEvent = procedure ( const Folder: string;
                                   var EnabledOK : integer;
                                   //0  - Disables the OK button
                                   //1  - Enables the OK button
                                   //-1 - leave as is
                                   var StatusText : string) of object;

  TFolderBrowser = class (TComponent)
  private
    FTitle : string;
    FBrowseFlags : TBrowseFlags;
    FFolder: string;
    FOwnerHandle : HWND;
    FOnChangeFolder: TFolderChangeEvent;
    procedure SetFolder(const Value: string);
    procedure SetOnChangeFolder(const Value: TFolderChangeEvent);
  protected
  public
    constructor Create(AOwner : TComponent); override;
    function Execute: boolean;
  published
    property BrowseFlags : TBrowseFlags read FBrowseFlags write FBrowseFlags;
    property Folder : string read FFolder write SetFolder;
    property Title : string read FTitle write FTitle;
    property OnChangeFolder : TFolderChangeEvent read FOnChangeFolder write SetOnChangeFolder;
  end;

procedure Register;
function FolderCallBack(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer stdcall;

implementation

var
  CurrentOpenedFolder : string;
  CurrentEventHandler : TFolderChangeEvent;

procedure Register;
begin
  RegisterComponents( 'Johnny', [ TFolderBrowser ] );
end;

function FolderCallBack(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer stdcall;
var
  a  : array[0..MAX_PATH] of Char;
  EnabledOK : integer;
  StatusText, Folder : string;
begin
  Result:=0;
  if uMsg=BFFM_INITIALIZED then begin
    StrPCopy(a,CurrentOpenedFolder);
    SendMessage(Wnd, BFFM_SETSELECTION, 1, Integer(@a[0]));
    exit;
    end;//if uMsg=BFFM_INITIALIZED
  if uMsg=BFFM_SELCHANGED then begin
    EnabledOK:=-1;
    StatusText:='';
    SHGetPathFromIDList(Pointer(lParam),a);
    Folder:=StrPas(a);
    if Assigned(CurrentEventHandler) and (Folder<>'')
      then CurrentEventHandler(Folder, EnabledOK, StatusText);
    if EnabledOK<>-1 then SendMessage(Wnd, BFFM_ENABLEOK, EnabledOK, EnabledOK);
    if StatusText<>''
      then SendMessage(Wnd, BFFM_SETSTATUSTEXT, EnabledOK, Integer(PChar(StatusText)));
    end;//if uMsg=BFFM_SELCHANGED
end;

{TFolderBrowser}

constructor TFolderBrowser.Create(AOwner : TComponent);
begin
  if not(AOwner is TWinControl) then Raise EFolderBrowserException.Create('I need WinControl!!!');
  inherited Create(AOwner);
  FOwnerHandle:=(AOwner As TWinControl).Handle;
  FTitle:='Select Folder';
  FBrowseFlags:=[];
  FFolder:='';
end;

function TFolderBrowser.Execute: boolean;
var bi : TBrowseInfoA;
    a  : array[0..MAX_PATH] of Char;
    b : PChar;
    idl : PItemIDList;
begin
  b:=StrAlloc(Length(FTitle)+1);
  try
    StrPCopy(b,FTitle);
    bi.hwndOwner:=FOwnerHandle;
    bi.pszDisplayName:=@a[0];
    bi.lpszTitle:=b;
    bi.ulFlags:=BIF_BROWSEFORCOMPUTER*Byte(bfComputersOnly in BrowseFlags)+
                BIF_BROWSEFORPRINTER*Byte(bfPrintersOnly in BrowseFlags)+
                BIF_RETURNONLYFSDIRS*Byte(bfDirsOnly in BrowseFlags)+
                BIF_STATUSTEXT*Byte(bfStatusText in BrowseFlags);
    bi.lpfn:=FolderCallBack;
    bi.lParam:=0;
    bi.pidlRoot:=Nil;
    CurrentOpenedFolder:=FFolder;
    CurrentEventHandler:=FOnChangeFolder;
    idl:=SHBrowseForFolder(bi);
    if idl<>nil then begin
      SHGetPathFromIDList(idl,a);
      FFolder:=StrPas(a);
      Result:=true;
      end//if idl<>nil
    else Result:=false;
  finally
    StrDispose(b);
  end;//finally
end;

procedure TFolderBrowser.SetFolder(const Value: string);
begin
  FFolder:=Value;
end;

procedure TFolderBrowser.SetOnChangeFolder(const Value: TFolderChangeEvent);
begin
  FOnChangeFolder:=Value;
end;

initialization
  CurrentOpenedFolder:='';
  CurrentEventHandler:=Nil;
end.

[文件夹浏览器截图]