是否可以更改TTabSheet标签的颜色 [英] Is it possible to change the colour of TTabSheet tabs

问题描述

我正在运行拉撒路0.9.30.2. 我有一个TForm，上面有一个TPageControl.在TPageControl中，有一系列TTabSheets(其中约有30个).我想要做的是对选项卡进行颜色编码，因此前10个是红色，接下来的10个是蓝色，最后10个是绿色.我在Intranet上看到过一些代码片段，当您单击它们并导航到它们(以突出显示活动的选项卡)时，它们会更改选项卡工作表的颜色(包括选项卡本身)，但是我要做的是如上所述地为它们着色标签页首先被加载.

I am running Lazarus 0.9.30.2. I have a TForm on which there is a TPageControl. Within the TPageControl there is a series of TTabSheets (about 30 of them). What I want to do is colour code the tabs, so the first 10 are Red, next 10 are Blue and the last 10 are Green. I have seen code snippets on the intranet that change the tab sheet colour (including the tab itself) when you click on them and navigate to them (to highlight the active tab), but what I want to do is colour them as described above when the tab sheets are first loaded.

有办法吗?

推荐答案

如果您足以获得一些棘手的解决方案，则 仅在禁用了主题的Windows上可以使用 然后尝试以下操作:

If it's enough for you to get a little bit tricky solution working only on Windows with themes disabled then try the following:

从Project / Project Options ...项目设置对话框中取消选中Use manifest file to enable themes (Windows only)选项，然后将以下代码通过页面控件粘贴到您的单元中.它使用插入的类，因此它将仅在粘贴此代码的单元中起作用.

Un-check the Use manifest file to enable themes (Windows only) option from Project / Project Options ... project settings dialog and paste the following code into your unit with page control. It uses the interposed class, so it will work only in units where you paste this code.

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;

这是它的样子(丑陋:)

Here is how it looks like (ugly :)

这篇关于是否可以更改TTabSheet标签的颜色的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！