The Road to Delphi

I just added a border support for the TTabColorControlStyleHook style hook (introduced in this post)

without border

with border

Enjoy :)

Introduction

Until now if you want change the color of a TTabSheet in a VCL application you must create a new descendant class of the TTabSheet component, then handle the WM_ERASEBKGND message, set the TPageControl to OwnerDraw property to true and finally implement the OnDrawTab event. And after that you will have an awfull and un-themed TPageControl.

In this post I will show you how using the vcl styles you can gain full control over to paint methods with very nice results.

The TTabSheet

To customize the colors of the TabSheets of a TPageControl we need to handle the WM_ERASEBKGND message of the TTabsheet and create a new Vcl Style Hook. For the first part we can use a interposer class like so

type
  TTabSheet = class(Vcl.ComCtrls.TTabSheet)
  private
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  end;

And then in the implementation of the WMEraseBkgnd method

{ TTabSheet }
procedure TTabSheet.WMEraseBkgnd(var Message: TWMEraseBkgnd);
var
  LRect  : TRect;
  LSize  : Integer;
  LCanvas: TCanvas;
begin
  if (PageControl <> nil) and StyleServices.Enabled and
     ((PageControl.Style = tsTabs) or TStyleManager.IsCustomStyleActive) then
  begin
    //Get the bounds of the Tabsheet
    GetWindowRect(Handle, LRect);
    OffsetRect(LRect, -LRect.Left, -LRect.Top);
    //Get the size of the border
    LSize := ClientToParent(Point(0, 0)).X;
    InflateRect(LRect, LSize, LSize); // remove the border
    //create a TCanvas for erase the background, using the DC of the message
    LCanvas := TCanvas.Create;
    try
      LCanvas.Handle := Message.DC;
      LCanvas.Brush.Color:=GetColorTab(TabIndex);
      LCanvas.FillRect(LRect);
    finally
      LCanvas.Handle := 0;
      LCanvas.Free;
    end;

    Message.Result := 1;
    //the call to this method produces which the Style hook paint the active tabsheet
    PageControl.UpdateTab2(PageControl.ActivePage);
  end
  else
    inherited;
end;

In the above code you can note a call to the methods GetColorTab and PageControl.UpdateTab2

The GetColorTab is a simple function which return a color based in the index of the tab (you an modify the colors returned as you want)

function GetColorTab(Index : Integer) : TColor;
Const
  MaxColors =9;
  //this is a sample palette of colors 
  Colors : Array [0..MaxColors-1] of TColor = (6512214,16755712,8355381,1085522,115885,1098495,1735163,2248434,4987610);
begin
  Result:=Colors[Index mod MaxColors];
end;

The PageControl.UpdateTab2 is part of a helper class to execute the private method TPageControl.UpdateTab and is just a trick used to inform to vcl style that need paint the active tabsheet.

type
  TPageControlHelper = class helper for TPageControl
  public
    procedure UpdateTab2(Page: Vcl.ComCtrls.TTabSheet);
  end;

procedure TPageControlHelper.UpdateTab2(Page: Vcl.ComCtrls.TTabSheet);
begin
  Self.UpdateTab(Page);
end;

The Vcl style hook

Now the second part is implement the style hook using the existing TTabControlStyleHook as base class, so in this way we only need override 3 methods (PaintBackground, Paint and DrawTab) and handle the WM_ERASEBKGND message again.

Take a look to the declaration of the new vcl style hook

  TTabColorControlStyleHook= class(TTabControlStyleHook)
  private
    procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;
  protected
    procedure PaintBackground(Canvas: TCanvas); override;
    procedure Paint(Canvas: TCanvas); override;
    procedure DrawTab(Canvas: TCanvas; Index: Integer); override;
  end;

Before we handle the WM_ERASEBKGND message of the TTabsheet, now we need do the same but for the style hook, because the style hook (TStyleHook) has their own messages handle routine.

procedure TTabColorControlStyleHook.WMEraseBkgnd(var Message: TMessage);
var
  LCanvas : TCanvas;
begin
  if (Message.LParam = 1) and StyleServices.Available then
  begin
    //create a Local canvas based in the HDC returned in the Message.WParam
    LCanvas := TCanvas.Create;
    try
      LCanvas.Handle := HDC(Message.WParam);
      //get the color
      LCanvas.Brush.Color:=GetColorTab(TabIndex);
      //apply the color
      LCanvas.FillRect(Control.ClientRect);
    finally
      LCanvas.Handle := 0;
      LCanvas.Free;
    end;
  end;
  Message.Result := 1;
  Handled := True;
end;

Following the implementation of the vcl style hook, this is the implementation of the PaintBackground method.

procedure TTabColorControlStyleHook.PaintBackground(Canvas: TCanvas);
var
  LColor : TColor;
begin
  if StyleServices.Available then
  begin
    //get the background color
    LColor:=StyleServices.GetSystemColor(clWindowFrame);
    Canvas.Brush.Color:=LColor;
    Canvas.FillRect(Control.ClientRect);
  end;
end;

Now the code for the Paint method, this procedure paint the body of the tabsheet and draw the child controls.

