A few weeks ago a fellow Delphi developer ask me via email about a workaround for a bug in the TButton component, when the ImageAlignment property has a value different than iaLeft (btw I just submit this bug to Quality Central).
Tipically when you uses this property in a TButton without a Vcl Style applied you had a result like this.

Now if you apply any VCL Style, this is the result

As you can see the images are not aligned properly. This is due which the TButtonStyleHook class (used by the TButton component) ignore the value of the ImageAlignment property. So to fix that we must patch the code of the Paint method TButtonStyleHook style hook.

Check the next code for a workaround

Uses
 Winapi.CommCtrl,
 Vcl.Themes,
 Vcl.Styles;

type
  TCustomButtonH=class(TCustomButton);

  //we need this helper to access some strict private fields
  TButtonStyleHookHelper = class Helper for TButtonStyleHook
  protected
   function Pressed : Boolean;
   function DropDown: Boolean;
  end;
  
  //to avoid writting a lot of extra code we are to use TButtonStyleHook class and override the paint method
  TButtonStyleHookFix = class(TButtonStyleHook)
  protected
    procedure Paint(Canvas: TCanvas); override;
  end;


{ TButtonStyleHookFix }

procedure TButtonStyleHookFix.Paint(Canvas: TCanvas);
var
  LDetails          : TThemedElementDetails;
  DrawRect          : TRect;
  pbuttonImagelist  : BUTTON_IMAGELIST;
  IW, IH, IY        : Integer;
  LTextFormatFlags  : TTextFormatFlags;
  ThemeTextColor    : TColor;
  Buffer            : string;
  BufferLength      : Integer;
  SaveIndex         : Integer;
  X, Y, I           : Integer;
  BCaption          : String;
