2012-04-03 46 views
3

禁用类剥皮使用XE2 VCL风格,我想禁用换肤的的TLabel(或财产sfTextLabelNormal)德尔福XE2 VCL样式,删除样式或从的TLabel

我已经尝试了所有种类的其他问题的解决方案,如使用Engine.UnRegisterStyleHook,但它没有效果。

+0

用TPaintbox替换TLabel并自定义绘制它可能会稍微不方便。 – 2012-04-03 14:53:07

回答

10

TLabel组件不使用样式挂钩,因为它不是TWinControl后代,因此您不能使用UnRegisterStyleHook函数。相反,您必须覆盖 涂料 DoDrawText方法。

UPDATE

在这里,你有一个如何重写的TLabel的烤漆工艺处理的样品。

//declare this code in the implementation part 
uses 
Vcl.Themes, 
Vcl.Styles; 

type 
    TLabelHelper= class helper for TCustomLabel 
    procedure DrawNormalText(DC: HDC; const Text: UnicodeString; var TextRect: TRect; TextFlags: Cardinal); 
    end; 

{ TLabelHelper } 

procedure TLabelHelper.DrawNormalText(DC: HDC; const Text: UnicodeString; 
    var TextRect: TRect; TextFlags: Cardinal); 
begin 
    Self.DoDrawNormalText(DC, Text, TextRect, TextFlags); 
end; 


{ TLabel } 

procedure TLabel.DoDrawText(var Rect: TRect; Flags: Integer); 
const 
    EllipsisStr = '...'; 
    Ellipsis: array[TEllipsisPosition] of Longint = (0, DT_PATH_ELLIPSIS, DT_END_ELLIPSIS, DT_WORD_ELLIPSIS); 
var 
    Text, DText: string; 
    NewRect: TRect; 
    Height, Delim: Integer; 
begin 
    Text := GetLabelText; 
    if (Flags and DT_CALCRECT <> 0) and 
    ((Text = '') or ShowAccelChar and (Text[1] = '&') and (Length(Text) = 1)) then 
    Text := Text + ' '; 

    if Text <> '' then 
    begin 
    if not ShowAccelChar then Flags := Flags or DT_NOPREFIX; 
    Flags := DrawTextBiDiModeFlags(Flags); 
    Canvas.Font := Font; 
    if (EllipsisPosition <> epNone) and not AutoSize then 
    begin 
     DText := Text; 
     Flags := Flags and not DT_EXPANDTABS; 
     Flags := Flags or Ellipsis[EllipsisPosition]; 
     if WordWrap and (EllipsisPosition in [epEndEllipsis, epWordEllipsis]) then 
     begin 
     repeat 
      NewRect := Rect; 
      Dec(NewRect.Right, Canvas.TextWidth(EllipsisStr)); 
      DrawNormalText(Canvas.Handle, DText, NewRect, Flags or DT_CALCRECT); 
      Height := NewRect.Bottom - NewRect.Top; 
      if (Height > ClientHeight) and (Height > Canvas.Font.Height) then 
      begin 
      Delim := LastDelimiter(' '#9, Text); 
      if Delim = 0 then 
       Delim := Length(Text); 
      Dec(Delim); 
      if ByteType(Text, Delim) = mbLeadByte then 
       Dec(Delim); 
      Text := Copy(Text, 1, Delim); 
      DText := Text + EllipsisStr; 
      if Text = '' then 
       Break; 
      end else 
      Break; 
     until False; 
     end; 
     if Text <> '' then 
     Text := DText; 
    end; 

    if Enabled or StyleServices.Enabled then 
     DrawNormalText(Canvas.Handle, Text, Rect, Flags) 
    else 
    begin 
     OffsetRect(Rect, 1, 1); 
     Canvas.Font.Color := clBtnHighlight; 
     DrawNormalText(Canvas.Handle, Text, Rect, Flags); 
     OffsetRect(Rect, -1, -1); 
     Canvas.Font.Color := clBtnShadow; 
     DrawNormalText(Canvas.Handle, Text, Rect, Flags); 
    end; 
    end; 
end; 

之前使用它以这种方式

TLabel = class (Vcl.StdCtrls.TLabel) 
    procedure DoDrawText(var Rect: TRect; Flags: Longint); override; 
    end; 

声明中介类这是结果

enter image description here

+0

你能否给我一个覆盖它的例子?只是保持字体的颜色等就足够了。谢谢。 – hikari 2012-04-03 20:09:02

+1

好的,添加了示例。 – RRUZ 2012-04-03 21:01:32

+0

太棒了,完美的作品! Tyvm :) – hikari 2012-04-03 21:33:48

1

一些modyfication RRUZ的解决方案(完整的组成部分,少写作):

type 
    TjsLabel = class(TLabel) 
    private 
     FDisableTheme: Boolean; 
     procedure SetDisableTheme(const Value: Boolean); 
    protected 

    public 
     procedure Invalidate;override; 
    published 
     property DisableTheme:Boolean read FDisableTheme write SetDisableTheme; 
    end; 


procedure Register; 

implementation 
uses Themes, Styles; 

type 
    TLabelHelper = class helper for TCustomLabel 
     procedure SetThemeBehavior(const AEnableTheme:Boolean); 
    end; 

    procedure Register; 
    begin 
     RegisterComponents('JS', [TJSLabel]); 
    end; 


    procedure TJSLabel.Invalidate; 
    begin 
     SetThemeBehavior(not DisableTheme); 
     inherited; 
    end; 


    procedure TJSLabel.SetDisableTheme(const Value: Boolean); 
    begin 
     if FDisableTheme <> Value then 
     begin 
     FDisableTheme := Value; 
     SetThemeBehavior(not Value); 
     end; 
    end; 

    { TLabelHelper } 

    procedure TLabelHelper.SetThemeBehavior(const AEnableTheme: Boolean); 
    begin 
     Self.FDrawTextProc := Self.DoDrawNormalText; 
     if AEnableTheme then 
     if StyleServices.Enabled then 
      Self.FDrawTextProc := Self.DoDrawThemeTextEx 
    end;