procedure TTabColorControlStyleHook.Paint(Canvas: TCanvas);
var
  LRect  : TRect;
  LIndex : Integer;
  SavedDC: Integer;
begin
  SavedDC := SaveDC(Canvas.Handle);
  try
    LRect := DisplayRect;
    ExcludeClipRect(Canvas.Handle, LRect.Left, LRect.Top, LRect.Right, LRect.Bottom);
    PaintBackground(Canvas);
  finally
    RestoreDC(Canvas.Handle, SavedDC);
  end;

  // Update the state of the tabs, except the active
  for LIndex := 0 to TabCount - 1 do
  begin
    if LIndex = TabIndex then
      Continue;
    DrawTab(Canvas, LIndex);
  end;

  //modify the bounds of the body to paint, based in the postion of the tab
  case TabPosition of
    tpTop   : InflateRect(LRect, Control.Width - LRect.Right, Control.Height - LRect.Bottom);
    tpLeft  : InflateRect(LRect, Control.Width - LRect.Right, Control.Height - LRect.Bottom);
    tpBottom: InflateRect(LRect, LRect.Left, LRect.Top);
    tpRight : InflateRect(LRect, LRect.Left, LRect.Top);
  end;

  //Paint the body of the tabsheet
  if StyleServices.Available then
  begin
    Canvas.Brush.Color:=GetColorTab(TabIndex);
    Canvas.FillRect(LRect);
  end;

  // Draw the active tab
  if TabIndex >= 0 then
    DrawTab(Canvas, TabIndex);

  // paint the controls of the tab
  TWinControlClass(Control).PaintControls(Canvas.Handle, nil);
end;

We’re almost done the job, now we just need to implement the code for draw the Tab. Check the next full commented code

procedure TTabColorControlStyleHook.DrawTab(Canvas: TCanvas; Index: Integer);
var
  LDetails    : TThemedElementDetails;
  LImageIndex : Integer;
  LThemedTab  : TThemedTab;
  LIconRect   : TRect;
  R, LayoutR  : TRect;
  LImageW, LImageH, DxImage : Integer;
  LTextX, LTextY: Integer;
  LTextColor    : TColor;
    //draw the text in the tab
    procedure DrawControlText(const S: string; var R: TRect; Flags: Cardinal);
    var
      TextFormat: TTextFormatFlags;
    begin
      Canvas.Font       := TWinControlClass(Control).Font; //the TWinControlClass is a just a crack class for the TWinControl to access the protected members
      TextFormat        := TTextFormatFlags(Flags);
      Canvas.Font.Color := LTextColor;    
      StyleServices.DrawText(Canvas.Handle, LDetails, S, R, TextFormat, Canvas.Font.Color);
    end;

