是否可以更改TTabSheet选项卡的颜色

Question

我运行的是Lazarus 0.9.30.2。我有一台上面有TPageControl的TForm。在TPageControl中有一系列的TTabSheets (大约30个)。我想做的是对标签进行颜色编码，因此前10个标签是红色的，接下来的10个标签是蓝色的，最后10个标签是绿色的。我在intranet上看到过代码片段，当你点击它们并导航到它们(以突出显示活动的标签)时，它们会改变标签页的颜色(包括标签本身)，但我想要做的是在第一次加载标签页时如上所述地对它们进行着色。

有没有办法做到这一点？

​

​

Answer 1

如果这足以让你有一点棘手的解决方案，只能在禁用了主题的视窗系统上工作，那么可以尝试以下方法：

取消选中Project / Project Options ...项目设置对话框中的Use manifest file to enable themes (Windows only)选项，并将以下代码粘贴到带有页面控件的单元中。它使用插入的类，因此它只能在粘贴此代码的单元中工作。

uses
  ComCtrls, Windows, LCLType;

type
  TPageControl = class(ComCtrls.TPageControl)
  private
    procedure CNDrawItem(var Message: TWMDrawItem); message WM_DRAWITEM;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  end; 

implementation

procedure TPageControl.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    if not (csDesigning in ComponentState) then
      Style := Style or TCS_OWNERDRAWFIXED;
  end;
end;

procedure TPageControl.CNDrawItem(var Message: TWMDrawItem);
var
  BrushHandle: HBRUSH;
  BrushColor: COLORREF;
begin
  with Message.DrawItemStruct^ do
  begin
    case itemID of
      0: BrushColor := RGB(235, 24, 33);
      1: BrushColor := RGB(247, 200, 34);
      2: BrushColor := RGB(178, 229, 26);
    else
      BrushColor := ColorToRGB(clBtnFace);
    end;
    BrushHandle := CreateSolidBrush(BrushColor);
    FillRect(hDC, rcItem, BrushHandle);
    SetBkMode(hDC, TRANSPARENT);
    DrawTextEx(hDC, PChar(Page[itemID].Caption), -1, rcItem, DT_CENTER or 
      DT_VCENTER or DT_SINGLELINE, nil);
  end;
  Message.Result := 1;
end;

下面是它的样子(丑陋:)

​

​