Можно ли изменить цвет вкладок TTabSheet

Я использую Лазарус 0.9.30.2. У меня есть TForm, на котором есть TPageControl. В TPageControl есть ряд TTabSheets (около 30 из них). Что я хочу сделать, так это раскрасить вкладки, чтобы первые 10 были красными, следующие 10 — синими, а последние 10 — зелеными. Я видел фрагменты кода в интрасети, которые меняют цвет листа вкладки (включая саму вкладку), когда вы нажимаете на них и переходите к ним (чтобы выделить активную вкладку), но я хочу раскрасить их, как описано выше, когда вкладки загружаются первыми.

Есть ли способ сделать это?

введите здесь описание изображения


delphi lazarus ttabsheet
person user1174918    schedule 18.02.2012    source источник
comment
Здравствуйте, я не уверен, что понял ваш вопрос. Вы пытались использовать TTabControl вместо этого? Опубликованы необходимые OnDrawTab события. Лазарь имеет от Delphi другого TPageControl предка.   -  person TLama    schedule 20.02.2012
comment
Я хочу сделать что-то вроде этого минимально воспроизводимый пример imgur.com/cNMko   -  person user1174918    schedule 21.02.2012
comment
Это действительно здорово @TLama..... это нормально для того, что я хочу делать. Очень признателен.   -  person user1174918    schedule 22.02.2012

Ответы (1)


arrow_upward
4
arrow_downward

Если вам достаточно сложного решения, работающего только в Windows с отключенными темами, попробуйте следующее:

Снимите флажок с параметра Use manifest file to enable themes (Windows only) в диалоговом окне настроек проекта Project / Project Options ... и вставьте следующий код в свой блок с управлением страницей. Он использует вставленный класс, поэтому он будет работать только в модулях, в которые вы вставите этот код.

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;

Вот как это выглядит (некрасиво :)

введите здесь описание изображения

person TLama    schedule 21.02.2012