是否可以在運行時修改VCL樣式？

我有一個TabControl其中每個選項卡代表一組不同的數據。我的應用程序使用VCL Styles，因此將OwnerDraw設置爲True不會導致調用OnDrawTab。我想知道是否有可能以某種方式攔截使用VCL Styles（在我的案例中爲TabControl）繪製特定控件的例程，並更改繪製控件的方式（例如，更改Canvas.Font等）。是否可以在運行時修改VCL樣式？

來源

2012-10-06 iMan Biglari

見RRUZ問題的答案[標籤頁一個的關閉按鈕不支持VCL風格（http://stackoverflow.com/a/10535145/576719）。您必須爲選項卡圖形引入一個樣式鉤子。 –

@LURD我在'DrawTab（）'過程中用下面的代碼創建了'TTabControlStyleHook'的後代。但它不會在運行時更改字體。我錯過了什麼嗎？ 'procedure TTabControlStyleHookBtnClose.DrawTab（Canvas：TCanvas; Index：Integer）; begin FontColor：= Random（MaxInt）; 繼承; 結束; ' –

如果你按照這個鏈接，[創建-color-tabsheets-with-the-vcl-styles]（http://theroadtodelphi.wordpress.com/2012/04/12/creating-colorful-tabsheets-with-the -vcl-styles /），RRUZ有一個用不同文本顏色繪製標籤的完整示例。 –

要使用vcl樣式更改標籤頁的字體顏色，您必須重寫Vcl.ComCtrls.TTabControlStyleHook樣式掛鉤的DrawTab方法，並使用您自己的代碼繪製標籤並設置顏色字體。

試試這個樣本

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.

這是結果

enter image description here

也存在着很多資源，可以幫助你，當你需要定製使用VCL樣式的標籤頁和組件的PageControl。

Creating colorful tabsheets with the VCL Styles
Added border to TTabColorControlStyleHook
檢查Vcl.Styles.ColorTabs單元，這是vcl styles utils項目的一部分的代碼。
How can i change text color of themed TabSheet caption?

來源

2012-10-06 16:06:27 RRUZ

如果我只想更改TTabbedNotebook的背景色，該怎麼辦？我是否必須輸入一段代碼才能更改顏色？ – Johan

是的。這是唯一可用於自定義「TCustomTabControl」後代且VCL樣式處於活動狀態的方法。 – RRUZ

是否可以在運行時修改VCL樣式？

回答

相關問題