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

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

代码如下：

function SelectDirectory(const Caption: string; const Root: WideString; var Directory: string): Boolean;

var

WindowList: Pointer;

BrowseInfo: TBrowseInfo;

Buffer: PChar;

OldErrorMode: Cardinal;

RootItemIDList, ItemIDList: PItemIDList;

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;

做个笔记以防忘记。