是否可以在运行时修改VCL样式? [英] Is it possible to modify VCL styles at runtime?
本文介绍了是否可以在运行时修改VCL样式?的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我有一个TabControl，其中每个选项卡代表一组不同的数据.我的应用程序使用VCL Styles，因此将OwnerDraw设置为True不会导致调用OnDrawTab.我想知道是否有可能以某种方式拦截使用VCL Styles绘制特定控件的例程(在我的情况下为TabControl)，并更改控件的绘制方式(例如，更改Canvas.Font等) ).
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.).
推荐答案
要使用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 - 在TTabColorControlStyleHook中添加了边框
- 检查如何更改主题TabSheet的文本颜色字幕?
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?
这篇关于是否可以在运行时修改VCL样式?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
