Можно ли изменить цвет вкладок TTabSheet? - PullRequest
Новая
       50

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

4 голосов
/ 18 февраля 2012

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

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

enter image description here

1 Ответ

4 голосов
/ 21 февраля 2012

Если вам достаточно немного сложного решения , работающего только в 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;

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

enter image description here

...