取消选中"启用运行时主题"或删除Delphi XE中的内部清单？

Question

我有一个我在Delphi XE中构建的组件,我希望以下列方式使用它:

1. 用户创建一个新的空白项目.

2. 用户在表单上删除我的组件.

3. 我的组件中会执行一些特殊的Designtime代码,这将更改项目选项以取消选中项目选项中的"启用运行时主题"复选框.我不确定这是否可能,所以我问是否可能.

如果#3不可能,那么我需要用这个组件解决我的"可用性"问题; 我遇到的问题是,如果用户不通过取消选中启用运行时主题来禁用静态链接的清单文件,那么链接到EXE的静态生成的清单似乎会覆盖我想要在EXE之外的外部清单文件,磁盘.我还需要在运行时修改这些清单,因此需要外部清单.当然,我可以在需要时使用这些清单启用运行时主题功能.第二个问题是关于外部和内部清单的优先级; 当您选中"启用运行时主题"时,外部清单能否以某种方式优先于链接到Delphi应用程序的内部清单资源？

除#3以外的可接受的解决方案:

A.不知何故导致Delphi无法生成清单.B.不知何故,在运行时,Windows会识别外部.manifest文件并确定其优先级,即使找到内部文件也是如此.

C.最不好的解决方案; 在运行时,在我的组件中的CoCreateInstance失败之后,我可以枚举资源,报告外部清单存在并且弄乱我们,并依赖于使用我的组件的开发人员读取我的组件吐出的运行时错误消息,告诉他们禁用运行时主题复选框并重建他们的应用程序 提取和读取清单已在此处的另一个stackoverflow问题中介绍,其中C++代码可以轻松转换为Delphi.

更新接受的答案完全符合我的要求,但被认为是黑客攻击,大卫关于激活上下文的答案更加明智,是推荐的方法.

Update2内置清单通常在更高版本的Delphi(XE5及更高版本)中通过项目设置明确指定要链接的清单来覆盖.

Answer 1

我想我找到了一个有效的解决方案,即你所要求的,即.在创建组件实例时(在表单上删除,或者在IDE中打开包含其实例的表单/模块),从项目选项中禁用运行时主题.这不会阻止用户稍后手动重新启用运行时主题,但它可能对您仍然有用.

BTW,IOTAProjectOptions在这种情况下似乎没有帮助; 它看起来像是IOTAProjectResource需要的.

TestComponentU.pas (运行时包的一部分):

unit TestComponentU;

interface

uses
  Windows, Classes;

type
  ITestComponentDesign = interface
    function DisableRuntimeThemes: Boolean;
  end;

  TTestComponent = class(TComponent)
  public
    constructor Create(AOwner: TComponent); override;
  end;

var
  TestComponentDesign: ITestComponentDesign = nil;

implementation

uses
  Dialogs;

constructor TTestComponent.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if (csDesigning in ComponentState) and Assigned(TestComponentDesign) and
    TestComponentDesign.DisableRuntimeThemes then
    ShowMessage('Project runtime themes disabled');
end;

end.

TestComponentRegU.pas (IDE中安装的设计包的一部分):

unit TestComponentRegU;

interface

procedure Register;

implementation

uses
  Windows, Classes, SysUtils, TestComponentU, ToolsAPI;

type
  TTestComponentDesign = class(TInterfacedObject, ITestComponentDesign)
  public
    function DisableRuntimeThemes: Boolean;
  end;

procedure Register;
begin
  RegisterComponents('Test', [TTestComponent]);
end;

function GetProjectResource(const Project: IOTAProject): IOTAProjectResource;
var
  I: Integer;
begin
  Result := nil;
  if not Assigned(Project) then
    Exit;

  for I := 0 to Project.ModuleFileCount - 1 do
    if Supports(Project.ModuleFileEditors[I], IOTAProjectResource, Result) then
      Break;
end;

function GetProjectResourceHandle(const ProjectResource: IOTAProjectResource; ResType, ResName: PChar): TOTAHandle;
var
  I: Integer;
  ResEntry: IOTAResourceEntry;
begin
  Result := nil;
  if not Assigned(ProjectResource) then
    Exit;

  for I := 0 to ProjectResource.GetEntryCount - 1 do
  begin
    ResEntry := ProjectResource.GetEntry(I);
    if Assigned(ResEntry) and (ResEntry.GetResourceType = ResType) and (ResEntry.GetResourceName = ResName) then
    begin
      Result := ResEntry.GetEntryHandle;
      Break;
    end;
  end;
end;

function DisableProjectRuntimeThemes(const Project: IOTAProject): Boolean;
var
  ProjectResource: IOTAProjectResource;
  ResHandle: TOTAHandle;
begin
  Result := False;
  ProjectResource := GetProjectResource(Project);
  if not Assigned(ProjectResource) then
    Exit;

  ResHandle := GetProjectResourceHandle(ProjectResource, RT_MANIFEST, CREATEPROCESS_MANIFEST_RESOURCE_ID);
  if Assigned(ResHandle) then
  begin
    ProjectResource.DeleteEntry(ResHandle);
    Result := True;
  end;
end;

function TTestComponentDesign.DisableRuntimeThemes: Boolean;
var
  Project: IOTAProject;
begin
  Project := GetActiveProject;
  Result := Assigned(Project) and DisableProjectRuntimeThemes(Project);
end;

initialization
  TestComponentDesign := TTestComponentDesign.Create;

finalization
  TestComponentDesign := nil;

end.

Answer 2

我怀疑最好的解决方案是让组件的用户为他们的应用程序做清单.否则会严重限制此组件的任何用户.

而是使用激活上下文 API在需要时激活组件所需的清单.

您目前在可执行文件目录中编写清单文件的想法听起来非常脆弱,并且无论何时无法写入该目录都可能失败.另一方面,激活上下文API正是您真正需要的,没有任何缺点.