CODEWITHSUNDEEP
delphi
Franz
Franz

Reputation: 2043

select a Folder using the Firemonkey framework

i would like to port the following short code fragment from VCL to FM using Delphi XE2

 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

I could not find the help to import the relevant units using FM framework. At least the filecrtl unit seem to be not available any longer Furthermore the solution relevant question does nor come up with a window in my test application.

Upvotes: 1

Views: 3122

Answers (2)

Ken White
Ken White

Reputation: 125669

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.

Upvotes: 1

David Heffernan
David Heffernan

Reputation: 612944

Since you are using Windows, you can use the code in the question even in a FireMonkey app. I think you need to put the code into a unit which does not use any FMX units, but otherwise it works fine. You'll need to use Vcl.Dialogs in that unit.

Upvotes: 0

Related Questions