The Road to Delphi – a Blog about programming

Delphi – Free Pascal – Oxygene

Exploring Delphi XE2 – VCL Styles Part II

10 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.

Download a sample application with the full sourcecode from here.

About these ads

Author: Rodrigo

Just another Delphi guy.

10 thoughts on “Exploring Delphi XE2 – VCL Styles Part II

  1. Pingback: RAD Studio XE2 정보 모음

  2. Pingback: Changing the color of Edit Controls with VCL Styles Enabled « The Road to Delphi – a Blog about programming

  3. downloaded code for “Object Packages Enable Highly Modular Applications”
    from James Heyworth Objective Software Technology
    it works with delphi 2009 but with not with delphi xe2.

    when the plugin package is loaded the first time it works ok,
    but as soon as I unload de plugin BPL it will complain with
    this message “Class ‘TMemoStyleHook’ is already registered for ‘TMemo’ ”
    I suspect that this problem is related to the vcl.Themes api in XE2
    It is not unregistering the HookClass for the Components in the form?
    How can I unregistrer the Hook Classes in order to load the Plugin BPLs
    with out any errors?

    source code found in

    http://www.obsof.com/public/download.html

    http://www.obsof.com/public/DL613.zip

    Best Regards,
    Arturo Ruvalcaba

  4. Rodrigo,

    Exelente tu trabajo! !

    Pero, quisiera saber como hago para cambiar solo una forma y deshabilitar el style en esa específicamente.

    Estoy usando Delphi XE4 y en la forma que quiero desactivar, estoy poniendo en la creación: StyleElements:=[] pero no funciona;

    Traté de hacer el cambio con TStyleManager.TrySetStyle, pero no es el efecto que busco.

    La forma es una especie de ventana de información, pero toda la aplicación tiene un Style definido.

    Saludos y gracias.

  5. Hola Rodrigo, mi pregunta es a la inversa, cómo se puede hacer para aplicar estilo a un solo form, en lugar de a todos los forms de la aplicación?. Ej. el form donde se testea cada estilo

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Follow

Get every new post delivered to your Inbox.

Join 586 other followers