begin

  if StyleServices.Available then
  begin
    BCaption := Text;
    if Pressed then
      LDetails := StyleServices.GetElementDetails(tbPushButtonPressed)
    else
    if MouseInControl then
      LDetails := StyleServices.GetElementDetails(tbPushButtonHot)
    else
    if Focused then
      LDetails := StyleServices.GetElementDetails(tbPushButtonDefaulted)
    else
    if Control.Enabled then
      LDetails := StyleServices.GetElementDetails(tbPushButtonNormal)
    else
      LDetails := StyleServices.GetElementDetails(tbPushButtonDisabled);

    DrawRect := Control.ClientRect;
    StyleServices.DrawElement(Canvas.Handle, LDetails, DrawRect);

    if Button_GetImageList(handle, pbuttonImagelist) and (pbuttonImagelist.himl <> 0) and ImageList_GetIconSize(pbuttonImagelist.himl, IW, IH) then
    begin
      if (GetWindowLong(Handle, GWL_STYLE) and BS_COMMANDLINK) = BS_COMMANDLINK then
        IY := DrawRect.Top + 15
      else
        IY := DrawRect.Top + (DrawRect.Height - IH) div 2;

      //here the image is drawn properly according to the ImageAlignment value
      case TCustomButton(Control).ImageAlignment of
        iaLeft  :
                  begin
                    ImageList_Draw(pbuttonImagelist.himl, 0, Canvas.Handle, DrawRect.Left + 3, IY, ILD_NORMAL);
                    Inc(DrawRect.Left, IW + 3);
                  end;
        iaRight :
                  begin
                    ImageList_Draw(pbuttonImagelist.himl, 0, Canvas.Handle, DrawRect.Right - IW -3, IY, ILD_NORMAL);
                    Dec(DrawRect.Right, IW - 3);
                  end;

        iaCenter:
                  begin
                   ImageList_Draw(pbuttonImagelist.himl, 0, Canvas.Handle, (DrawRect.Right - IW) div 2, IY, ILD_NORMAL);
                  end;


        iaTop   :
                  begin
                   ImageList_Draw(pbuttonImagelist.himl, 0, Canvas.Handle, (DrawRect.Right - IW) div 2, 3, ILD_NORMAL);
                  end;


        iaBottom:
                  begin
                   ImageList_Draw(pbuttonImagelist.himl, 0, Canvas.Handle, (DrawRect.Right - IW) div 2, (DrawRect.Height - IH) - 3, ILD_NORMAL);
                  end;

      end;


    end;

    if (GetWindowLong(Handle, GWL_STYLE) and BS_COMMANDLINK) = BS_COMMANDLINK then
    begin
      if pbuttonImagelist.himl = 0 then
        Inc(DrawRect.Left, 35);

      Inc(DrawRect.Top, 15);
      Inc(DrawRect.Left, 5);
      Canvas.Font := TCustomButtonH(Control).Font;
      Canvas.Font.Style := [];
      Canvas.Font.Size := 12;
      LTextFormatFlags := TTextFormatFlags(DT_LEFT);
      if StyleServices.GetElementColor(LDetails, ecTextColor, ThemeTextColor) then
         Canvas.Font.Color := ThemeTextColor;
      StyleServices.DrawText(Canvas.Handle, LDetails, BCaption, DrawRect, LTextFormatFlags, Canvas.Font.Color);
      SetLength(Buffer, Button_GetNoteLength(Handle) + 1);
      if Length(Buffer) <> 0 then
      begin
        BufferLength := Length(Buffer);
        if Button_GetNote(Handle, PChar(Buffer), BufferLength) then
        begin
          LTextFormatFlags := TTextFormatFlags(DT_LEFT or DT_WORDBREAK);
          Inc(DrawRect.Top, Canvas.TextHeight('Wq') + 2);
          Canvas.Font.Size := 8;
          StyleServices.DrawText(Canvas.Handle, LDetails, Buffer, DrawRect,
            LTextFormatFlags, Canvas.Font.Color);
        end;
      end;

      if pbuttonImagelist.himl = 0 then
      begin
        if Pressed then
          LDetails := StyleServices.GetElementDetails(tbCommandLinkGlyphPressed)
        else if MouseInControl then
          LDetails := StyleServices.GetElementDetails(tbCommandLinkGlyphHot)
        else if Control.Enabled then
          LDetails := StyleServices.GetElementDetails(tbCommandLinkGlyphNormal)
        else
          LDetails := StyleServices.GetElementDetails(tbCommandLinkGlyphDisabled);
        DrawRect.Right := 35;
        DrawRect.Left := 3;
        DrawRect.Top := 10;
        DrawRect.Bottom := DrawRect.Top + 32;
        StyleServices.DrawElement(Canvas.Handle, LDetails, DrawRect);
      end;

    end
    else
    if (GetWindowLong(Handle, GWL_STYLE) and BS_SPLITBUTTON) = BS_SPLITBUTTON then
    begin
      Dec(DrawRect.Right, 15);
      DrawControlText(Canvas, LDetails, Text, DrawRect, DT_VCENTER or DT_CENTER);
      if DropDown then
      begin
        LDetails := StyleServices.GetElementDetails(tbPushButtonPressed);
        SaveIndex := SaveDC(Canvas.Handle);
        try
          IntersectClipRect(Canvas.Handle, Control.Width - 15, 0,
            Control.Width, Control.Height);
          DrawRect := Rect(Control.Width - 30, 0, Control.Width, Control.Height);
          StyleServices.DrawElement(Canvas.Handle, LDetails, DrawRect);
        finally
          RestoreDC(Canvas.Handle, SaveIndex);
        end;
      end;

      with Canvas do
      begin
        Pen.Color := StyleServices.GetSystemColor(clBtnShadow);
        MoveTo(Control.Width - 15, 3);
        LineTo(Control.Width - 15, Control.Height - 3);
        if Control.Enabled then
          Pen.Color := StyleServices.GetSystemColor(clBtnHighLight)
        else
          Pen.Color := Font.Color;
        MoveTo(Control.Width - 14, 3);
        LineTo(Control.Width - 14, Control.Height - 3);
        Pen.Color := Font.Color;
        X := Control.Width - 8;
        Y := Control.Height div 2 + 1;
        for i := 3 downto 0 do
        begin
          MoveTo(X - I, Y - I);
          LineTo(X + I + 1, Y - I);
        end;
      end;

    end
    else
    begin
      //finally the text is aligned and drawn depending of the value of the ImageAlignment property
      case TCustomButton(Control).ImageAlignment of
        iaLeft,
        iaRight,
        iaCenter : DrawControlText(Canvas, LDetails, BCaption, DrawRect, DT_VCENTER or DT_CENTER);
        iaBottom : DrawControlText(Canvas, LDetails, BCaption, DrawRect, DT_TOP or DT_CENTER);
        iaTop    : DrawControlText(Canvas, LDetails, BCaption, DrawRect, DT_BOTTOM or DT_CENTER);
      end;
    end;
  end;
end;

{ TButtonStyleHookHelper }

function TButtonStyleHookHelper.DropDown: Boolean;
begin
  Result:=Self.FDropDown;
end;

function TButtonStyleHookHelper.Pressed: Boolean;
begin
  Result:=Self.FPressed;
end;

And this is the result after of aply the above style hook

TStyleManager.Engine.RegisterStyleHook(TButton, TButtonStyleHookFix);

Today I receive a question about how disable the vcl styles in the non client area of a vcl form. Well that can be done using a Style hook.

Tipically a VCL form with a vcl style look like this

To remove the vcl style in the non client are we need create a style hook which descend of the TMouseTrackControlStyleHook and then override the PaintBackground and Create methods.

Check this sample code

  TFormStyleHookNC= class(TMouseTrackControlStyleHook)
  protected
    procedure PaintBackground(Canvas: TCanvas); override;
    constructor Create(AControl: TWinControl); override;
  end;

constructor TFormStyleHookNC.Create(AControl: TWinControl);
begin
  inherited;
  OverrideEraseBkgnd := True;
end;

procedure TFormStyleHookNC.PaintBackground(Canvas: TCanvas);
var
  Details: TThemedElementDetails;
  R: TRect;
begin
  if StyleServices.Available then
  begin
    Details.Element := teWindow;
    Details.Part := 0;
    R := Rect(0, 0, Control.ClientWidth, Control.ClientHeight);
    StyleServices.DrawElement(Canvas.Handle, Details, R);
  end;
end;

And apply in this way

TStyleManager.Engine.RegisterStyleHook(TForm1, TFormStyleHookNC);

After of that this is the result

The Issue

The last weeks I found a couple questions and QC reports(100645, 101822, 102984) regarding to how change the color of a Edit Control (TEdit, TMaskEdit, TMemo and so on) when the VCL Styles are enabled. So today I will show you how you can change the colors of these controls even with the VCL Styles activated.

In a Standard VCL Form application you can change the Color property of Edit controls

But when the Vcl Styles Are applied these colors are not used, and the controls are painted using the colors of the current VCl Style.

The Solution

So what is the solution? well the answer is : Create a new TStyleHook (read this article to learn more about Style Hooks) . All the TWinControls uses a TStyleHook to paint the control when the vcl styles are actived, so you can modify the TStyleHook of a particular control to modify the way of how the component is painted.

Implementation

Before to implement a Custom Style hook you must be aware which this new TStyleHook will affect to all the controls of the same type used in the RegisterStyleHook method, because the Style hooks are implemented for a particular class type and not for an instance.

First let’s create a style hook for the TCustomEdit descendents, using the TEditStyleHook class, this new style hook can be used with controls like TEdit, TMaskEdit, TLabeledEdit and so on.

Check the next commented code

  TEditStyleHookColor = class(TEditStyleHook)
  private
    procedure UpdateColors;
  protected
    procedure WndProc(var Message: TMessage); override;
  public
    constructor Create(AControl: TWinControl); override;
  end;

uses
  Vcl.Styles;

type
 TWinControlH= class(TWinControl);

constructor TEditStyleHookColor.Create(AControl: TWinControl);
begin
  inherited;
  //call the UpdateColors method to use the custom colors
  UpdateColors;
end;

//Here you set the colors of the style hook
procedure TEditStyleHookColor.UpdateColors;
var
  LStyle: TCustomStyleServices;
begin
 if Control.Enabled then
 begin
  Brush.Color := TWinControlH(Control).Color; //use the Control color
  FontColor   := TWinControlH(Control).Font.Color;//use the Control font color
 end
 else
 begin
  //if the control is disabled use the colors of the style
  LStyle := StyleServices;
  Brush.Color := LStyle.GetStyleColor(scEditDisabled);
  FontColor := LStyle.GetStyleFontColor(sfEditBoxTextDisabled);
 end;
end;

//Handle the messages of the control
procedure TEditStyleHookColor.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    CN_CTLCOLORMSGBOX..CN_CTLCOLORSTATIC:
      begin
        //Get the colors
        UpdateColors;
        SetTextColor(Message.WParam, ColorToRGB(FontColor));
        SetBkColor(Message.WParam, ColorToRGB(Brush.Color));
        Message.Result := LRESULT(Brush.Handle);
        Handled := True;
      end;
    CM_ENABLEDCHANGED:
      begin
        //Get the colors
        UpdateColors;
        Handled := False;
      end
  else
    inherited WndProc(Message);
  end;
end;

Now a style hook for the TCustomMemo using the TMemoStyleHook class.

  TMemoStyleHookColor = class(TMemoStyleHook)
  private
    procedure UpdateColors;
  protected
    procedure WndProc(var Message: TMessage); override;
  public
    constructor Create(AControl: TWinControl); override;
  end;

constructor TMemoStyleHookColor.Create(AControl: TWinControl);
begin
  inherited;
  //call the UpdateColors method to use the custom colors
  UpdateColors;
end;

//Set the colors to be used by the Style hook
procedure TMemoStyleHookColor.UpdateColors;
var
  LStyle: TCustomStyleServices;
begin
 if Control.Enabled then
 begin
  Brush.Color := TWinControlH(Control).Color;
  FontColor   := TWinControlH(Control).Font.Color;
 end
 else
 begin
  //if the control is disabled use the current style colors
  LStyle := StyleServices;
  Brush.Color := LStyle.GetStyleColor(scEditDisabled);
  FontColor := LStyle.GetStyleFontColor(sfEditBoxTextDisabled);
 end;
end;

//handle the messages
procedure TMemoStyleHookColor.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    CN_CTLCOLORMSGBOX..CN_CTLCOLORSTATIC:
      begin
        //get the colors
        UpdateColors;
        SetTextColor(Message.WParam, ColorToRGB(FontColor));
        SetBkColor(Message.WParam, ColorToRGB(Brush.Color));
        Message.Result := LRESULT(Brush.Handle);
        Handled := True;
      end;

    CM_COLORCHANGED,
    CM_ENABLEDCHANGED:
      begin
        //get the colors
        UpdateColors;
        Handled := False;
      end
  else
    inherited WndProc(Message);
  end;
end;

Finally to apply the above code you must call the TStyleManager.Engine.RegisterStyleHook method in this way (ideally in the initialization part of you unit)

 TStyleManager.Engine.RegisterStyleHook(TEdit, TEditStyleHookColor);
 TStyleManager.Engine.RegisterStyleHook(TMaskEdit, TEditStyleHookColor);
 TStyleManager.Engine.RegisterStyleHook(TLabeledEdit, TEditStyleHookColor);
 TStyleManager.Engine.RegisterStyleHook(TButtonedEdit, TEditStyleHookColor);

 TStyleManager.Engine.RegisterStyleHook(TMemo, TMemoStyleHookColor);

