通过在运行时添加应用程序清单,可以对运行时主题进行运行时可选的切换吗?

men*_*raz 1 delphi themes manifest

可能重复:
如何在运行时在主题与非主题之间切换应用程序?

我创建的GUI App的运行时主题选项设置为未启用,需要该选项在App初始化期间手动启用嵌入式清单。

题:

VCL是否允许扩展点实现这一点?

让我解释:

  • 定制清单作为字符串常量嵌入在二进制文件中。
  • 使用命令行参数开关启用运行时主题,例如: MyApp.exe -themeOn

我已经深入研究Forms.TApplication,希望找到一个句柄,但没有找到指向该方向的有趣内容。

Dav*_*nan 5

我会反过来做。我将通过在项目设置中启用运行时主题来包括标准comctl v6清单。然后SetThemeAppProperties,如果需要,我将在启动时从.dpr文件调用以禁用运行时主题。

procedure DisableRuntimeThemes;
begin
  InitThemeLibrary;
  if Assigned(SetThemeAppProperties) then
    SetThemeAppProperties(STAP_ALLOW_NONCLIENT);
end;

begin
  if not FindCmdLineSwitch('themeOn') then
    DisableRuntimeThemes;
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TMainForm, MainForm);
  Application.Run;
end.
Run Code Online (Sandbox Code Playgroud)

您需要确保它UxTheme在.dpr使用子句中,或者甚至更好地将该函数移到其自己的专用单元中。

像平常一样包含清单,然后禁用运行时主题会更容易。启用运行时主题的替代方法涉及激活上下文,而激活上下文要比该方法涉及更多。


说了比使用激活上下文要容易的多,我决定看看其中涉及的内容。这是我想出的:

unit ActivateRuntimeThemes;

interface

implementation

uses
  Windows, SysUtils;

type
  TActivationContext = class
  private
    FActCtxHandle: THandle;
    FCreateActCtx: function(var pActCtx: TActCtx): THandle; stdcall;
    FActivateActCtx: function(hActCtx: THandle; var lpCookie: LongWord): BOOL; stdcall;
    FDeactivateActCtx: function(dwFlags: DWORD; ulCookie: LongWord): BOOL; stdcall;
    FReleaseActCtx: procedure(hActCtx: THandle); stdcall;
    FCookie: LongWord;
    FSucceeded: Boolean;
  public
    constructor Create;
    destructor Destroy; override;
  end;

constructor TActivationContext.Create;
var
  ActCtx: TActCtx;
  hKernel32: HMODULE;
begin
  inherited;
  hKernel32 := GetModuleHandle(kernel32);
  FCreateActCtx := GetProcAddress(hKernel32, 'CreateActCtxW');
  if Assigned(FCreateActCtx) then
  begin
    FReleaseActCtx := GetProcAddress(hKernel32, 'ReleaseActCtx');
    FActivateActCtx := GetProcAddress(hKernel32, 'ActivateActCtx');
    FDeactivateActCtx := GetProcAddress(hKernel32, 'DeactivateActCtx');
    ZeroMemory(@ActCtx, SizeOf(ActCtx));
    ActCtx.cbSize := SizeOf(ActCtx);
    ActCtx.lpSource := 'C:\desktop\comctlv6.manifest.txt';
    FActCtxHandle := FCreateActCtx(ActCtx);
    FSucceeded := (FActCtxHandle<>INVALID_HANDLE_VALUE) and FActivateActCtx(FActCtxHandle, FCookie);
  end
  else
    FActCtxHandle := INVALID_HANDLE_VALUE;
end;

destructor TActivationContext.Destroy;
begin
  if FSucceeded then
    FDeactivateActCtx(0, FCookie);
  if FActCtxHandle<>INVALID_HANDLE_VALUE then
    FReleaseActCtx(FActCtxHandle);
  inherited;
end;

var
  ActivationContext: TActivationContext;

procedure FinaliseActivationContext;
begin
  ActivationContext.Free;
end;

initialization
  if FindCmdLineSwitch('themeOn') then
    ActivationContext := TActivationContext.Create;

finalization
  ActivationContext.Free;

end.
Run Code Online (Sandbox Code Playgroud)

您应尽早在.dpr文件中包含此单元。在任何内存管理器之后,但在任何RTL / VCL单元之前。在项目设置中将运行时主题设置为“ ”。您可能希望将清单文件包含为资源,但是为了方便起见,我在此处将其作为文件包含在内。