更新时间:2023-02-15 12:42:29
要使用vcl样式更改选项卡的字体颜色,必须覆盖Vcl.ComCtrls.TTabControlStyleHook样式钩子的DrawTab方法,并使用自己的代码绘制选项卡并设置颜色字体.
To change the font color of a tabsheet using the vcl styles, you must override the DrawTab method of the Vcl.ComCtrls.TTabControlStyleHook style hook and use your own code to draw the tab and set the color font.
尝试此示例
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls;
type
TForm1 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
TabSheet5: TTabSheet;
TabSheet6: TTabSheet;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
Vcl.Styles,
Vcl.Themes;
{$R *.dfm}
type
TTabFontColorStyleHook= class(Vcl.ComCtrls.TTabControlStyleHook)
protected
procedure DrawTab(Canvas: TCanvas; Index: Integer); override;
end;
TWinControlClass = class(TWinControl);
TCustomTabControlClass = class(TCustomTabControl);
procedure TTabFontColorStyleHook.DrawTab(Canvas: TCanvas; Index: Integer);
var
LDetails : TThemedElementDetails;
LImageIndex : Integer;
LThemedTab : TThemedTab;
LIconRect : TRect;
R, LayoutR : TRect;
LImageW, LImageH, DxImage : Integer;
LTextX, LTextY: Integer;
LTextColor : TColor;
procedure DrawControlText(const S: string; var R: TRect; Flags: Cardinal);
var
TextFormat: TTextFormatFlags;
begin
Canvas.Font := TWinControlClass(Control).Font;
TextFormat := TTextFormatFlags(Flags);
Canvas.Font.Color := LTextColor;
StyleServices.DrawText(Canvas.Handle, LDetails, S, R, TextFormat, Canvas.Font.Color);
end;
procedure AngleTextOut2(Canvas: TCanvas; Angle, X,
Y: Integer; const Text: string);
var
LSavedDC: Integer;
begin
LSavedDC := SaveDC(Canvas.Handle);
try
SetBkMode(Canvas.Handle, TRANSPARENT);
Canvas.Font.Orientation := Angle;
Canvas.TextOut(X, Y, Text);
finally
RestoreDC(Canvas.Handle, LSavedDC);
end;
end;
begin
if (Images <> nil) and (Index < Images.Count) then
begin
LImageW := Images.Width;
LImageH := Images.Height;
DxImage := 3;
end
else
begin
LImageW := 0;
LImageH := 0;
DxImage := 0;
end;
R := TabRect[Index];
if R.Left < 0 then Exit;
if TabPosition in [tpTop, tpBottom] then
begin
if Index = TabIndex then
InflateRect(R, 0, 2);
end
else if Index = TabIndex then
Dec(R.Left, 2) else Dec(R.Right, 2);
Canvas.Font.Assign(TCustomTabControlClass(Control).Font);
LayoutR := R;
LThemedTab := ttTabDontCare;
//Get the type of the active tab
case TabPosition of
tpTop:
begin
if Index = TabIndex then
LThemedTab := ttTabItemSelected
else if (Index = HotTabIndex) and MouseInControl then
LThemedTab := ttTabItemHot
else
LThemedTab := ttTabItemNormal;
end;
tpLeft:
begin
if Index = TabIndex then
LThemedTab := ttTabItemLeftEdgeSelected
else if (Index = HotTabIndex) and MouseInControl then
LThemedTab := ttTabItemLeftEdgeHot
else
LThemedTab := ttTabItemLeftEdgeNormal;
end;
tpBottom:
begin
if Index = TabIndex then
LThemedTab := ttTabItemBothEdgeSelected
else if (Index = HotTabIndex) and MouseInControl then
LThemedTab := ttTabItemBothEdgeHot
else
LThemedTab := ttTabItemBothEdgeNormal;
end;
tpRight:
begin
if Index = TabIndex then
LThemedTab := ttTabItemRightEdgeSelected
else if (Index = HotTabIndex) and MouseInControl then
LThemedTab := ttTabItemRightEdgeHot
else
LThemedTab := ttTabItemRightEdgeNormal;
end;
end;
//draw the tab
if StyleServices.Available then
begin
LDetails := StyleServices.GetElementDetails(LThemedTab);//necesary for DrawControlText
StyleServices.DrawElement(Canvas.Handle, LDetails, R);
end;
//get the index of the image (icon)
if Control is TCustomTabControl then
LImageIndex := TCustomTabControlClass(Control).GetImageIndex(Index)
else
LImageIndex := Index;
//draw the image
if (Images <> nil) and (LImageIndex >= 0) and (LImageIndex < Images.Count) then
begin
LIconRect := LayoutR;
case TabPosition of
tpTop, tpBottom:
begin
LIconRect.Left := LIconRect.Left + DxImage;
LIconRect.Right := LIconRect.Left + LImageW;
LayoutR.Left := LIconRect.Right;
LIconRect.Top := LIconRect.Top + (LIconRect.Bottom - LIconRect.Top) div 2 - LImageH div 2;
if (TabPosition = tpTop) and (Index = TabIndex) then
OffsetRect(LIconRect, 0, -1)
else
if (TabPosition = tpBottom) and (Index = TabIndex) then
OffsetRect(LIconRect, 0, 1);
end;
tpLeft:
begin
LIconRect.Bottom := LIconRect.Bottom - DxImage;
LIconRect.Top := LIconRect.Bottom - LImageH;
LayoutR.Bottom := LIconRect.Top;
LIconRect.Left := LIconRect.Left + (LIconRect.Right - LIconRect.Left) div 2 - LImageW div 2;
end;
tpRight:
begin
LIconRect.Top := LIconRect.Top + DxImage;
LIconRect.Bottom := LIconRect.Top + LImageH;
LayoutR.Top := LIconRect.Bottom;
LIconRect.Left := LIconRect.Left + (LIconRect.Right - LIconRect.Left) div 2 - LImageW div 2;
end;
end;
if StyleServices.Available then
StyleServices.DrawIcon(Canvas.Handle, LDetails, LIconRect, Images.Handle, LImageIndex);
end;
//draw the text of the tab
if StyleServices.Available then
begin
//here you set the color of the font
LTextColor:=clRed;
if (TabPosition = tpTop) and (Index = TabIndex) then
OffsetRect(LayoutR, 0, -1)
else
if (TabPosition = tpBottom) and (Index = TabIndex) then
OffsetRect(LayoutR, 0, 1);
if TabPosition = tpLeft then
begin
LTextX := LayoutR.Left + (LayoutR.Right - LayoutR.Left) div 2 - Canvas.TextHeight(Tabs[Index]) div 2;
LTextY := LayoutR.Top + (LayoutR.Bottom - LayoutR.Top) div 2 + Canvas.TextWidth(Tabs[Index]) div 2;
Canvas.Font.Color := LTextColor;
AngleTextOut2(Canvas, 900, LTextX, LTextY, Tabs[Index]);
end
else
if TabPosition = tpRight then
begin
LTextX := LayoutR.Left + (LayoutR.Right - LayoutR.Left) div 2 + Canvas.TextHeight(Tabs[Index]) div 2;
LTextY := LayoutR.Top + (LayoutR.Bottom - LayoutR.Top) div 2 - Canvas.TextWidth(Tabs[Index]) div 2;
Canvas.Font.Color := LTextColor;
AngleTextOut2(Canvas, -900, LTextX, LTextY, Tabs[Index]);
end
else
DrawControlText(Tabs[Index], LayoutR, DT_VCENTER or DT_CENTER or DT_SINGLELINE or DT_NOCLIP);
end;
end;
initialization
TStyleManager.Engine.RegisterStyleHook(TCustomTabControl, TTabFontColorStyleHook);
TStyleManager.Engine.RegisterStyleHook(TTabControl, TTabFontColorStyleHook);
end.
这就是结果
还存在一些资源,当您需要使用vcl样式自定义标签页和页面控件组件时,这些资源可以为您提供帮助.
Also exist several resources which can help you when you need customize a tabsheet and pagecontrol components using vcl styles.
Creating colorful tabsheets with the VCL Styles
Creating colorful tabsheets with the VCL Styles