Come posso cambiare il colore del testo della didascalia TabSheet a tema?

Question

Buona giornata!

Ho bisogno di cambiare il colore del testo della didascalia di alcuni TabSheet in TPageControl. Qualcosa di simile sulla foto

so come può essere fatto utilizzando OnDrawTab. Ma se ho abilitato OwnerDraw, la decorazione di Windows XP Theme scompare. Ecco perché provo a disegnare questa decorazione manualmente. Questo è il modo ho cercato di fare questo:

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; 

E ho ottenuto questo

(sinistra - Versione OwnerDraw, a destra - draw di default)

Come si può vedere, TabSheets avere dei confini che non sono stati cancellati. E non posso superare questi confini.

Come posso disegnare lo sfondo della scheda correttamente (come PageControl a destra)?

Answer 1

Una possibile soluzione è l'override del metodo PaintWindow del TPageControl invece di utilizzare il proprietario, in questo modo è possibile controllare ogni aspetto visivo delle schede.

Controllare questo campione di base.

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; 

E questo è il risultato.