Fixing a VCL Style bug in the TPageControl and TTabControl components
Update : this bug was fixed in the Update 4 of Delphi XE2.
The BUG
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 ;).
