>用户创建一个新的空白项目.
>用户将我的组件放在窗体上.
>我的组件中的一些特殊的Designtime代码被执行,这将改变项目选项以取消选中项目选项中的“启用运行时主题”复选框.我不知道这是甚么可能的,所以我问是否有可能.
如果#3是不可能的,那么我需要另一个解决方案来解决这个组件的“可用性”问题.我的问题是,如果用户不通过取消选中启用运行时主题来禁用静态链接的清单文件,那么链接到EXE中的静态生成的清单似乎覆盖了我想在EXE之外的外部清单文件,磁盘.我还需要在运行时修改这些清单,因此需要外部清单.当然,当需要这样做时,我可以使用这些清单启用运行时主题功能.第二个问题是外部和内部清单的优先级;当您检查“启用运行时主题”时,可以将外部清单优先于链接到Delphi应用程序的内部清单资源吗？
3号以外可接受的解决方案：
不知何故导致Delphi不生成清单.
B.不知何故在运行时,即使找到内部文件,Windows也可以识别和优先考虑外部的.manifest文件.
C.最好的解决方案在运行时,在我的组件中的CoCreateInstance失败之后,我可以枚举资源,报告外部清单存在,并且使我们陷入困境,并依赖使用我的组件的开发人员读取我的组件抛出的运行时错误消息,告诉他们禁用运行时主题复选框并重建其应用程序.另一个stackoverflow问题here已经涵盖了提取和读取清单,C代码可以很容易地转换为Delphi.
更新接受的答案完全是我所问的,但被认为是一个黑客,而David关于激活上下文的答案更为理智,而且是推荐的方法.
Update2通过在项目设置中明确指定要链接的清单,通常会在更高版本的Delphi(XE5和更高版本)中覆盖内置清单.
解决方法
这并不妨碍用户稍后手动重新启用运行时主题,但也许对您来说仍然有用.
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.