@davea 的答案还可以,但它只显示旧的(WinXP)对话框样式。
所以,这是我现在使用的代码。在 Win Vista 及更高版本上,它显示新样式对话框和 Win XP 上的旧样式:
{$WARN SYMBOL_PLATFORM OFF}
{$IFDEF MSWindows}
function SelectAFolder(VAR Folder: string; CONST Options: TFileDialogOptions= [fdoPickFolders, fdoForceFileSystem, fdoPathMustExist, fdoDefaultNoMiniMode]): Boolean; { Keywords: FolderDialog, BrowseForFolder} { Works with UNC paths }
VAR Dlg: TFileOpenDialog;
begin
{ Win Vista and up }
if OS_IsWindowsVistaUp then
begin
Dlg:= TFileOpenDialog.Create(NIL); { Class for Vista and newer Windows operating systems style file open dialogs }
TRY
Dlg.Options := Options;
Dlg.DefaultFolder := Folder;
Dlg.FileName := Folder;
Result := Dlg.Execute;
if Result
then Folder:= Dlg.FileName;
FINALLY
FreeAndNil(Dlg);
END;
end
else
{ Win XP or down }
Result:= vcl.FileCtrl.SelectDirectory('', ExtractFileDrive(Folder), Folder, [sdNewUI, sdShowEdit, sdNewFolder], nil);
if Result
then Folder:= Trail(Folder);
end;
{$ENDIF}
{$WARN SYMBOL_PLATFORM On}
{ Keywords: FolderDialog, BrowseForFolder}