Question

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

I create a GUI App with runtime themes option set to not enabled and need the option to manually enable an embedded Manifest during App initialization.

Question:

Does the VCL allow an extension point to implement that?

Let me explain:

• The custom Manifest is embedded in the binary as a string constant.
• Runtime themes is enabled using command line parameter switch, e.g.: MyApp.exe -themeOn

I have delved into Forms.TApplication in hope to find a handle but found nothing of interest pointing to a direction to go.

Answer 1

I would do this the other way around. I would include the standard comctl v6 manifest by enabling runtime themes in the project settings. Then I would call SetThemeAppProperties at startup, from the .dpr file, to disable runtime themes if necessary.

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.

You’ll need to make sure that UxTheme is in the .dpr uses clause, or even better move that function to its own dedicated unit.

It’s easier to include the manifest as normal and then disable runtime themes. The alternative of enabling runtime themes involves activation contexts which is rather more involved than this approach.

---

Having said it was easier than using the activation context, I decided to see what was involved in that. And here’s what I came up with:

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.

You should include this unit as early as possible in your .dpr file. After any memory managers, but before any RTL/VCL units. Set runtime themes to None in the project settings. You’d probably want to include the manifest file as a resource, but I’ve done it as a file here for my convenience.