Trick : If you only want apply these new hooks to the controls of a particular form, you can use a interposer class in the begining of your unit

type
  TEdit= Class (Vcl.StdCtrls.TEdit);
  TMemo= Class (Vcl.StdCtrls.TMemo);
  TButtonedEdit= Class (Vcl.ExtCtrls.TButtonedEdit);
  TLabeledEdit= Class (Vcl.ExtCtrls.TLabeledEdit);

The final result

Now look how the forms with the vcl styles can have custom colors in the Edit controls

Check the full source code on Github.

In the past days I’ve added many new features and a lot of improvements in the VCL Style Utils project. You can see the updated siteand a new video showing the VCL Style Utils library in action, also the repository contains a set of demo projects to check how use the library.

Check this video of an Demo app.

I just uploaded a video showing how you can change the HSL values of any VCL Style in runtime using the VCL Styles Utils library. in the code google site you can found the the full source code of the application and more demo projects.

Update : this project now is hosted on Github.

Introduction

The VCL Styles are great but it seems that was designed to hide (and protect?) a lot of useful properties and classes. Because that I wrote a small (for the moment) library that using class helpers (and another tricks) can access to hidden properties and classes of the VCL Styles. Today I will show you how using this library you can create a previewer for your vcl styles.

When you design a GUI and include the option to change the current VCL Style of an application you generally provide a list of the availables VCL Styles, then the user without knowing nothing about the appearance of the style must choose one and then apply the changes. Well you can improve the user experience showing a preview image of the VCL style before to apply the selection.

Check out this sample image of a settings option of the WDCC, that shows a preview of the VCL Styles.

The internals

The TStyleManager class contains an internal collection with all the registered (loaded) styles, this list is stored in a Dictionary class var like this FRegisteredStyles: TDictionary; and each TPair contains the style name and a TSourceInfo value.

This is the definition of the TSourceInfo type

TStyleServicesHandle = type Pointer;
  strict private type
    TSourceInfo = record
      Data: TStyleServicesHandle;
      StyleClass: TCustomStyleServicesClass;
    end;

The Data field point to a TStream that contains all the objects and bitmaps related to the style and the StyleClass field has the type of the class Style Service. Now in order to access the visual elements of the style we need interpret the content of the Data field. The logic to interpret the streams with the VCL style info is placed in two files StyleUtils.inc and StyleAPI.inc, these files are in the source\vcl folder of your Rad Studio installation. As probably you must know these files are not units and are embedded in the implementation part of the Vcl.Styles unit, because that the classes and methods of these files are not accesible in any way (for now).

Note : The StyleUtils.inc and StyleAPI.inc files contains code that originally was part of the SkineEngine library of Eugene A. Kryukov (Yeah Eugene is the original author of the DXScene the antecesor of FireMonkey).

Accesing the TSourceInfo

The first task is gain access to the class var FRegisteredStyles of the TStyleManager class. So using a class helper we can do the trick.

  //we need redeclare these types because are defined as <em>strict private</em> types inside of the <em>TStyleManager </em>class and are not accesible of outside.
  TStyleServicesHandle = type Pointer;
  TSourceInfo = record
    Data: TStyleServicesHandle;
    StyleClass: TCustomStyleServicesClass;
  end;
   
  //the class helper
  TStyleManagerHelper = Class Helper for TStyleManager
  strict private
    class function GetStyleSourceInfo(const StyleName: string): TSourceInfo; static;
  public
   class function GetRegisteredStyles: TDictionary<string, TSourceInfo>;
   class property StyleSourceInfo[const StyleName: string]: TSourceInfo read GetStyleSourceInfo;
  end;

class function TStyleManagerHelper.GetRegisteredStyles: TDictionary<string, TSourceInfo>;
var
  t            : TPair<string, TStyleManager.TSourceInfo>;
  SourceInfo   : TSourceInfo;
begin
 Result:=TDictionary<string, TSourceInfo>.Create;
  for t in Self.FRegisteredStyles do
  begin
   SourceInfo.Data:=t.Value.Data;
   SourceInfo.StyleClass:=t.Value.StyleClass;
   Result.Add(t.Key,SourceInfo);
  end;
end;

class function TStyleManagerHelper.GetStyleSourceInfo(const StyleName: string): TSourceInfo;
Var
 LRegisteredStyles : TDictionary<string, TSourceInfo>;
begin
  LRegisteredStyles:=TStyleManager.GetRegisteredStyles;
  try
    if LRegisteredStyles.ContainsKey(StyleName) then
      Result:=LRegisteredStyles[StyleName];
  finally
     LRegisteredStyles.Free;
  end;
end;

So in this point we have access to the TSourceInfo of each registered style. Now we can use the above class helper in this way

var
  SourceInfo: TSourceInfo;