begin
  //get the size of tab image (icon)
  if (Images <> nil) and (Index < Images.Count) then
  begin
    LImageW := Images.Width;
    LImageH := Images.Height;
    DxImage := 3;
  end
  else
  begin
    LImageW := 0;
    LImageH := 0;
    DxImage := 0;
  end;

  R := TabRect[Index];
  //check the left position of the tab , because can be hide 
  if R.Left < 0 then Exit;

  //adjust the size of the tab to draw
  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(TCustomTabControlClass(Control).Font);//the TCustomTabControlClass is another crack class to access the protected font property
  LayoutR := R;
  LThemedTab := ttTabDontCare;
  //Get the type of the active tab to draw
  case TabPosition of
    tpTop:
      begin
        if Index = TabIndex then
          LThemedTab := ttTabItemSelected
        else 
        if (Index = HotTabIndex) and MouseInControl then
          LThemedTab := ttTabItemHot
        else
          LThemedTab := ttTabItemNormal;
      end;
    tpLeft:
      begin
        if Index = TabIndex then
          LThemedTab := ttTabItemLeftEdgeSelected
        else 
        if (Index = HotTabIndex) and MouseInControl then
          LThemedTab := ttTabItemLeftEdgeHot
        else
          LThemedTab := ttTabItemLeftEdgeNormal;
      end;
    tpBottom:
      begin
        if Index = TabIndex then
          LThemedTab := ttTabItemBothEdgeSelected
        else 
        if (Index = HotTabIndex) and MouseInControl then
          LThemedTab := ttTabItemBothEdgeHot
        else
          LThemedTab := ttTabItemBothEdgeNormal;
      end;
    tpRight:
      begin
        if Index = TabIndex then
          LThemedTab := ttTabItemRightEdgeSelected
        else 
        if (Index = HotTabIndex) and MouseInControl then
          LThemedTab := ttTabItemRightEdgeHot
        else
          LThemedTab := ttTabItemRightEdgeNormal;
      end;
  end;

  //draw the tab
  if StyleServices.Available then
  begin
    LDetails := StyleServices.GetElementDetails(LThemedTab);//necesary for DrawControlText and draw the icon
    InflateRect(R,-1,0);//adjust the size of the tab creating a blank space between the tabs
    Canvas.Brush.Color:=GetColorTab(Index);//get the color 
    Canvas.FillRect(R);
  end;

  //get the index of the image (icon)
  if Control is TCustomTabControl then
    LImageIndex := TCustomTabControlClass(Control).GetImageIndex(Index)
  else
    LImageIndex := Index;

  //draw the image
  if (Images <> nil) and (LImageIndex >= 0) and (LImageIndex < Images.Count) then
  begin
    LIconRect := LayoutR;
    case TabPosition of
      tpTop, tpBottom:
        begin
          LIconRect.Left := LIconRect.Left + DxImage;
          LIconRect.Right := LIconRect.Left + LImageW;
          LayoutR.Left := LIconRect.Right;
          LIconRect.Top := LIconRect.Top + (LIconRect.Bottom - LIconRect.Top) div 2 - LImageH div 2;
          if (TabPosition = tpTop) and (Index = TabIndex) then
            OffsetRect(LIconRect, 0, -1)
          else
          if (TabPosition = tpBottom) and (Index = TabIndex) then
            OffsetRect(LIconRect, 0, 1);
        end;
      tpLeft:
        begin
          LIconRect.Bottom := LIconRect.Bottom - DxImage;
          LIconRect.Top := LIconRect.Bottom - LImageH;
          LayoutR.Bottom := LIconRect.Top;
          LIconRect.Left := LIconRect.Left + (LIconRect.Right - LIconRect.Left) div 2 - LImageW div 2;
        end;
      tpRight:
        begin
          LIconRect.Top := LIconRect.Top + DxImage;
          LIconRect.Bottom := LIconRect.Top + LImageH;
          LayoutR.Top := LIconRect.Bottom;
          LIconRect.Left := LIconRect.Left + (LIconRect.Right - LIconRect.Left) div 2 - LImageW div 2;
        end;
    end;
    if StyleServices.Available then
      StyleServices.DrawIcon(Canvas.Handle, LDetails, LIconRect, Images.Handle, LImageIndex);
  end;

  //draw the text of the tab
  if StyleServices.Available then
  begin
    LTextColor:=GetColorTextTab(LThemedTab);//this is a helper function which get the  text color of the tab based in his current state (normal, select, hot).

    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
      LTextX := LayoutR.Left + (LayoutR.Right - LayoutR.Left) div 2 - Canvas.TextHeight(Tabs[Index]) div 2;
      LTextY := LayoutR.Top + (LayoutR.Bottom - LayoutR.Top) div 2 + Canvas.TextWidth(Tabs[Index]) div 2;
      Canvas.Font.Color := LTextColor;
      AngleTextOut2(Canvas, 90, LTextX, LTextY, Tabs[Index]);
    end
    else
    if TabPosition = tpRight then
    begin
      LTextX := LayoutR.Left + (LayoutR.Right - LayoutR.Left) div 2 + Canvas.TextHeight(Tabs[Index]) div 2;
      LTextY := LayoutR.Top + (LayoutR.Bottom - LayoutR.Top) div 2 - Canvas.TextWidth(Tabs[Index]) div 2;
      Canvas.Font.Color := LTextColor;
      AngleTextOut2(Canvas, -90, LTextX, LTextY, Tabs[Index]);
    end
    else
     DrawControlText(Tabs[Index], LayoutR, DT_VCENTER or DT_CENTER or DT_SINGLELINE  or DT_NOCLIP);
  end;
end;

The final result

Ok, that was a lot of code, now this is the final result

To use this style hook you must include the Vcl.Styles.ColorTabs unit in your uses class after of the Vcl.ComCtrls unit and then register the hook in this way.

  TCustomStyleEngine.RegisterStyleHook(TCustomTabControl, TTabColorControlStyleHook);
  TCustomStyleEngine.RegisterStyleHook(TTabControl, TTabColorControlStyleHook);

The full source code of this style hook is located in the vcl style utils repository.

Adding a background image to a delphi form is a topic very well covered by many articles, but most of them doesn’t work or another produces a lot of flicker when the vcl styles are enabled. The common techniques to set a background image in a form includes :

• Use a TImage component with the align property set to alClient
• Use the OnPaint event of the Form and handle the WM_ERASEBKGND message
• use the Canvas.Brush.Bitmap property of the form to assign a bitmap
• and so on.

Since the introduction of the vcl styles, now you can use the style hooks to handle the paint operations of the TWinControl descendant, the main advantage about the styles hookz is which you can override the core paint methods directly, avoiding the flicker and in most cases you do not even need to handle the windows messages. So now I will how you how you can create a style hook to add a custom background image or color to a form including the non client area.

The first step is create a new Style hook descendant of the TFormStyleHook class and override the PaintNC and PaintBackground methods.

So the class definition will look like this

type
  TFormStyleHookBackround=class(TFormStyleHook)
  strict private
    type
      TSettings = class
      strict private
        FColor: TColor;
        FImageLocation: string;
        FBitmap: TBitmap;
        FUseColor: Boolean;
        FUseImage: Boolean;
        FEnabled: Boolean;
        procedure SetColor(const Value: TColor);
        procedure SetImageLocation(const Value: string);
        procedure SetUseColor(const Value: Boolean);
        procedure SetUseImage(const Value: Boolean);
      public
        property UseImage : Boolean read FUseImage write SetUseImage;
        property UseColor : Boolean read FUseColor write SetUseColor;
        property Color : TColor read FColor write SetColor;
        property ImageLocation : string read FImageLocation write SetImageLocation;
        property Bitmap : TBitmap read FBitmap;
        property Enabled : Boolean read FEnabled write FEnabled;
        constructor Create;
        destructor  Destroy;override;
      end;
    class var FNCSettings: TSettings;
    class var FBackGroundSettings: TSettings;
    class var FMergeImages: boolean;
  protected
    procedure PaintNC(Canvas: TCanvas); override;
    procedure PaintBackground(Canvas: TCanvas); override;
    class constructor Create;
    class destructor  Destroy;
  public
    class property MergeImages: boolean read FMergeImages write FMergeImages;
    class property NCSettings : TSettings read FNCSettings;
    class property BackGroundSettings : TSettings read FBackGroundSettings;
  end;

