Fixing a VCL Style bug in the TButton component

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);

Disabling the VCL Styles in the non client area of a Form

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

Changing the color of Edit Controls with VCL Styles Enabled

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;
    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;
    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_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

Download the full source code and a demo project from here