delphi - 使用 Firemonkey 框架选择一个文件夹

Question

我想使用 Delphi XE2 将以下短代码片段从 VCL 移植到 FM

 with TFileOpenDialog.Create(nil) do
   try
    Title := 'Select Directory';
    Options := [fdoPickFolders, fdoPathMustExist, fdoForceFileSystem];
    OkButtonLabel := 'Select';
    DefaultFolder := FDir;
    FileName := FDir;
    if Execute then
       ShowMessage(FileName);
   finally
    Free;
 end

我找不到使用 FM 框架导入相关单元的帮助。至少 filecrtl 单元似乎不再可用此外，解决方案相关问题也没有在我的测试应用程序中出现窗口。

Answer 1

This works fine with a new FireMonkey HD application (running on Win7 64, both as a Win32 and Win64 target) in XE4.

It of course is specific to Windows. You can use OS-version specifics (WinVistaSelectFolder or WinXPSelectFolder), or just call the generic SelectFolder which does that for you.

unit WinFolderSelectUtils;

interface

uses
  SysUtils;

function SelectFolder: string;    
function WinVistaSelectFolder: string;
function WinXPSelectFolder: string;

implementation

uses
  ShellAPI, ShlObj, ActiveX, Windows;

function SelectFolder: string;
begin
  if TOSVersion.Check(6) then
    Result := WinVistaSelectFolder
  else
    Result := WinXPSelectFolder;
end;

function WinXPSelectFolder: string;
var
  BrowseInfo: TBrowseInfo;
  ItemIDList: PItemIDList;
  ItemSelected: PItemIDList;
  NameBuffer: array[0..MAX_PATH] of Char;
begin
  Result := '';

  // Should be doing some error handling here. Omitted for clarity, but
  // obviously should raise some sort of exception if anything fails instead
  // of just returning an empty string.
  ItemIDList := nil;
  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
  BrowseInfo.hwndOwner := 0;
  BrowseInfo.pidlRoot := ItemIDList;
  BrowseInfo.pszDisplayName := NameBuffer;
  BrowseInfo.lpszTitle := 'Select a directory';
  BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
  ItemSelected := SHBrowseForFolder(BrowseInfo);
  if ItemSelected <> nil then
  begin
    SHGetPathFromIDList(ItemSelected, NameBuffer);
    Result := NameBuffer;
  end;
  CoTaskMemFree(BrowseInfo.pidlRoot);
end;

function WinVistaSelectFolder: String;
var
  FileDialog: IFileDialog;
  hr: HRESULT;
  IResult: IShellItem;
  FileName: PWideChar;
  Settings: Cardinal;
  Title: String;
begin
  hr := CoCreateInstance(CLSID_FileOpenDialog,
                         nil,
                         CLSCTX_INPROC_SERVER,
                         IFileDialog,
                         FileDialog);
  if hr = S_OK then
  begin
    FileDialog.GetOptions(Settings);
    Settings := Settings or FOS_PICKFOLDERS or FOS_FORCEFILESYSTEM;
    FileDialog.SetOptions(Settings);
    FileDialog.SetOkButtonLabel('Select');
    Title := 'Select a directory';
    FileDialog.SetTitle(PWideChar(Title));
    hr := FileDialog.Show(0);
    if hr = S_OK then
    begin
      hr := FileDialog.GetResult(IResult);
      if hr = S_OK then
      begin
        IResult.GetDisplayName(SIGDN_FILESYSPATH, FileName);
        Result := FileName;
      end;
    end;
  end;
end;

end.

Answer 2

由于您使用的是 Windows，因此您甚至可以在 FireMonkey 应用程序中使用问题中的代码。我认为您需要将代码放入不使用任何 FMX 单元的单元中，否则它可以正常工作。您需要在该单元中使用 Vcl.Dialogs。