Можно ли изменить цвет шрифта заголовка вкладки TTabSheet?
Просто ответьте на этот вопрос здесь => ссылка. Можно ли изменить цвет текста надписи TabSheet на другой цвет (например, белый) и изменить стиль шрифта на "жирный"?
1 ответ
Решение
Может быть, это может дать вам такое вдохновение. Опять же, обратите внимание, что это будет работать только в Windows и с темами, отключенными в вашем приложении.
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
FontHandle: HFONT;
FontColor: COLORREF;
FontObject: TLogFont;
BrushColor: COLORREF;
BrushHandle: HBRUSH;
begin
with Message.DrawItemStruct^ do
begin
GetObject(Font.Handle, SizeOf(FontObject), @FontObject);
case itemID of
0:
begin
BrushColor := RGB(235, 24, 33);
FontColor := clWhite;
FontObject.lfWeight := FW_NORMAL;
FontObject.lfItalic := 0;
end;
1:
begin
BrushColor := RGB(247, 200, 34);
FontColor := clGreen;
FontObject.lfWeight := FW_NORMAL;
FontObject.lfItalic := 1;
end;
2:
begin
BrushColor := RGB(178, 229, 26);
FontColor := clGreen;
FontObject.lfWeight := FW_BOLD;
FontObject.lfItalic := 1;
end
else
BrushColor := ColorToRGB(clBtnFace);
end;
BrushHandle := CreateSolidBrush(BrushColor);
FillRect(hDC, rcItem, BrushHandle);
FontHandle := CreateFontIndirect(FontObject);
try
SelectObject(hDC, FontHandle);
SetTextColor(hDC, FontColor);
SetBkMode(hDC, TRANSPARENT);
DrawTextEx(hDC, PChar(Page[itemID].Caption), -1, rcItem, DT_CENTER or
DT_VCENTER or DT_SINGLELINE, nil);
finally
DeleteObject(FontHandle);
end;
end;
Message.Result := 1;
end;
Вот как это выглядит: