select a Folder using the Firemonkey framework - delphi

Question

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.

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

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.