Exploring Delphi XE2 – VCL Styles Part II

December 16, 2011 by Rodrigo | 2 Comments

The TStyleHook Class

The VCL Styles uses the TStyleHook class to intercept the paint methods and the Windows messages related to the Vcl Styles operations, If you have a custom control or need change the way how a control like a TEdit, TMemo, TListView, etc. is painted you must create a new Style hook class inheriting from TStyleHook or using a existing like TEditStyleHook, TComboBoxStyleHook, TMemoStyleHook ans so on . After of creating your own hook you need to register your new style hook class using the RegisterStyleHook method. Also you can unregister a register style hook using the UnRegisterStyleHook procedure.

Check these samples of using custom TStyleHook classes

A Real World Sample

All the above links are about fixing bugs related to the VCL Styles. but that is not all what you can do do with the TStyleHook classes, for example check this image of a TSynEdit component inside of an VCL application with has the Carbon Vcl Style applied.

As you can see the scrollbars are not painted using the selected VCL style. So what I can do? In this case you can write a new style hook class or use an existing hook style. After of quick look for the existing style hook classes in the Vcl.StdCtrls unit, you will discover that the TMemoStyleHook class can do the work.

So writting just one line of code

TStyleManager.Engine.RegisterStyleHook(TCustomSynEdit, TMemoStyleHook);

The magic is done.

A Little of hack

When you need register a style hook using the RegisterStyleHook method, if you try to register the same hook class twice, an EStyleEngineException will be raised, So before to try to register a new hook class you must check if is the hook is already registered for a specific control or use a place like the initialization part of a unit to register the hooks . Unfortunally great part of the VCL styles logic and the collections containing the registered style hooks, is contained in sealed classes, strict private vars and strict private static classes. So that information is not accesible directly. Because that tasks how list the registered hooks, check if a hook has previously registered or if a class has a register style hook is not a trivial task.

The TCustomStyleEngine class (of the Vcl.Themes unit) has a strict protected class property called RegisteredStyleHooks this property points to a TDictionary declarated (as a private type) like this

    TStyleHookList = TList<TStyleHookClass>;
    TStyleHookDictionary = TDictionary<TClass, TStyleHookList>;

The info contained in this property is very usefull, but due to his visibility (strict protected class property) you need to use a hack to extract such info.

So using a helper class for the TCustomStyleEngine class you can gain access to the TDictionary with the registered hooks

type
  TStyleHookList = TList<TStyleHookClass>;  //you must need declare this type again because are declarated in the private section of the TCustomStyleEngine and are not visible
  TStyleHookDictionary = TDictionary<TClass, TStyleHookList>;//you must need declare this type again because are declarated in the private section of the TCustomStyleEngine and are not visible
  TCustomStyleEngineHelper = Class Helper for TCustomStyleEngine
  public
    class function GetRegisteredStyleHooks : TStyleHookDictionary;
  end;

And now using this helper class you can construct additional functions to work with the Style hooks.

Procedure ApplyEmptyVCLStyleHook(ControlClass :TClass); 
Procedure RemoveEmptyVCLStyleHook(ControlClass :TClass);
function  IsStyleHookRegistered(ControlClass: TClass; StyleHookClass: TStyleHookClass) : Boolean;
function  GetRegisteredStylesHooks(ControlClass: TClass) : TStyleHookList;

Using these functions you can list all the registerd style hooks in the system like so

var
 RttiType  : TRttiType;
 Item      : TListItem;
 List      : TStyleHookList;
 StyleClass: TStyleHookClass;
begin
  for RttiType in TRttiContext.Create.GetTypes do
    if RttiType.IsInstance and RttiType.AsInstance.MetaclassType.InheritsFrom(TComponent) then
    begin
       List:=GetRegisteredStylesHooks(RttiType.AsInstance.MetaclassType);
       if Assigned(List) then
       begin
         Item:=ListViewStyleHooks.Items.Add;
         Item.Caption:=RttiType.Name;

         for StyleClass in List do
          Item.SubItems.Add(StyleClass.ClassName);
       end;
    end;
end;

This is the code of the unit containing all the above code

unit uVCLStyleUtils;

interface

Uses
  Vcl.Themes,
  Vcl.Styles,
  Generics.Collections,
  Classes;

type
  TStyleHookList = TList<TStyleHookClass>;

Procedure ApplyEmptyVCLStyleHook(ControlClass :TClass);
Procedure RemoveEmptyVCLStyleHook(ControlClass :TClass);
function  IsStyleHookRegistered(ControlClass: TClass; StyleHookClass: TStyleHookClass) : Boolean;
function  GetRegisteredStylesHooks(ControlClass: TClass) : TStyleHookList;

implementation

uses
 Sysutils;

type
  TStyleHookDictionary = TDictionary<TClass, TStyleHookList>;
  TCustomStyleEngineHelper = Class Helper for TCustomStyleEngine
  public
    class function GetRegisteredStyleHooks : TStyleHookDictionary;
  end;


class function TCustomStyleEngineHelper.GetRegisteredStyleHooks: TStyleHookDictionary;
begin
  Result:= Self.FRegisteredStyleHooks;
end;

function  IsStyleHookRegistered(ControlClass: TClass; StyleHookClass: TStyleHookClass) : Boolean;
var
  List : TStyleHookList;
begin
 Result:=False;
    if TCustomStyleEngine.GetRegisteredStyleHooks.ContainsKey(ControlClass) then
    begin
      List := TCustomStyleEngine.GetRegisteredStyleHooks[ControlClass];
      Result:=List.IndexOf(StyleHookClass) <> -1;
    end;
end;

function  GetRegisteredStylesHooks(ControlClass: TClass) : TStyleHookList;
begin
 Result:=nil;
    if TCustomStyleEngine.GetRegisteredStyleHooks.ContainsKey(ControlClass) then
      Result:=TCustomStyleEngine.GetRegisteredStyleHooks[ControlClass];
end;

Procedure ApplyEmptyVCLStyleHook(ControlClass :TClass);
begin
   if not IsStyleHookRegistered(ControlClass, TStyleHook) then
    TStyleManager.Engine.RegisterStyleHook(ControlClass, TStyleHook);
end;

Procedure RemoveEmptyVCLStyleHook(ControlClass :TClass);
begin
   if IsStyleHookRegistered(ControlClass, TStyleHook) then
    TStyleManager.Engine.UnRegisterStyleHook(ControlClass, TStyleHook);
end;


end.