begin
  SourceInfo:=TStyleManager.StyleSourceInfo[StyleName];
  //do something 
end;

Writting a TCustomStyle

The second part of the task is interpret the stream stored in TSourceInfo.Data, to do this we need create a TCustomStyle descendant class and use the code of the StyleUtils.inc and StyleAPI.inc files. The TCustomStyle class has a private field FSource: TObject; that store the VCL Style content (objects, fonts, colors, bitmaps and so on) this field must be filled with the content of the Stream stored in the TSourceInfo.Data. After of that you will have a new Style Class ready to use as you want.

This is the definiton of the TCustomStyleExt class.

type
  TCustomStyleHelper = Class Helper for TCustomStyle
  private
    function GetSource: TObject;
  public
    property Source: TObject read GetSource;
  End;

  TCustomStyleExt = class(TCustomStyle)
  strict private
    FStream    : TStream;
  public
    function  GetStyleInfo : TStyleInfo;
  public
    constructor Create(const FileName :string);overload;
    constructor Create(const Stream:TStream);overload;
    destructor Destroy;override;
    property StyleInfo : TStyleInfo read GetStyleInfo;
  end;

//we need include this files in the implemnetation part to use the TseStyle class
{$I 'C:\Program Files (x86)\Embarcadero\RAD Studio\9.0\source\vcl\StyleUtils.inc'}
{$I 'C:\Program Files (x86)\Embarcadero\RAD Studio\9.0\source\vcl\StyleAPI.inc'}

//Gain acess to the FSource field of the TCustomStyle
function TCustomStyleHelper.GetSource: TObject;
begin
  Result:=Self.FSource;
end;

//with this constructor we can load a Vcl Style file, without register in the system
constructor TCustomStyleExt.Create(const FileName: string);
var
  LStream: TFileStream;
begin
  LStream := TFileStream.Create(FileName, fmOpenRead);
  try
    Create(LStream);
  finally
    LStream.Free;
  end;
end;

//Load an stream with the Vcl Style Data
constructor TCustomStyleExt.Create(const Stream: TStream);
begin
  inherited Create;
  FStream:=TMemoryStream.Create;

  Stream.Seek(0, soBeginning); //set position to 0 before to copy
  FStream.CopyFrom(Stream, Stream.Size); //copy the content in a local stream
  Stream.Seek(0, soBeginning); //very importan restore the index to 0.

  FStream.Seek(0, soBeginning);//set position to 0 before to load
  TseStyle(Source).LoadFromStream(FStream);//makes the magic, fill the 
end;

//free the resources
destructor TCustomStyleExt.Destroy;
begin
  if Assigned(FStream) then
    FStream.Free;
  inherited Destroy;
end;

//Get misc info about the Vcl Style
function TCustomStyleExt.GetStyleInfo: TStyleInfo;
begin
 Result.Name        :=  TseStyle(Source).StyleSource.Name;
 Result.Author      :=  TseStyle(Source).StyleSource.Author;
 Result.AuthorEMail :=  TseStyle(Source).StyleSource.AuthorEMail;
 Result.AuthorURL   :=  TseStyle(Source).StyleSource.AuthorURL;
 Result.Version     :=  TseStyle(Source).StyleSource.Version;
end;

Creating the preview

Finally now we can create a image that represent the VCL Style.

Check out the code to create a simple image of a form using a TCustomStyle.

//draws a form (window) over a Canvas using a TCustomStyle
procedure DrawSampleWindow(Style:TCustomStyle;Canvas:TCanvas;ARect:TRect;const ACaption : string);
var
  LDetails        : TThemedElementDetails;
  CaptionDetails  : TThemedElementDetails;
  IconDetails     : TThemedElementDetails;
  IconRect        : TRect;
  BorderRect      : TRect;
  CaptionRect     : TRect;
  ButtonRect      : TRect;
  TextRect        : TRect;
  CaptionBitmap   : TBitmap;

    function GetBorderSize: TRect;
    var
      Size: TSize;
      Details: TThemedElementDetails;
      Detail: TThemedWindow;
    begin
      Result  := Rect(0, 0, 0, 0);
      Detail  := twCaptionActive;
      Details := Style.GetElementDetails(Detail);
      Style.GetElementSize(0, Details, esActual, Size);
      Result.Top := Size.cy;
      Detail := twFrameLeftActive;
      Details := Style.GetElementDetails(Detail);
      Style.GetElementSize(0, Details, esActual, Size);
      Result.Left := Size.cx;
      Detail := twFrameRightActive;
      Details := Style.GetElementDetails(Detail);
      Style.GetElementSize(0, Details, esActual, Size);
      Result.Right := Size.cx;
      Detail := twFrameBottomActive;
      Details := Style.GetElementDetails(Detail);
      Style.GetElementSize(0, Details, esActual, Size);
      Result.Bottom := Size.cy;
    end;

    function RectVCenter(var R: TRect; Bounds: TRect): TRect;
    begin
      OffsetRect(R, -R.Left, -R.Top);
      OffsetRect(R, 0, (Bounds.Height - R.Height) div 2);
      OffsetRect(R, Bounds.Left, Bounds.Top);
      Result := R;
    end;

