Ist es möglich, die Farbe von TTabsheet -Registerkarten zu ändern?
Frage
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?
Lösung
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 :)