Delphi 使其仅适用于最常用的对话框

在Delphi 2007及更高版本中，全局变量

UseLatestCommonDialogs

使

TOpenDialog

在Windows Vista和7上使用新的Vista样式对话框。那很酷

不幸的是，Vista样式对话框似乎不支持TopEndDialog的Hieradoly选项。无论此选项设置为True还是False，只读复选框都不会出现

如何使TopEndDialog在Vista样式对话框上显示只读复选框？

---

由于这破坏了向后兼容性，我将其报告为一个错误：Delphi 2006应用程序的默认设置为False，在使用Delphi 2007、2009编译时，如果不进行更改，将丢失其只读复选框，或2010，并在Windows Vista或7上运行。

我通过修改Dialogs.pas在Delphi 2010中实现了这一点，如下所示：

首先，声明并实现类

TFileOpenDialogWrapperReadOnlyEvent

：

{ TFileOpenDialogWrapperReadOnlyEvent }

type
  TFileOpenDialogWrapperReadOnlyEvent = class(TInterfacedObject, IFileDialogEvents, IFileDialogControlEvents)
  private
    FOpenDialog: TOpenDialog;
  public
    function OnButtonClicked(const pfdc: IFileDialogCustomize; dwIDCtl: Cardinal): HRESULT; stdcall;
    function OnCheckButtonToggled(const pfdc: IFileDialogCustomize; dwIDCtl: Cardinal; bChecked: LongBool): HRESULT; stdcall;
    function OnControlActivating(const pfdc: IFileDialogCustomize; dwIDCtl: Cardinal): HRESULT; stdcall;
    function OnItemSelected(const pfdc: IFileDialogCustomize; dwIDCtl: Cardinal; dwIDItem: Cardinal): HRESULT; stdcall;
    function OnFileOk(const pfd: IFileDialog): HRESULT; stdcall;
    function OnFolderChange(const pfd: IFileDialog): HRESULT; stdcall;
    function OnFolderChanging(const pfd: IFileDialog; const psiFolder: IShellItem): HRESULT; stdcall;
    function OnOverwrite(const pfd: IFileDialog; const psi: IShellItem; out pResponse: Cardinal): HRESULT; stdcall;
    function OnSelectionChange(const pfd: IFileDialog): HRESULT; stdcall;
    function OnShareViolation(const pfd: IFileDialog; const psi: IShellItem; out pResponse: Cardinal): HRESULT; stdcall;
    function OnTypeChange(const pfd: IFileDialog): HRESULT; stdcall;
  end;

function TFileOpenDialogWrapperReadOnlyEvent.OnButtonClicked(const pfdc: IFileDialogCustomize; dwIDCtl: Cardinal): HRESULT;
begin
  Result := S_OK
end;

function TFileOpenDialogWrapperReadOnlyEvent.OnCheckButtonToggled(const pfdc: IFileDialogCustomize; dwIDCtl: Cardinal; bChecked: LongBool): HRESULT;
begin
  if bChecked then FOpenDialog.Options := FOpenDialog.Options + [ofReadOnly]
    else FOpenDialog.Options := FOpenDialog.Options - [ofReadOnly];
  Result := S_OK
end;

function TFileOpenDialogWrapperReadOnlyEvent.OnControlActivating(const pfdc: IFileDialogCustomize; dwIDCtl: Cardinal): HRESULT;
begin
  Result := S_OK
end;

function TFileOpenDialogWrapperReadOnlyEvent.OnFileOk(const pfd: IFileDialog): HRESULT;
begin
  Result := S_OK
end;

function TFileOpenDialogWrapperReadOnlyEvent.OnFolderChange(const pfd: IFileDialog): HRESULT;
begin
  Result := S_OK
end;

function TFileOpenDialogWrapperReadOnlyEvent.OnFolderChanging(const pfd: IFileDialog; const psiFolder: IShellItem): HRESULT;
begin
  Result := S_OK
end;

function TFileOpenDialogWrapperReadOnlyEvent.OnItemSelected(const pfdc: IFileDialogCustomize; dwIDCtl, dwIDItem: Cardinal): HRESULT;
begin
  Result := S_OK
end;

function TFileOpenDialogWrapperReadOnlyEvent.OnOverwrite(const pfd: IFileDialog; const psi: IShellItem; out pResponse: Cardinal): HRESULT;
begin
  Result := S_OK
end;

function TFileOpenDialogWrapperReadOnlyEvent.OnSelectionChange(const pfd: IFileDialog): HRESULT;
begin
  Result := S_OK
end;

function TFileOpenDialogWrapperReadOnlyEvent.OnShareViolation(const pfd: IFileDialog; const psi: IShellItem; out pResponse: Cardinal): HRESULT;
begin
  Result := S_OK
end;

function TFileOpenDialogWrapperReadOnlyEvent.OnTypeChange(const pfd: IFileDialog): HRESULT;
begin
  Result := S_OK
end;

将此字符串声明为资源，以便对其进行本地化（如果您关心此问题）：

然后分两步修改

TFileOpenDialogWrapper.OnExecuteEvent

。首先，添加以下变量声明：

C: IFileDialogCustomize;
E: TFileOpenDialogWrapperReadOnlyEvent;
Cookie: Cardinal;

然后在程序末尾添加此代码：

if not (ofHideReadOnly in FOpenDialog.Options) then begin
  if FFileDialog.Dialog.QueryInterface(IFileDialogCustomize, C) = S_OK then begin
    C.AddCheckButton(1, PChar(SReadOnly), ofReadOnly in FOpenDialog.Options);
    E := TFileOpenDialogWrapperReadOnlyEvent.Create;
    E.FOpenDialog := FOpenDialog;
    FFileDialog.Dialog.Advise(E, Cookie);
  end;
end;

