1

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 ユニットはもう利用できないようです さらに、ソリューションに関連する質問は、テストアプリケーションでウィンドウを表示しません。

4

2 に答える 2

1

これは、XE4 の新しい FireMonkey HD アプリケーション (Win32 と Win64 の両方のターゲットとして Win7 64 で実行) で正常に動作します。

もちろん、これはWindowsに固有のものです。OS バージョンの仕様 (WinVistaSelectFolderまたはWinXPSelectFolder) を使用するか、それを行うジェネリックSelectFolderを呼び出すことができます。

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;

終わり。

于 2013-05-10T19:21:31.753 に答える
0

あなたはWindowsを使っているので、FireMonkeyアプリでも問題のコードを使うことができます。FMX ユニットを使用しないユニットにコードを配置する必要があると思いますが、それ以外の場合は正常に動作します。そのユニットでは Vcl.Dialogs を使用する必要があります。

于 2013-05-10T17:13:15.757 に答える