Note: the above class definition includes some additional elements to store the settings of the style hook like Bitmaps and Colors used.

Painting the background

The PaintBackground method, paints the background of the form filling the control area with the current vcl style background color, in this case we are use a bitmap or a custom color depnding of the setting of the hook.

procedure TFormStyleHookBackround.PaintBackground(Canvas: TCanvas);
var
  LRect   : TRect;
  RBitmap : TRect;
  L,H     : Integer;
begin
  //if the option is not enabled use the default inherited PaintBackground method
  if not BackGroundSettings.Enabled then
   inherited
  else
  begin
    //get he bounds of the control (form)
    LRect := Rect(0, 0, Control.ClientWidth, Control.ClientHeight);
    //use a custom color for the background?
    if  BackGroundSettings.UseColor then
    begin
     Canvas.Brush.Color:=BackGroundSettings.Color;
     Canvas.FillRect(LRect);
    end
    else
    //use a bitmap
    begin
      //check the size of the bitmap against the control bounds to detrine how the bitmap is drawn
      if (BackGroundSettings.Bitmap.Width<LRect.Width) or (BackGroundSettings.Bitmap.Height<LRect.Height) then
      begin
       Canvas.Brush.Bitmap := BackGroundSettings.BitMap;
       Canvas.FillRect(LRect);
      end
      else
      begin
       //check if the the background bitmap must be merged with non client area bitmap
       if not FMergeImages then
        Canvas.CopyRect(LRect,BackGroundSettings.Bitmap.Canvas,LRect)
       else
       begin
        RBitmap:=LRect;
        H:=_GetBorderSize.Top;
        L:=_GetBorderSize.Left;
        RBitmap.SetLocation(L, H);
        Canvas.CopyRect(LRect,BackGroundSettings.Bitmap.Canvas,RBitmap);
       end;
      end;
    end;
  end;
end;

The above code will produce results like these

Using a custom color background

Using a custom image background

Painting the Non client area

To handle the paint operations over the non client area in the old versions of windows (before to windows vista) you must handle the WM_NCPAINT windows message or since Windows Vista using the DWM API you can accomplish this task. But if you uses the vcl styles only you must need override the PaintNC method.

This is the implementation of the PaintNC method to use a custom color or image in the non client area.

procedure TFormStyleHookBackround.PaintNC(Canvas: TCanvas);
var
  LDetail: TThemedWindow;
  LDetails,
  CaptionDetails,
  IconDetails   : TThemedElementDetails;
  R, R1, DrawRect, ButtonRect, TextRect: TRect;
  CaptionBuffer: TBitmap;
  FButtonState: TThemedWindow;
  TextFormat: TTextFormat;
  LText: string;
  SrcBackRect     : TRect;
