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.

Answer 2

There is an option in delphi 11(not sure about older versions) to change the TPageControl caption color Select the required font color in the properties Then in the style elements property unselect the seFont to false and then Build