¿Cómo puedo cambiar el color del texto de la leyenda TabSheet temática?

Question

¡Buen día!

Necesito cambiar el color del texto de la leyenda de TabSheet en TPageControl. Algo como esto en la foto

sé lo que se puede hacer utilizando OnDrawTab. Pero si activé OwnerDraw, desaparece la decoración de Windows XP Theme. Es por eso que trato de dibujar esta decoración manualmente. Así es como he intentado hacer esto:

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; 

Y tengo esto

(izquierda - versión OwnerDraw, a la derecha - empate por defecto)

Como se puede ver, TabSheets tener algunas fronteras que no están sobregiradas Y no puedo sobrepasar estas fronteras.

¿Cómo puedo dibujar el fondo de la pestaña correctamente (como PageControl a la derecha)?

Answer 1

Una posible solución es anular el método PaintWindow del TPageControl en lugar de usar el dibujo propietario, de esta manera puede controlar todos los aspectos visuales de las pestañas.

Compruebe esta muestra básica.

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; 

Y este es el resultado.