欧美熟妇另类久久久久久不卡,欧美精品一国产成人综合久久

一直使用經典版本的選擇文件夾對話框

文章插圖
代碼如下：
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;
做個筆記以防忘記。