I have a TabControl
in which each tab represents a distinct set of data. My application uses VCL Styles
, and thus setting OwnerDraw
to True
does not lead to OnDrawTab
being called. I was wondering if it is possible to somehow intercept the routine which draws a specific control using VCL Styles
(in my case, TabControl
), and change the way the control is drawn (for instance, change the Canvas.Font
, etc.).
可以将文章内容翻译成中文,广告屏蔽插件可能会导致该功能失效(如失效,请关闭广告屏蔽插件后再试):
问题:
回答1:
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.
Try this sample
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.
And this is the result
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
- Added border to TTabColorControlStyleHook
- Check the code of the Vcl.Styles.ColorTabs unit, which is part of the vcl styles utils project.
- How can i change text color of themed TabSheet caption?