Is it possible to change the colour of TTabSheet tabs

问题

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.

Is there are way to do this?

回答1:

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

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 :)

来源：https://stackoverflow.com/questions/9340940/is-it-possible-to-change-the-colour-of-ttabsheet-tabs

标签

Delphi

lazarus

ttabsheet