Wie kann ich die Textfarbe der thematisierten TabSheet-Beschriftung ändern?

Question

Guten Tag!

Ich muss Textfarbe der Beschriftung einiger TabSheet in TPageControl ändern. So etwas wie dieses Bild

Ich weiß, wie es OnDrawTab gemacht werden kann. Aber wenn ich OwnerDraw aktiviert habe, verschwindet die Dekoration von Windows XP Theme. Deshalb versuche ich diese Dekoration manuell zu zeichnen. Dies ist, wie ich versucht, dies zu tun:

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; 

Und ich habe diese

(links - OwnerDraw Version, rechts - default Unentschieden)

Wie Sie sehen können, tabsheets haben Sie einige Grenzen, die nicht überzeichnet sind. Und ich kann diese Grenzen nicht überzeichnen.

Wie kann ich Hintergrund der Registerkarte richtig (wie PageControl auf der rechten Seite) zeichnen?

Answer 1

Eine mögliche Lösung ist die PaintWindow Methode der TPageControl überschreiben anstelle der OwnerDraw, auf diese Weise können Sie jeden visuellen Aspekt der Registerkarten steuern.

Überprüfen Sie dieses Basisbeispiel.

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; 

Und das ist das Ergebnis.