Ist es möglich, die Farbe von TTabsheet -Registerkarten zu ändern?

Question

Ich betreibe Lazarus 0.9.30.2. Ich habe ein Tform, auf dem es eine tpageControl gibt. Innerhalb des TPageControl gibt es eine Reihe von TTabsheets (etwa 30 davon). Was ich tun möchte, ist Farbcode die Registerkarten, also sind die ersten 10 rot, die nächsten 10 sind blau und die letzten 10 sind grün. Ich habe Code -Snippets auf dem Intranet gesehen, die die Registerkartenblattfarbe (einschließlich der Registerkarte selbst) ändern, wenn Sie darauf klicken und zu ihnen navigieren (um die aktive Registerkarte hervorzuheben). Ich möchte sie jedoch wie oben beschrieben färben, wenn Die Registerkartenblätter werden zuerst geladen.

Gibt es Möglichkeiten, dies zu tun?

Answer 1

Wenn es für Sie ausreicht, um ein bisschen knifflige Lösung zu bekommen Arbeiten nur unter Windows mit deaktivierten Themen Versuchen Sie dann Folgendes:

Nicht überprüft Use manifest file to enable themes (Windows only) Option von Project / Project Options ... Projekteinstellungen Dialogfeld und fügen Sie den folgenden Code mit Seitensteuerung in Ihr Gerät ein. Es verwendet die interponierte Klasse, sodass es nur in Einheiten funktioniert, in denen Sie diesen Code einfügen.

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;

So sieht es aus (hässlich :)