我如何更改主题TabSheet标题的文本颜色？

Question

美好的一天！

我需要更改TPageControl中某些TabSheet的标题文字颜色。像这样的东西在画面

我知道如何它可以使用OnDrawTab完成。但是，如果我启用了OwnerDraw，Windows XP Theme的装饰消失了。这就是为什么我尝试手动绘制这种装饰。这是我想做到这一点：

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; 

，我得到这个

（左 - 的OwnerDraw版本，正确的 - 默认平局）

正如你所看到的，TabSheets有一些没有透支的边界。我不能透支这个边界。

如何正确绘制标签背景（如右侧的PageControl）？

Answer 1

一种可能的解决方案是覆盖TPageControl的PaintWindow方法，而不是使用的OwnerDraw，以这种方式就可以控制翼片的每一个视觉方面。

检查这个基本样本。

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; 

这就是结果。