How can i change text color of themed TabSheet caption?

Question

Good Day!

I need to change text color of caption of some TabSheet in TPageControl. Something like this on picture

I know how it can be done using OnDrawTab. But if i enabled OwnerDraw, decoration of Windows XP Theme disappears. That's why i try to draw this decoration manually. This is how i tried to do this:

procedure TForm1.PageControl1DrawTab(Control: TCustomTabControl;
  TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
  FRect: TRect;
  Text: string;
begin
  FRect := Control.TabRect(TabIndex);
  if Active then
    ThemeServices.DrawElement(Control.Canvas.Handle, ThemeServices.GetElementDetails(ttTabItemHot), FRect)
  else
    ThemeServices.DrawElement(Control.Canvas.Handle, ThemeServices.GetElementDetails(ttTabItemNormal), FRect);
  Text := PageControl1.Pages[TabIndex].Caption;
  Control.Canvas.Brush.Style := bsClear;
  if not Active then
    FRect.Top := FRect.Top + 4;
  DrawText(Control.Canvas.Handle, PChar(Text), Length(Text), FRect, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
end;

And i got this

(left - OwnerDraw version, right - default draw)

As you can see, TabSheets have some borders that's are not overdrawn. And I can't overdraw this borders.

How can i draw background of tab correctly (like PageControl on the right)?

Answer 1

A possible solution is override the PaintWindow method of the TPageControl instead of use the ownerdraw , in this way you can control every visual aspect of the tabs.

Check this basic sample.

type
  TPageControl = class(Vcl.ComCtrls.TPageControl)
  private
    FColorTextTab: TColor;
    procedure  DrawTab(LCanvas: TCanvas; Index: Integer);
    procedure  DoDraw(DC: HDC; DrawTabs: Boolean);
    procedure SetColorTextTab(const Value: TColor);
  protected
    procedure PaintWindow(DC: HDC); override;
  published
    property  ColorTextTab : TColor read FColorTextTab write SetColorTextTab;

  end;

  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    CheckBox1: TCheckBox;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    TabSheet5: TTabSheet;
    TabSheet6: TTabSheet;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
 Math,
 Themes,
 Types;


type
  TCustomTabControlClass = class(TCustomTabControl);

procedure AngleTextOut2(Canvas: TCanvas; Angle: Integer; 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;


{ TPageControl }
procedure TPageControl.DrawTab(LCanvas: 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
      LCanvas.Font       := Font;
      TextFormat         := TTextFormatFlags(Flags);
      LCanvas.Font.Color := LTextColor;
      StyleServices.DrawText(LCanvas.Handle, LDetails, S, R, TextFormat, LCanvas.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.
  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);

  LCanvas.Font.Assign(Font);
  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
    StyleServices.DrawElement(LCanvas.Handle, LDetails, R);
  end;

  //get the index of the image (icon)
  if Self is TCustomTabControl then
    LImageIndex := TCustomTabControlClass(Self).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(LCanvas.Handle, LDetails, LIconRect, Images.Handle, LImageIndex);
  end;

  //draw the text of the tab
  if StyleServices.Available then
  begin
    //StyleServices.GetElementColor(LDetails, ecTextColor, LTextColor);
    LTextColor:=FColorTextTab;

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

procedure TPageControl.DoDraw(DC: HDC; DrawTabs: Boolean);
var
  Details: TThemedElementDetails;
  R: TRect;
  LIndex, SelIndex: Integer;
begin
  Details := StyleServices.GetElementDetails(ttTabItemNormal);
  SelIndex := TabIndex;
  try
    Canvas.Handle := DC;
    if DrawTabs then
      for LIndex := 0 to Tabs.Count - 1 do
        if LIndex <> SelIndex then
         DrawTab(Canvas, LIndex);

    if SelIndex < 0 then
      R := Rect(0, 0, Width, Height)
    else
    begin
      R := TabRect(SelIndex);
      R.Left := 0;
      R.Top := R.Bottom;
      R.Right := Width;
      R.Bottom := Height;
    end;

    StyleServices.DrawElement(DC, StyleServices.GetElementDetails(ttPane), R);

    if (SelIndex >= 0) and DrawTabs then
      DrawTab(Canvas, SelIndex);
  finally
    Canvas.Handle := 0;
  end;
end;

procedure TPageControl.PaintWindow(DC: HDC);
begin
 DoDraw(DC, True);
 //inherited;
end;

procedure TPageControl.SetColorTextTab(const Value: TColor);
begin
  FColorTextTab := Value;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  PageControl1.ColorTextTab:=clGreen;
end;

And this is the result.