begin
  //if the setting is not enabled use the original PaintNC method
  if not NCSettings.Enabled then
  begin
   inherited ;
   exit;
  end;

  //check the border style of the form
  if Form.BorderStyle = bsNone then
  begin
    MainMenuBarHookPaint(Canvas);
    Exit;
  end;


  {init some parameters}
  _FCloseButtonRect := Rect(0, 0, 0, 0);
  _FMaxButtonRect := Rect(0, 0, 0, 0);
  _FMinButtonRect := Rect(0, 0, 0, 0);
  _FHelpButtonRect := Rect(0, 0, 0, 0);
  _FSysMenuButtonRect := Rect(0, 0, 0, 0);
  _FCaptionRect := Rect(0, 0, 0, 0);

  if not StyleServices.Available then
    Exit;
  R := _GetBorderSize;

  {draw caption}

  if (Form.BorderStyle <> bsToolWindow) and
     (Form.BorderStyle <> bsSizeToolWin) then
  begin
    if _FFormActive then
      LDetail := twCaptionActive
    else
      LDetail := twCaptionInActive
  end
  else
  begin
   if _FFormActive then
      LDetail := twSmallCaptionActive
    else
      LDetail := twSmallCaptionInActive
  end;
  CaptionBuffer := TBitmap.Create;
  CaptionBuffer.SetSize(_FWidth, R.Top);

  {draw caption border}
  DrawRect := Rect(0, 0, CaptionBuffer.Width, CaptionBuffer.Height);
  LDetails := StyleServices.GetElementDetails(LDetail);  //used for draw text in the caption

  //check if a must use a custom color or a bitmap
  if FNCSettings.UseColor then
  begin
    //use the select color to fill the background of the canvas
    CaptionBuffer.Canvas.Brush.Color:=FNCSettings.Color;
    CaptionBuffer.Canvas.FillRect(DrawRect);
  end
  else
  begin
    //use the bitmap to fill the canvas
    SrcBackRect.Left:=0;
    SrcBackRect.Top:=0;
    SrcBackRect.Width:=DrawRect.Width;
    SrcBackRect.Height:=DrawRect.Height;
    //SrcBackRect.SetLocation(FNCSettings.Bitmap.Width-DrawRect.Width, 0);
    //SrcBackRect.SetLocation(_GetBorderSize.Width, 0);
    CaptionBuffer.Canvas.CopyRect(DrawRect, FNCSettings.Bitmap.Canvas,SrcBackRect);
  end;

  TextRect := DrawRect;
  CaptionDetails := LDetails;

  {draw icon}
  if (biSystemMenu in TCustomFormHack(Form).BorderIcons) and
     (Form.BorderStyle <> bsDialog) and
     (Form.BorderStyle <> bsToolWindow) and
     (Form.BorderStyle <> bsSizeToolWin) then
  begin
    IconDetails := StyleServices.GetElementDetails(twSysButtonNormal);
    if not StyleServices.GetElementContentRect(0, IconDetails, DrawRect, ButtonRect) then
      ButtonRect := Rect(0, 0, 0, 0);
    R1 := Rect(0, 0, GetSystemMetrics(SM_CXSMICON), GetSystemMetrics(SM_CYSMICON));
    RectVCenter(R1, ButtonRect);
    if ButtonRect.Width > 0 then
      DrawIconEx(CaptionBuffer.Canvas.Handle, R1.Left, R1.Top, _GetIconFast.Handle, 0, 0, 0, 0, DI_NORMAL);
    Inc(TextRect.Left, ButtonRect.Width + 5);
    _FSysMenuButtonRect := ButtonRect;
  end
  else
    Inc(TextRect.Left, R.Left);

  {draw buttons}
  if (biSystemMenu in TCustomFormHack(Form).BorderIcons) then
  begin
    if (Form.BorderStyle <> bsToolWindow) and
       (Form.BorderStyle <> bsSizeToolWin) then
    begin
      if (_FPressedButton = HTCLOSE) and (_FHotButton = HTCLOSE) then
        FButtonState := twCloseButtonPushed
      else if _FHotButton = HTCLOSE then
        FButtonState := twCloseButtonHot
      else
        if _FFormActive then
          FButtonState := twCloseButtonNormal
        else
          FButtonState := twCloseButtonDisabled;
     end
    else
    begin
      if (_FPressedButton = HTCLOSE) and (_FHotButton = HTCLOSE) then
        FButtonState := twSmallCloseButtonPushed
      else if _FHotButton = HTCLOSE then
        FButtonState := twSmallCloseButtonHot
      else
        if _FFormActive then
          FButtonState := twSmallCloseButtonNormal
        else
          FButtonState := twSmallCloseButtonDisabled;
    end;

    LDetails := StyleServices.GetElementDetails(FButtonState);
    if not StyleServices.GetElementContentRect(0, LDetails, DrawRect, ButtonRect) then
      ButtonRect := Rect(0, 0, 0, 0);

    StyleServices.DrawElement(CaptionBuffer.Canvas.Handle, LDetails, ButtonRect);

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

  if (biMaximize in TCustomFormHack(Form).BorderIcons) and
     (biSystemMenu in TCustomFormHack(Form).BorderIcons) and
     (Form.BorderStyle <> bsDialog) and
     (Form.BorderStyle <> bsToolWindow) and
     (Form.BorderStyle <> bsSizeToolWin) then
  begin
    if Form.WindowState = wsMaximized then
    begin
      if (_FPressedButton = HTMAXBUTTON) and (_FHotButton = HTMAXBUTTON) then
        FButtonState := twRestoreButtonPushed
      else if _FHotButton = HTMAXBUTTON then
        FButtonState := twRestoreButtonHot
      else
      if _FFormActive then
        FButtonState := twRestoreButtonNormal
      else
        FButtonState := twRestoreButtonDisabled;
    end
    else
    begin
      if (_FPressedButton = HTMAXBUTTON) and (_FHotButton = HTMAXBUTTON) then
        FButtonState := twMaxButtonPushed
      else if _FHotButton = HTMAXBUTTON then
        FButtonState := twMaxButtonHot
      else
      if _FFormActive then
        FButtonState := twMaxButtonNormal
      else
        FButtonState := twMaxButtonDisabled;
    end;
    LDetails := StyleServices.GetElementDetails(FButtonState);

    if not StyleServices.GetElementContentRect(0, LDetails, DrawRect, ButtonRect) then
      ButtonRect := Rect(0, 0, 0, 0);
    if ButtonRect.Width > 0 then
      StyleServices.DrawElement(CaptionBuffer.Canvas.Handle, LDetails, ButtonRect);
    if ButtonRect.Left > 0 then
      TextRect.Right := ButtonRect.Left;
    _FMaxButtonRect := ButtonRect;
  end;

  if (biMinimize in TCustomFormHack(Form).BorderIcons) and
     (biSystemMenu in TCustomFormHack(Form).BorderIcons) and
     (Form.BorderStyle <> bsDialog) and
     (Form.BorderStyle <> bsToolWindow) and
     (Form.BorderStyle <> bsSizeToolWin) then
  begin
    if (_FPressedButton = HTMINBUTTON) and (_FHotButton = HTMINBUTTON) then
      FButtonState := twMinButtonPushed
    else if _FHotButton = HTMINBUTTON then
      FButtonState := twMinButtonHot
    else
      if _FFormActive then
        FButtonState := twMinButtonNormal
      else
        FButtonState := twMinButtonDisabled;

    LDetails := StyleServices.GetElementDetails(FButtonState);

    if not StyleServices.GetElementContentRect(0, LDetails, DrawRect, ButtonRect) then
      ButtonRect := Rect(0, 0, 0, 0);
    if ButtonRect.Width > 0 then
      StyleServices.DrawElement(CaptionBuffer.Canvas.Handle, LDetails, ButtonRect);
    if ButtonRect.Left > 0 then TextRect.Right := ButtonRect.Left;
    _FMinButtonRect := ButtonRect;
  end;

  if (biHelp in TCustomFormHack(Form).BorderIcons) and (biSystemMenu in TCustomFormHack(Form).BorderIcons) and
     ((not (biMaximize in TCustomFormHack(Form).BorderIcons) and
     not (biMinimize in TCustomFormHack(Form).BorderIcons)) or (Form.BorderStyle = bsDialog))
  then
  begin
    if (_FPressedButton = HTHELP) and (_FHotButton = HTHELP) then
      FButtonState := twHelpButtonPushed
    else if _FHotButton = HTHELP then
      FButtonState := twHelpButtonHot
    else
    if _FFormActive then
      FButtonState := twHelpButtonNormal
    else
      FButtonState := twHelpButtonDisabled;
    LDetails := StyleServices.GetElementDetails(FButtonState);

    if not StyleServices.GetElementContentRect(0, LDetails, DrawRect, ButtonRect) then
      ButtonRect := Rect(0, 0, 0, 0);
    if ButtonRect.Width > 0 then
      StyleServices.DrawElement(CaptionBuffer.Canvas.Handle, LDetails, ButtonRect);

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

  {draw text}
  TextFormat := [tfLeft, tfSingleLine, tfVerticalCenter];
  if Control.UseRightToLeftReading then
    Include(TextFormat, tfRtlReading);

  LText := Text;
  StyleServices.DrawText(CaptionBuffer.Canvas.Handle, CaptionDetails, LText, TextRect, TextFormat);
  _FCaptionRect := TextRect;

  {draw caption buffer}

  Canvas.Draw(0, 0, CaptionBuffer);
  CaptionBuffer.Free;

  {draw menubar}
  MainMenuBarHookPaint(Canvas);

  {draw left border}
  DrawRect := Rect(0, R.Top, R.Left, _FHeight - R.Bottom);
  if DrawRect.Bottom - DrawRect.Top > 0 then
    //use a color?
    if FNCSettings.UseColor then
    begin
      Canvas.Brush.Color:=FNCSettings.Color;
      Canvas.FillRect(DrawRect);
    end
    else
    begin
      if (DrawRect.Height<=FNCSettings.BitMap.Height) and (DrawRect.Width<=FNCSettings.BitMap.Width)  then
        Canvas.CopyRect(DrawRect,FNCSettings.Bitmap.Canvas,DrawRect)
      else
        Canvas.StretchDraw(DrawRect, FNCSettings.BitMap);
    end;

  {draw right border}
  DrawRect := Rect(_FWidth - R.Right, R.Top, _FWidth, _FHeight - R.Bottom);

  if DrawRect.Bottom - DrawRect.Top > 0 then
    //use a color?
    if FNCSettings.UseColor then
    begin
      Canvas.Brush.Color:=FNCSettings.Color;
      Canvas.FillRect(DrawRect);
    end
    else
    begin
      if (DrawRect.Height<=FNCSettings.BitMap.Height) and (Control.Width<=FNCSettings.BitMap.Width)  then
        Canvas.CopyRect(DrawRect,FNCSettings.Bitmap.Canvas,DrawRect)
      else
        Canvas.StretchDraw(DrawRect, FNCSettings.BitMap);
    end;

  {draw Bottom border}
  DrawRect := Rect(0, _FHeight - R.Bottom, _FWidth, _FHeight);

  if DrawRect.Bottom - DrawRect.Top > 0 then
    //use a color?
    if FNCSettings.UseColor then
    begin
      Canvas.Brush.Color:=FNCSettings.Color;
      Canvas.FillRect(DrawRect);
    end
    else
    begin
      if (DrawRect.Height<=FNCSettings.BitMap.Height) and (Control.Width<=FNCSettings.BitMap.Width)  then
        Canvas.CopyRect(DrawRect,FNCSettings.Bitmap.Canvas,DrawRect)
      else
      begin
        SrcBackRect.Left:=0;
        SrcBackRect.Top:=0;
        SrcBackRect.Width:=DrawRect.Width;
        SrcBackRect.Height:=DrawRect.Height;
        SrcBackRect.SetLocation(FNCSettings.BitMap.Width-DrawRect.Width, 0);
        Canvas.CopyRect(DrawRect, FNCSettings.BitMap.Canvas,SrcBackRect);
      end;
    end;