begin
  BorderRect := GetBorderSize;

  CaptionBitmap := TBitmap.Create;
  CaptionBitmap.SetSize(ARect.Width, BorderRect.Top);

  //Draw background
  LDetails.Element := teWindow;
  LDetails.Part := 0;
  Style.DrawElement(Canvas.Handle, LDetails, ARect);

  //Draw caption border
  CaptionRect := Rect(0, 0, CaptionBitmap.Width, CaptionBitmap.Height);
  LDetails := Style.GetElementDetails(twCaptionActive);
  Style.DrawElement(CaptionBitmap.Canvas.Handle, LDetails, CaptionRect);
  TextRect := CaptionRect;
  CaptionDetails := LDetails;

  //Draw icon
  IconDetails := Style.GetElementDetails(twSysButtonNormal);
  if not Style.GetElementContentRect(0, IconDetails, CaptionRect, ButtonRect) then
    ButtonRect := Rect(0, 0, 0, 0);
  IconRect := Rect(0, 0, GetSystemMetrics(SM_CXSMICON), GetSystemMetrics(SM_CYSMICON));
  RectVCenter(IconRect, ButtonRect);
  if ButtonRect.Width > 0 then
   if Assigned(Application.MainForm) then
    DrawIconEx(CaptionBitmap.Canvas.Handle, IconRect.Left, IconRect.Top, Application.MainForm.Icon.Handle, 0, 0, 0, 0, DI_NORMAL);

  Inc(TextRect.Left, ButtonRect.Width + 5);

  //Draw buttons

  //Close button
  LDetails := Style.GetElementDetails(twCloseButtonNormal);
  if Style.GetElementContentRect(0, LDetails, CaptionRect, ButtonRect) then
   Style.DrawElement(CaptionBitmap.Canvas.Handle, LDetails, ButtonRect);

  //Maximize button
  LDetails := Style.GetElementDetails(twMaxButtonNormal);
  if Style.GetElementContentRect(0, LDetails, CaptionRect, ButtonRect) then
    Style.DrawElement(CaptionBitmap.Canvas.Handle, LDetails, ButtonRect);

  //Minimize button
  LDetails := Style.GetElementDetails(twMinButtonNormal);

  if Style.GetElementContentRect(0, LDetails, CaptionRect, ButtonRect) then
    Style.DrawElement(CaptionBitmap.Canvas.Handle, LDetails, ButtonRect);

  //Help button
  LDetails := Style.GetElementDetails(twHelpButtonNormal);
  if Style.GetElementContentRect(0, LDetails, CaptionRect, ButtonRect) then
    Style.DrawElement(CaptionBitmap.Canvas.Handle, LDetails, ButtonRect);

  if ButtonRect.Left > 0 then
    TextRect.Right := ButtonRect.Left;

  //Draw text
  Style.DrawText(CaptionBitmap.Canvas.Handle, CaptionDetails, ACaption, TextRect, [tfLeft, tfSingleLine, tfVerticalCenter]);

  //Draw caption
  Canvas.Draw(0, 0, CaptionBitmap);
  CaptionBitmap.Free;

  //Draw left border
  CaptionRect := Rect(0, BorderRect.Top, BorderRect.Left, ARect.Height - BorderRect.Bottom);
  LDetails := Style.GetElementDetails(twFrameLeftActive);
  if CaptionRect.Bottom - CaptionRect.Top > 0 then
    Style.DrawElement(Canvas.Handle, LDetails, CaptionRect);

  //Draw right border
  CaptionRect := Rect(ARect.Width - BorderRect.Right, BorderRect.Top, ARect.Width, ARect.Height - BorderRect.Bottom);
  LDetails := Style.GetElementDetails(twFrameRightActive);
  Style.DrawElement(Canvas.Handle, LDetails, CaptionRect);

  //Draw Bottom border
  CaptionRect := Rect(0, ARect.Height - BorderRect.Bottom, ARect.Width, ARect.Height);
  LDetails := Style.GetElementDetails(twFrameBottomActive);
  Style.DrawElement(Canvas.Handle, LDetails, CaptionRect);
end;

Finally joining all the pieces we can access the objects, bitmaps, colors and fonts of any VCl style, no matter where is located (embedded in a resource or in a external file).

The library and the demo application of the above image is available in the code google site.

Stay tuned for more updates of this library, the next updates will be include HSL, RGB effects to VCL Styles, vcl style explorer and so on.

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

• Fixing a VCL Style bug in the TPageControl and TTabControl components
• How to make a transparent form when a VCL Style is enabled?
• Fix for TRibbon and VCL styles

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 an extensive 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 accessible 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 are not trivial.

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.

Check the full source code on Github.

Update : this bug was fixed in the Update 4 of Delphi XE2.

The BUG

