Delphi11 使用windows新版的文件夹选择对话框 _Delphi11

一直使用经典版本的选择文件夹对话框

文章插图
代码如下：
function SelectDirectory(const Caption: string; const Root: WideString; var Directory: string): Boolean;
var
WindowList: Pointer;
BrowseInfo: TBrowseInfo;
Buffer: PChar;
OldErrorMode: Cardinal;
RootItemIDList, ItemIDList: PItemIDList;
【Delphi11 使用windows新版的文件夹选择对话框】ShellMalloc: IMalloc;
IDesktopFolder: IShellFolder;
Eaten, Flags: LongWord;
begin
Result := False;
if not DirectoryExists(Directory) then
Directory := ”;
FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
begin
Buffer := ShellMalloc.Alloc(MAX_PATH);
try
RootItemIDList := nil;
if Root <> ” then
begin
SHGetDesktopFolder(IDesktopFolder);
IDesktopFolder.ParseDisplayName(Application.Handle, nil, POleStr(Root), Eaten, RootItemIDList, Flags);
end;
with BrowseInfo do
begin
hwndOwner := Application.Handle;
pidlRoot := RootItemIDList;
pszDisplayName := Buffer;
lpszTitle := PChar(Caption);
ulFlags := BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE;
if Directory <> ” then
begin
lpfn := SelectDirCB;
lParam := Integer(PChar(Directory));
end;
end;
WindowList := DisableTaskWindows(0);
OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
try
ItemIDList := ShBrowseForFolder(BrowseInfo);
finally
SetErrorMode(OldErrorMode);
EnableTaskWindows(WindowList);
end;
Result := ItemIDList <> nil;
if Result then
begin
ShGetPathFromIDList(ItemIDList, Buffer);
ShellMalloc.Free(ItemIDList);
Directory := Buffer;
end;
finally
ShellMalloc.Free(Buffer);
end;
end;
end;
说实话该对话框应该被淘汰了，最新的文件夹选择对话框代码量少，用户界面也非常友好。

文章插图
代码如下：
with TFileOpenDialog.Create(nil) do
try
Options := [fdoPickFolders];
if Execute then
begin
showmessage(filename);
end;
finally
Free;
end;
做个笔记以防忘记。