end;

And the result is

Using a custom color in the non client area

Using a custom image in the non client area

Putting it all together

Finally if you mix both methods (the background and the non client area) you can get very nice results

Using the class

The full source code of the TFormStyleHookBackround class is available here and is part of the vcl style utils project. to use it just include a reference to the Vcl.Styles.FormStyleHooks unit in your project and register the style hook like so.

  TStyleManager.Engine.RegisterStyleHook(TFrmMain, TFormStyleHookBackround);

To modify the background image of the form, use this code

  TFormStyleHookBackround.BackGroundSettings.UseImage := True;
  TFormStyleHookBackround.BackGroundSettings.ImageLocation := 'image.png'; //set the location of the image

To modify the background color of the form, use this code

  TFormStyleHookBackround.BackGroundSettings.UseColor := True;
  TFormStyleHookBackround.BackGroundSettings.Color := clRed;//set the colot

After of modify background color or image you must repaint the form sending the WM_PAINT message

Check this sample

Var
  LIndex: Integer;
begin
  for LIndex := 0 to ComponentCount - 1 do
    if Components[LIndex] is TWinControl then
    begin
      TWinControl(Components[LIndex]).Invalidate;
      TWinControl(Components[LIndex]).Perform(WM_PAINT, 0, 0);
    end;

  Self.Invalidate;
  Self.Perform(WM_PAINT, 0, 0);