---

将新Dialogs.pas复制到源代码文件夹中，并删除或重命名Delphi的

Lib

文件夹中的两个Dialogs.dcu文件。重新编译你的应用程序，一个仅适用于Vista风格对话框的应用程序。

我通过修改dialogs.pas在Delphi 2010中实现了这一点，如下所示：

首先，声明并实现类

TFileOpenDialogWrapperReadOnlyEvent

：

{ TFileOpenDialogWrapperReadOnlyEvent }

type
  TFileOpenDialogWrapperReadOnlyEvent = class(TInterfacedObject, IFileDialogEvents, IFileDialogControlEvents)
  private
    FOpenDialog: TOpenDialog;
  public
    function OnButtonClicked(const pfdc: IFileDialogCustomize; dwIDCtl: Cardinal): HRESULT; stdcall;
    function OnCheckButtonToggled(const pfdc: IFileDialogCustomize; dwIDCtl: Cardinal; bChecked: LongBool): HRESULT; stdcall;
    function OnControlActivating(const pfdc: IFileDialogCustomize; dwIDCtl: Cardinal): HRESULT; stdcall;
    function OnItemSelected(const pfdc: IFileDialogCustomize; dwIDCtl: Cardinal; dwIDItem: Cardinal): HRESULT; stdcall;
    function OnFileOk(const pfd: IFileDialog): HRESULT; stdcall;
    function OnFolderChange(const pfd: IFileDialog): HRESULT; stdcall;
    function OnFolderChanging(const pfd: IFileDialog; const psiFolder: IShellItem): HRESULT; stdcall;
    function OnOverwrite(const pfd: IFileDialog; const psi: IShellItem; out pResponse: Cardinal): HRESULT; stdcall;
    function OnSelectionChange(const pfd: IFileDialog): HRESULT; stdcall;
    function OnShareViolation(const pfd: IFileDialog; const psi: IShellItem; out pResponse: Cardinal): HRESULT; stdcall;
    function OnTypeChange(const pfd: IFileDialog): HRESULT; stdcall;
  end;

function TFileOpenDialogWrapperReadOnlyEvent.OnButtonClicked(const pfdc: IFileDialogCustomize; dwIDCtl: Cardinal): HRESULT;
begin
  Result := S_OK
end;

function TFileOpenDialogWrapperReadOnlyEvent.OnCheckButtonToggled(const pfdc: IFileDialogCustomize; dwIDCtl: Cardinal; bChecked: LongBool): HRESULT;
begin
  if bChecked then FOpenDialog.Options := FOpenDialog.Options + [ofReadOnly]
    else FOpenDialog.Options := FOpenDialog.Options - [ofReadOnly];
  Result := S_OK
end;

function TFileOpenDialogWrapperReadOnlyEvent.OnControlActivating(const pfdc: IFileDialogCustomize; dwIDCtl: Cardinal): HRESULT;
begin
  Result := S_OK
end;

function TFileOpenDialogWrapperReadOnlyEvent.OnFileOk(const pfd: IFileDialog): HRESULT;
begin
  Result := S_OK
end;

function TFileOpenDialogWrapperReadOnlyEvent.OnFolderChange(const pfd: IFileDialog): HRESULT;
begin
  Result := S_OK
end;

function TFileOpenDialogWrapperReadOnlyEvent.OnFolderChanging(const pfd: IFileDialog; const psiFolder: IShellItem): HRESULT;
begin
  Result := S_OK
end;

function TFileOpenDialogWrapperReadOnlyEvent.OnItemSelected(const pfdc: IFileDialogCustomize; dwIDCtl, dwIDItem: Cardinal): HRESULT;
begin
  Result := S_OK
end;

function TFileOpenDialogWrapperReadOnlyEvent.OnOverwrite(const pfd: IFileDialog; const psi: IShellItem; out pResponse: Cardinal): HRESULT;
begin
  Result := S_OK
end;

function TFileOpenDialogWrapperReadOnlyEvent.OnSelectionChange(const pfd: IFileDialog): HRESULT;
begin
  Result := S_OK
end;

function TFileOpenDialogWrapperReadOnlyEvent.OnShareViolation(const pfd: IFileDialog; const psi: IShellItem; out pResponse: Cardinal): HRESULT;
begin
  Result := S_OK
end;

function TFileOpenDialogWrapperReadOnlyEvent.OnTypeChange(const pfd: IFileDialog): HRESULT;
begin
  Result := S_OK
end;

将此字符串声明为资源，以便对其进行本地化（如果您关心此问题）：

然后分两步修改

TFileOpenDialogWrapper.OnExecuteEvent

。首先，添加以下变量声明：

C: IFileDialogCustomize;
E: TFileOpenDialogWrapperReadOnlyEvent;
Cookie: Cardinal;

然后在程序末尾添加此代码：

if not (ofHideReadOnly in FOpenDialog.Options) then begin
  if FFileDialog.Dialog.QueryInterface(IFileDialogCustomize, C) = S_OK then begin
    C.AddCheckButton(1, PChar(SReadOnly), ofReadOnly in FOpenDialog.Options);
    E := TFileOpenDialogWrapperReadOnlyEvent.Create;
    E.FOpenDialog := FOpenDialog;
    FFileDialog.Dialog.Advise(E, Cookie);
  end;
end;

将新Dialogs.pas复制到源代码文件夹中，并删除或重命名Delphi的

Lib

文件夹中的两个Dialogs.dcu文件。重新编译你的应用程序，只需使用Vista风格的对话框即可。

相关问题：。执行VCL不支持OOTB的任何操作都需要使用新样式对话框上的

IFileDialogCustomize

界面。相关问题：。执行VCL不支持OOTB的任何操作都需要使用新样式对话框上的

IFileDialogCustomize

界面。