Question

美好的一天！

我需要在TPageControl中更改某些TabSheet标题的文本颜色。照片上有这样的东西

enter image description here

我知道如何使用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;

我得到了这个

enter image description here

（左 - 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;

这就是结果。

enter image description here

如何更改主题选项卡表标题的文本颜色？

1 个答案: