Get access to over 100 FireMonkey cross platform samples for Android, IOS, OSX, Windows, and Linux!

AppmethodCode SnippetDelphiFiremonkeyOSXWindows

Select Directory Dialogs In #Delphi XE8 Firemonkey On Windows and OSX

| Delphi 11 10 XE8 XE7 XE Seattle Berlin Tokyo Rio Firemonkey Delphi Android Delphi IOS

Delphi XE8 Firemonkey Select Directory Windows OSX | Delphi 11 10 XE8 XE7 XE Seattle Berlin Tokyo Rio Firemonkey Delphi Android Delphi IOS

If you are building a multi platform app in Delphi XE8 Firemonkey for Windows and OSX you may have need of a select directory dialog box. Both platforms have their own unique APIs for creating this dialog box. Here is a code snippet which wraps up both APIs into a single easy to use function. On Windows it uses SHBrowseForFolder and on OSX it uses TNSOpenPanel. The function doesn’t provide a dialog for IOS or Android. However, it should also work in Appmethod. Here is the code snippet:

uses
{$IFDEF MSWINDOWS}
FMX.Platform.Win, Winapi.Windows, Winapi.ShellAPI, ComObj, ShlObj, ActiveX;
{$ENDIF MSWINDOWS}
{$IFDEF MACOS}
Macapi.AppKit, Macapi.Foundation, Macapi.ObjectiveC;
{$ENDIF MACOS}
//
var
NewPath: string;
begin
if SelectDirectory('Please select directory...', NewPath) then
begin
edSearchPath.Text := NewPath;
end;
//
{$IFDEF MSWINDOWS}
function BI_CallBack_Proc(hwnd: HWND; uMsg: UINT; lParam: DWORD;
lpData: DWORD): integer; stdcall;
var
PathName: array[0..MAX_PATH] of Char;
begin
case uMsg of
BFFM_INITIALIZED:
SendMessage(Hwnd, BFFM_SETSELECTION, Ord(True), Integer(lpData));
BFFM_SELCHANGED:
begin
SHGetPathFromIDList(PItemIDList(lParam), @PathName);
SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, Longint(PChar(@PathName)));
end;
end;
Result := 0;
end;
{$ENDIF MSWINDOWS}
//
function SelectDirectory(const ATitle: string;
var ADir: string): boolean;
{$IFDEF MSWINDOWS}
var
hr: HRESULT;
FormHandle: THandle;
IDList: PItemIDList;
RootIDList: PItemIDList;
Malloc: IMalloc;
lpBuf: LPTSTR;
BI: TBrowseInfo;
sCaption: string;
begin
Result := False;
FormHandle := FMX.Platform.Win.WindowHandleToPlatform(Handle).Wnd;
ADir := EmptyStr;
if (SHGetMalloc(Malloc) = S_OK) and (Malloc <> nil) then
begin
sCaption := ATitle;
FillChar(BI, SizeOf(BI), 0);
lpBuf := Malloc.Alloc(MAX_PATH);
RootIDList := nil;
SHGetSpecialFolderLocation(FormHandle, CSIDL_DESKTOP, RootIDList);
with BI do
begin
hwndOwner := FormHandle;
pidlRoot := RootIDList;
pszDisplayName := lpBuf;
lpszTitle := PWideChar(sCaption);
ulFlags := BIF_NEWDIALOGSTYLE or BIF_USENEWUI;
lpfn := @BI_CallBack_Proc;
lParam := 0;
iImage := 0;
end;
try
hr := CoInitializeEx(nil, COINIT_APARTMENTTHREADED);
if (hr = S_OK) or (hr = S_FALSE) then
begin
IDList := SHBrowseForFolder(BI);
Result := IDList <> nil;
if Result then
begin
SHGetPathFromIDList(IDList, lpBuf);
ADir := StrPas(lpBuf);
Malloc.Free(RootIDList);
RootIDList := nil;
Malloc.Free(IDList);
IDList := nil;
end;
CoUnInitialize();
end;
finally
Malloc.Free(lpBuf);
end;
end;
{$ENDIF MSWINDOWS}
{$IFDEF MACOS}
var
LOpenDir: NSOpenPanel;
LInitialDir: NSURL;
LDlgResult: Integer;
begin
Result := False;
LOpenDir := TNSOpenPanel.Wrap(TNSOpenPanel.OCClass.openPanel);
LOpenDir.setAllowsMultipleSelection(False);
LOpenDir.setCanChooseFiles(False);
LOpenDir.setCanChooseDirectories(True);
if ADir <> '' then
begin
LInitialDir := TNSURL.Create;
LInitialDir.initFileURLWithPath(NSSTR(ADir));
LOpenDir.setDirectoryURL(LInitialDir);
end;
if ATitle <> '' then
LOpenDir.setTitle(NSSTR(ATitle));
LOpenDir.retain;
try
LDlgResult := LOpenDir.runModal;
if LDlgResult = NSOKButton then
begin
ADir := string(TNSUrl.Wrap(LOpenDir.URLs.objectAtIndex(0)).relativePath.UTF8String);
Result := True;
end;
finally
LOpenDir.release;
end;
{$ENDIF MACOS}
end;

Head over and check out more information about Conditional Compilation in Delphi XE8 Firemonkey.

close

Have Delphi Firemonkey questions? Ask and get answers on StackOverflow.

Related posts
DelphiFiremonkeyShowcaseWindows

How To Build Stable Diffusion Text To Image Prompts

AndroidC++BuilderDelphiFiremonkeyIOSOSXWindows

FireMonkey 10.4.2 Features Updated iOS 14, Android 11, And macOS 11 Support Plus Hundreds Of Fixes

DelphiIDEShowcaseWindows

Ryzen 9 5950x: One Billion Lines Of Delphi Code Compiled In ~5 Minutes On 16 Cores

DelphiFiremonkeyIDEIOSOSXWindows

DelphiCon 2020 FireMonkey Sessions Available Starting November 19

Sign up for our Newsletter and
stay informed

Leave a Reply to Zam Cancel reply