FireMonkey には SelectDirectory() がないのだとか。
[Firemonkey HD Application フォルダ選択ダイアログボックスが無い (Embarcadero Discussion Forums)]
https://forums.embarcadero.com/thread.jspa?threadID=96309
SHBrowseForFolder() をラッピングしたものを使えばいいような気がします。以下の関数は VCL の SelectDirectory() の二番目の方と互換性があります。
[FMX.SelectDirectory.Win.pas]
unit FMX.SelectDirectory.Win;
interface
uses
System.SysUtils, System.UITypes, FMX.Dialogs, FMX.Platform.Win, Winapi.Windows,
Winapi.Messages, Winapi.ShlObj, Winapi.ActiveX, Vcl.Consts;
type
TSelectDirExtOpt = (sdNewFolder, sdShowEdit, sdShowShares, sdNewUI, sdShowFiles, sdValidateDir);
TSelectDirExtOpts = set of TSelectDirExtOpt;
function SelectDirectory(const Caption: string; const Root: WideString;
var Directory: string; Options: TSelectDirExtOpts = [sdNewUI]; Parent: HWND = 0): Boolean;
implementation
function BrowseFolderCallbackProc(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer; stdcall;
begin
Result := 0;
case uMsg of
BFFM_INITIALIZED:
SendMessage(Wnd, BFFM_SETSELECTION, 1, lpData);
BFFM_VALIDATEFAILEDW,
BFFM_VALIDATEFAILEDA:
begin
MessageDlg(Format(SInvalidPath, [PChar(lParam)]), TMsgDlgType.mtError, [TMsgDlgBtn.mbOK], 0);
Result := 1;
end;
end;
end;
function SelectDirectory(const Caption: string; const Root: WideString;
var Directory: string; Options: TSelectDirExtOpts = [sdNewUI]; Parent: HWND = 0): Boolean;
var
BI: TBrowseInfo;
IDList, RootIDList: PItemIDList;
Dir: array[0..Max_Path] of Char;
IDesktopFolder: IShellFolder;
Eaten, Flags: LongWord;
begin
Result := False;
FillChar(BI, SizeOf(BI), 0);
with BI do
begin
hwndOwner := Parent;
lpfn := @BrowseFolderCallbackProc;
lpszTitle := PChar(Caption);
RootIDList := nil;
if Root <> '' then
begin
SHGetDesktopFolder(IDesktopFolder);
IDesktopFolder.ParseDisplayName(Parent, nil, POleStr(Root), Eaten, RootIDList, Flags);
end;
pidlRoot := RootIDList;
ulFlags := BIF_RETURNONLYFSDIRS;
if (sdNewUI in Options) then
begin
ulFlags := ulFlags or BIF_NEWDIALOGSTYLE;
if not (sdNewFolder in Options) then
ulFlags := ulFlags or BIF_NONEWFOLDERBUTTON;
end;
if (sdShowEdit in Options) then
begin
ulFlags := ulFlags or BIF_EDITBOX;
if (sdValidateDir in Options) then
ulFlags := ulFlags or BIF_VALIDATE;
end;
if (sdShowShares in Options) then
ulFlags := ulFlags or BIF_SHAREABLE;
if (sdShowFiles in Options) then
ulFlags := ulFlags or BIF_BROWSEINCLUDEFILES;
lParam := Winapi.Windows.LPARAM(PChar(IncludeTrailingPathDelimiter(Directory)));
end;
IDList := SHBrowseForFolder(BI);
if IDList <> nil then
begin
SHGetPathFromIDList(IDList, Dir);
Directory := string(Dir);
Result := True;
end;
end;
end.
Vcl.Consts は SInvalidPath 定数のためだけに使われています…FMX.Consts には適当な定数がないのですヨ。多言語化が必要ないのでしたら、ここを直接書き換えてしまえば Vcl.Consts は不要になります。
使い方は以下になります。
uses
..., FMX.Platform.Win, FMX.SelectDirectory.Win;
var
Dir: String;
begin
if SelectDirectory('Caption', '', Dir, [sdNewUI, sdNewFolder], FmxHandleToHWND(Self.Handle)) then
Edit1.Text := Dir;
end;
Embarcadero Discussion Forums はしばしば見えなくなるので念のためにこちらにも転記しておきます。
See Also:
[SelectDirectory (DocWiki)]
http://docwiki.embarcadero.com/Libraries/ja/Vcl.FileCtrl.SelectDirectory
[SHBrowseForFolder function (MSDN)]
http://msdn.microsoft.com/en-us/library/windows/desktop/bb762115%28v=vs.85%29.aspx
|
