Fixing a VCL Style bug in the TPageControl and TTabControl components

November 28, 2011 by Rodrigo 6 Comments

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.