delphi - 是否可以通过在运行时添加应用程序 list 来执行 **运行时主题** 的运行时可选切换？

Question

Possible Duplicate:
How to switch an Application between Themed and not Themed at run-time?

我创建了一个 GUI 应用程序，其运行时主题选项设置为未启用，并且需要在应用程序初始化期间手动启用嵌入式 list 的选项。

问题:

VCL 是否允许扩展点来实现它？

让我解释一下:

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

我深入研究了 Forms.TApplication，希望找到一个句柄，但没有发现任何有趣的方向。

Answer 1

我会反过来做。我将通过在项目设置中启用运行时主题来包含标准 comctl v6 list 。然后我会打电话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.

您需要确保 UxTheme 位于 .dpr 使用子句中，或者最好将该函数移至其自己的专用单元。

像平常一样包含 list 然后禁用运行时主题会更容易。启用运行时主题的替代方案涉及激活上下文，这比这种方法更复杂。

<小时/>

话虽如此，它比使用激活上下文更容易，但我决定看看其中涉及什么。这就是我的想法:

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.

您应该尽早将此单元包含在您的 .dpr 文件中。在任何内存管理器之后，但在任何 RTL/VCL 单元之前。在项目设置中将运行时主题设置为无。您可能希望将 list 文件作为资源包含在内，但为了方便起见，我已将其作为文件在这里完成。