Yesterday while I’ve working migrating a personal project to Delphi XE2, I found a bug(QC #101346) in the TPageControl and TTabControl components. The issue is related to the images (icons) which are drawn in the tab controls when an ImageList is associated to the component. check the next sample image

In the above image, the form contains two components a TPageControl and a TTabControl, and both has an imagelist associated. Now if you change the VCL style of this form you will get this result.

As you can see when the Vcl Style is applied the images associated to the tabs are changed. So after a few minutes debugging the source code of the VCL when the Style is enabled, I found the issue in the DrawTab method of the TTabControlStyleHook class. This class is the responsible of call the drawing functions (of the TTabControl and TCustomTabControl) associated to a particular VCL style when and Style is enabled.

The main problem is in this line

procedure TTabControlStyleHook.DrawTab(Canvas: TCanvas; Index: Integer);
..
..
..
..
    if StyleServices.Available then
      StyleServices.DrawIcon(Canvas.Handle, Details, GlyphR, Images.Handle, Index);
..
..

As are you noted the problem is which the DrawIcon method is called passing the Index of the tab and not the index of image associated (imageindex) to the tab.

The Fix

So what I can do now?, First I report the issue to the Quality Central, and the I begin to work in a temporal solution until this problem was fixed by embarcadero. The Fix was create a new Style Hook class and register this class to be used by the style manager when a TPageControl or TTabControl are painted.

This is the source code of the style hook class

uses
  Vcl.Graphics,
  Winapi.Windows,
  Vcl.ComCtrls;

type
  TMyTabControlStyleHook = class(TTabControlStyleHook)
  strict private
    procedure AngleTextOut(Canvas: TCanvas; Angle: Integer; X, Y: Integer; const Text: string);//need to implemented because this method is strict private and can't be accessed directly
    function GetImageIndex(TabIndex: Integer): Integer;//helper class to retrieve the "real imageindex"
  strict protected
    procedure DrawTab(Canvas: TCanvas; Index: Integer); override;//a new implementation of the DrawTab method
  end;

implementation

Uses
  Vcl.Themes,
  System.Classes;

type
  THackCustomTabControl  =class (TCustomTabControl);

{ TMyTabControlStyleHook }

procedure TMyTabControlStyleHook.AngleTextOut(Canvas: TCanvas; Angle, X,
  Y: Integer; const Text: string);
var
  NewFontHandle, OldFontHandle: hFont;
  LogRec: TLogFont;
begin
  GetObject(Canvas.Font.Handle, SizeOf(LogRec), Addr(LogRec));
  LogRec.lfEscapement := Angle * 10;
  LogRec.lfOrientation := LogRec.lfEscapement;
  NewFontHandle := CreateFontIndirect(LogRec);
  OldFontHandle := SelectObject(Canvas.Handle, NewFontHandle);
  SetBkMode(Canvas.Handle, TRANSPARENT);
  Canvas.TextOut(X, Y, Text);
  NewFontHandle := SelectObject(Canvas.Handle, OldFontHandle);
  DeleteObject(NewFontHandle);
end;

//this function retrieve the "real" image index of a tab based on the tab index.
function TMyTabControlStyleHook.GetImageIndex(TabIndex: Integer): Integer;
begin
  Result:=-1;
  if (Control <> nil) and (Control is TCustomTabControl) then
   Result:=THackCustomTabControl(Control).GetImageIndex(TabIndex);
end;

//Patch to the DrawTab method
procedure TMyTabControlStyleHook.DrawTab(Canvas: TCanvas; Index: Integer);
var
  R, LayoutR, GlyphR: TRect;
  ImageWidth, ImageHeight, ImageStep, TX, TY: Integer;
  DrawState: TThemedTab;
  Details: TThemedElementDetails;
  ThemeTextColor: TColor;
  ImageIndex:Integer;
begin
  ImageIndex:=GetImageIndex(Index); //get the real image index

  if (Images <> nil) and (ImageIndex < Images.Count) then
  begin
    ImageWidth := Images.Width;
    ImageHeight := Images.Height;
    ImageStep := 3;
  end
  else
  begin
    ImageWidth := 0;
    ImageHeight := 0;
    ImageStep := 0;
  end;

  R := TabRect[Index];
  if R.Left < 0 then Exit;

  if TabPosition in [tpTop, tpBottom] then
  begin
    if Index = TabIndex then
      InflateRect(R, 0, 2);
  end
  else if Index = TabIndex then
    Dec(R.Left, 2) else Dec(R.Right, 2);

  Canvas.Font.Assign(THackCustomTabControl(Control).Font);//access the original protected font property using a helper hack class
  LayoutR := R;
  DrawState := ttTabDontCare;
  case TabPosition of
    tpTop:
      begin
        if Index = TabIndex then
          DrawState := ttTabItemSelected
        else if (Index = HotTabIndex) and MouseInControl then
          DrawState := ttTabItemHot
        else
          DrawState := ttTabItemNormal;
      end;
    tpLeft:
      begin
        if Index = TabIndex then
          DrawState := ttTabItemLeftEdgeSelected
        else if (Index = HotTabIndex) and MouseInControl then
          DrawState := ttTabItemLeftEdgeHot
        else
          DrawState := ttTabItemLeftEdgeNormal;
      end;
    tpBottom:
      begin
        if Index = TabIndex then
          DrawState := ttTabItemBothEdgeSelected
        else if (Index = HotTabIndex) and MouseInControl then
          DrawState := ttTabItemBothEdgeHot
        else
          DrawState := ttTabItemBothEdgeNormal;
      end;
    tpRight:
      begin
        if Index = TabIndex then
          DrawState := ttTabItemRightEdgeSelected
        else if (Index = HotTabIndex) and MouseInControl then
          DrawState := ttTabItemRightEdgeHot
        else
          DrawState := ttTabItemRightEdgeNormal;
      end;
  end;

  if StyleServices.Available then
  begin
    Details := StyleServices.GetElementDetails(DrawState);
    StyleServices.DrawElement(Canvas.Handle, Details, R);
  end;

  if (Images <> nil) and (ImageIndex < Images.Count) then//check the bounds of the image index to draw
  begin
    GlyphR := LayoutR;
    case TabPosition of
      tpTop, tpBottom:
        begin
          GlyphR.Left := GlyphR.Left + ImageStep;
          GlyphR.Right := GlyphR.Left + ImageWidth;
          LayoutR.Left := GlyphR.Right;
          GlyphR.Top := GlyphR.Top + (GlyphR.Bottom - GlyphR.Top) div 2 - ImageHeight div 2;
          if (TabPosition = tpTop) and (Index = TabIndex) then
            OffsetRect(GlyphR, 0, -1)
          else if (TabPosition = tpBottom) and (Index = TabIndex) then
            OffsetRect(GlyphR, 0, 1);
        end;
      tpLeft:
        begin
          GlyphR.Bottom := GlyphR.Bottom - ImageStep;
          GlyphR.Top := GlyphR.Bottom - ImageHeight;
          LayoutR.Bottom := GlyphR.Top;
          GlyphR.Left := GlyphR.Left + (GlyphR.Right - GlyphR.Left) div 2 - ImageWidth div 2;
        end;
      tpRight:
        begin
          GlyphR.Top := GlyphR.Top + ImageStep;
          GlyphR.Bottom := GlyphR.Top + ImageHeight;
          LayoutR.Top := GlyphR.Bottom;
          GlyphR.Left := GlyphR.Left + (GlyphR.Right - GlyphR.Left) div 2 - ImageWidth div 2;
        end;
    end;
    if StyleServices.Available then
      StyleServices.DrawIcon(Canvas.Handle, Details, GlyphR, Images.Handle, ImageIndex);//Here the Magic is made using the "real" imageindex of the tab
  end;

  if StyleServices.Available then
  begin
    if (TabPosition = tpTop) and (Index = TabIndex) then
      OffsetRect(LayoutR, 0, -1)
    else if (TabPosition = tpBottom) and (Index = TabIndex) then
      OffsetRect(LayoutR, 0, 1);

    if TabPosition = tpLeft then
    begin
      TX := LayoutR.Left + (LayoutR.Right - LayoutR.Left) div 2 -
        Canvas.TextHeight(Tabs[Index]) div 2;
      TY := LayoutR.Top + (LayoutR.Bottom - LayoutR.Top) div 2 +
        Canvas.TextWidth(Tabs[Index]) div 2;
     if StyleServices.GetElementColor(Details, ecTextColor, ThemeTextColor) then
       Canvas.Font.Color := ThemeTextColor;
      AngleTextOut(Canvas, 90, TX, TY, Tabs[Index]);
    end
    else if TabPosition = tpRight then
    begin
      TX := LayoutR.Left + (LayoutR.Right - LayoutR.Left) div 2 +
        Canvas.TextHeight(Tabs[Index]) div 2;
      TY := LayoutR.Top + (LayoutR.Bottom - LayoutR.Top) div 2 -
        Canvas.TextWidth(Tabs[Index]) div 2;
      if StyleServices.GetElementColor(Details, ecTextColor, ThemeTextColor)
      then
        Canvas.Font.Color := ThemeTextColor;
      AngleTextOut(Canvas, -90, TX, TY, Tabs[Index]);
    end
    else
      DrawControlText(Canvas, Details, Tabs[Index], LayoutR, DT_VCENTER or DT_CENTER or DT_SINGLELINE  or DT_NOCLIP);
  end;
end;



end.

Now before to use this new class in our code we need to unregister the original style hook class and then register the new one, using the UnRegisterStyleHook and RegisterStyleHook methods, check this code.

   TStyleManager.Engine.UnRegisterStyleHook(TCustomTabControl, TTabControlStyleHook);//unregister the original style hook for the TCustomTabControl components
   TStyleManager.Engine.RegisterStyleHook(TCustomTabControl, TMyTabControlStyleHook);//register the new style hook class
   TStyleManager.Engine.UnRegisterStyleHook(TTabControl, TTabControlStyleHook);//unregister the original style hook for the TTabControl components
   TStyleManager.Engine.RegisterStyleHook(TTabControl, TMyTabControlStyleHook);//register the new style hook class

And this is the final result (Now the tabs show the correct image)

I hope which this short article was useful for you, and you see one of the uses which you can made of the RegisterStyleHook and UnRegisterStyleHook methods ;).

Check the sample project source on Github.