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.
Pingback: Added border to TTabColorControlStyleHook « The Road to Delphi – a Blog about programming
May 3, 2012 at 1:53 am
nice article
July 4, 2012 at 10:29 am
really nice article, but i’m wondering, how can we do same thing on Delphi XE?
July 4, 2012 at 11:10 am
The Vcl Styles was introduced in Delphi XE2, so you can’t use it in Delphi XE.
September 1, 2013 at 3:32 am
It seems to not work properly.
Background color doesn’t change. If I select any tabsheet, border color changes only after sending window to taskbar. In the second screenshot tabsheet 4 is selected.
September 1, 2013 at 7:07 am
Sorry. It was my mistake. It works perfectly except for “Self.UpdateTab(Page)” that gives me a lot of graphical problems expanding window or sending to taskbar.
Is there any alternative?
July 8, 2014 at 12:59 pm
I was using your vcl styles sample to color the tabsheet on a pagecontrol. It works real nice. But how can I choose wich tab do I want to paint?
Thanks. Sorry I posted on the wrong article before
July 9, 2014 at 12:54 pm
Hi Pablo I can’t figure out what do you mean with “….how can I choose which tab do I want to paint” can you please rephrase you question and/or give a example of what do you want to accomplish?
July 1, 2015 at 10:50 am
Very nice article. But have we need to use a Theme to use this customization ? Can we use it on the default Windows style ?
Thanks.
July 1, 2015 at 11:23 am
Hi David, Sorry but this code only can be used with the VCL Styles.
July 3, 2015 at 5:36 am
Hi, thanks for your answer.
June 1, 2016 at 7:36 am
is is possible just to change font color and style, and use the chosen style to draw the tab. so i only customize a part of it
June 1, 2016 at 1:08 pm
Per, to change the font color you need create a new style hook which descends from the TTabControlStyleHook class and override the DrawTab method.