加入收藏 | 设为首页 | 会员中心 | 我要投稿 李大同 （https://www.lidatong.com.cn/）- 科技、建站、经验、云计算、5G、大数据,站长网!
当前位置： 首页 > 大数据 > 正文

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

发布时间：2020-12-15 09:52:45 所属栏目：大数据 来源：网络整理
导读：美好的一天！ 我需要在TPageControl中更改某些TabSheet的标题的文本颜色.照片上有这样的东西 我知道如何使用OnDrawTab完成.但如果我启用了OwnerDraw,Windows XP Theme的装饰就会消失.这就是为什么我尝试手动绘制这个装饰.这就是我试图这样做的方式： procedu
美好的一天！

我需要在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)？

解决方法

可能的解决方案是覆盖 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,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,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,-1)
          else
          if (TabPosition = tpBottom) and (Index = TabIndex) then
            OffsetRect(LIconRect,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,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,-1)
    else
    if (TabPosition = tpBottom) and (Index = TabIndex) then
      OffsetRect(LayoutR,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,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,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;

这就是结果.

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!
    相关内容
      推荐文章
        站长推荐
        热点阅读

          【免责声明】本站内容转载自互联网，其发布内容言论不代表本站观点，如果其链接、内容的侵犯您的权益，烦请提交相关链接至邮箱bqsm@foxmail.com我们将及时予以处理。

          建议您使用1920×1080分辨率、谷歌浏览器Google Chrome、Microsoft Edge以获得本站的最佳浏览效果

          Copygight © 2008-2022 https://www.lidatong.com.cn/ All Rights Reserved. 李大同