end;

To customize the color of the non client area of the form use this code

  TFormStyleHookBackround.NCSettings.UseColor:= True;
  TFormStyleHookBackround.NCSettings.Color:= clGreen; //set the color

To assign an image to the non client area of the form use this code

  TFormStyleHookBackround.NCSettings.UseImage := True;
  TFormStyleHookBackround.NCSettings.ImageLocation := 'image.png'; //set the location of the image

After of modify color or image of the non client area you must repaint the NC using the WM_NCPAINT message

SendMessage(Handle, WM_NCPAINT, 0, 0);

Download the demo application (binaries) from here.

How you probably know the TWebBrowser doesn’t supports the vcl styles, so two days ago I started to write a fix for the TWebBrowser and the VCL styles

So far i’m getting very good results

But I need to do some additional tests in order to release the code, so your help is need it to try the demo app included in this post. Please let me know about any issue which you can find.

Download the demo application from here.

You can send me your feedback to rodrigo dot ruz dot v at gmail dot com

UPDATE

A Updated and improved version of the code shown on this article can be found in the Vcl.Styles.OwnerDrawFix unit which is part of the Vcl Styles Utils.

The Issue

When you uses the Vcl Styles, you expect which at least all the standard (and common) controls (TListBox, TEditBox, TListView, TMemo, Treeview, and so on) are skinned according to the style selected, but maybe you are observed some minor issues in controls like TListBox, TListView and TTreeView.

Check the next image, which had a form with a TListBox and a TListView

As you can see the highlight color and the checkboxes doesn’t use the Vcl Styles elements.

The Explanation

So why this happen? is a Vcl Style bug? well let me answer both questions :

First exist basically two ways how the vcl styles skin a control, if the control doesn’t have a windows handle (like the TLabel), the control is draw (usually) in the  paint method using the properties and procedures of the StyleServices (TCustomStyleServices) class, otherwise if the control is a TWinControl descendent then use the Style Hooks , the styles hooks handles the windows messages of the controls wrapped by the VCL and use Windows messages and WinApi calls to draw directly over the Canvas of the control or set the properties of the controls (when is possible) like the background  or foreground color using the SendMessage function.

In this point the windows messages are the key,   some Windows controls doesn’t fire some messages at least which the control was in an owner draw (or Custom Draw) mode.

for example if you want to change the highlight color of  a listview

1) You must receive the WM_NOTIFY message
2) then check the NM_CUSTOMDRAW notification code
3) after check for the current drawing stage (CDDS_ITEMPREPAINT in this case)
4) to finally pass a NMLVCUSTOMDRAW record with the new colors to use.

So in this case if the list view has the OwnerDraw property set to false these messages never will sent to our application. Because that is not possible implement a Style hook as there are not windows messages to process.

Note : Is technically possible write a Style hook for receive such owner draw messages, but that will implies create a style hook which need modify the ownerdraw property and then full draw the control.

The Fix

So how the style hooks are discarded, in this case we can owner draw the contols using the Vcl Styles classes and functions. (I don’t spend much time writing these routines , so can be incomplete)

OnDrawItem implementation for a TListbox

procedure TFrmMain.ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
Var
 LListBox : TListBox;
 LStyles  : TCustomStyleServices;
 LDetails : TThemedElementDetails;
begin
  LListBox :=TListBox(Control);
  LStyles  :=StyleServices;
  //check the state
  if odSelected in State then
    LListBox.Brush.Color := LStyles.GetSystemColor(clHighlight);

  //get the details (states and parts) to use
  LDetails := StyleServices.GetElementDetails(tlListItemNormal);
    
  LListBox.Canvas.FillRect(Rect);
  Rect.Left:=Rect.Left+2;
  //draw the text
  LStyles.DrawText(LListBox.Canvas.Handle, LDetails, LListBox.Items[Index], Rect, [tfLeft, tfSingleLine, tfVerticalCenter]);

  //draw the Highlight rect using the vcl styles colors
  if odFocused In State then
  begin
    LListBox.Canvas.Brush.Color := LStyles.GetSystemColor(clHighlight);
    LListBox.Canvas.DrawFocusRect(Rect);
  end;
end;

OnDrawItem implementation for a TListView

procedure TFrmMain.ListView1DrawItem(Sender: TCustomListView; Item: TListItem;
  Rect: TRect; State: TOwnerDrawState);
var
  r         : TRect;
  rc        : TRect;
  ColIdx    : Integer;
  s         : string;
  LDetails  : TThemedElementDetails;
  LStyles   : TCustomStyleServices;
  BoxSize   : TSize;
  Spacing   : Integer;
  LColor    : TColor;
begin
  Spacing:=4;
  LStyles:=StyleServices;
  //get the color text of the items 
  if not LStyles.GetElementColor(LStyles.GetElementDetails(ttItemNormal), ecTextColor, LColor) or  (LColor = clNone) then
  LColor := LStyles.GetSystemColor(clWindowText);

  //get and set the backgroun color
  Sender.Canvas.Brush.Color := LStyles.GetStyleColor(scListView);

  //set the font color
  Sender.Canvas.Font.Color  := LColor;
  Sender.Canvas.FillRect(Rect);

  r := Rect;
  inc(r.Left, Spacing);
  //iterate over the columns
  for ColIdx := 0 to TListView(Sender).Columns.Count - 1 do
  begin
    r.Right := r.Left + Sender.Column[ColIdx].Width;

    if ColIdx > 0 then
      s := Item.SubItems[ColIdx - 1]
    else
    begin
      BoxSize.cx := GetSystemMetrics(SM_CXMENUCHECK);
      BoxSize.cy := GetSystemMetrics(SM_CYMENUCHECK);
      s := Item.Caption;
      if TListView(Sender).Checkboxes then
       r.Left:=r.Left+BoxSize.cx+3;
    end;

    if ColIdx = 0 then
    begin
      if not IsWindowVisible(ListView_GetEditControl(Sender.Handle)) and ([odSelected, odHotLight] * State <> []) then
      begin
        if ([odSelected, odHotLight] * State <> []) then
        begin
          rc:=Rect;
          if TListView(Sender).Checkboxes then
           rc.Left:=rc.Left+BoxSize.cx+Spacing;

          if not TListView(Sender).RowSelect then
           rc.Right:=Sender.Column[0].Width;
          
          Sender.Canvas.Brush.Color := LStyles.GetSystemColor(clHighlight);
          //draw the highlight rect using the current the vcl styles colors
          Sender.Canvas.FillRect(rc);
        end;
      end;
    end;

    if TListView(Sender).RowSelect then
      Sender.Canvas.Brush.Color := LStyles.GetSystemColor(clHighlight);

    //draw the text of the item
    LDetails := StyleServices.GetElementDetails(tlListItemNormal);
    Sender.Canvas.Brush.Style := bsClear;
    LStyles.DrawText(Sender.Canvas.Handle, LDetails, s, r, [tfLeft, tfSingleLine, tfVerticalCenter, tfEndEllipsis]);

    //draw the check box 
    if (ColIdx=0) and TListView(Sender).Checkboxes then
    begin
      rc := Rect;
      rc.Top    := Rect.Top + (Rect.Bottom - Rect.Top - BoxSize.cy) div 2;
      rc.Bottom := rc.Top + BoxSize.cy;
      rc.Left   := rc.Left + Spacing;
      rc.Right  := rc.Left + BoxSize.cx;

      if Item.Checked then
       LDetails := StyleServices.GetElementDetails(tbCheckBoxUncheckedNormal)
      else
       LDetails := StyleServices.GetElementDetails(tbCheckBoxcheckedNormal);

      LStyles.DrawElement(Sender.Canvas.Handle, LDetails, Rc);
    end;

    if ColIdx=0 then
     r.Left:=Sender.Column[ColIdx].Width + Spacing
    else
     inc(r.Left, Sender.Column[ColIdx].Width);
  end;

end;

After of apply the above code , this is the result

Check the source of the demo project on Github.

UPDATE

This is an old article if you are looking how add vcl styles support to the Menus, dialogs and more try the VCL Styles Utils  project.

The TPopupMenu component has not support for Vcl Styles directly, so if you use this control in a form with Vcl Styles enabled you will get a result like this.

To fix this you have 2 ways :

1. Write a style hook for a TPopUpMenu (The hard way)
2. Or use the TPopupActionBar component (the easy way)

In this post I will show you how use the option 2, taking advantage of two facts

1. The TPopupActionBar component has full support for Vcl Styles
2. Descends directly from the TPopupMenu component.

So adding the Vcl.ActnPopup unit to your project and using a interposer class (before of the form declaration which contains the PopupMenu), you can add vcl styles to the TPopupMenu component.

uses Vcl.ActnPopup;
type TPopupMenu=class(Vcl.ActnPopup.TPopupActionBar);

This is the result after of add the 2 above lines of code.