Delphi XE2 VCL styles, remove a style or disable a class skinning from a TLabel

问题

Using XE2 VCL styles, I'd like to disable the skinning for TLabel (or property sfTextLabelNormal)

I've tried all kind of solutions from other questions, like using Engine.UnRegisterStyleHook, but it has no effect.

回答1:

The TLabel component doesn't use styles hooks because is not a TWinControl descendant, so you can't use the UnRegisterStyleHook function. Instead you must override the Paint DoDrawText method.

UPDATE

Here you have a sample of how override the paint process of a 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;

before to use it declare an interposer class in this way

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

And this is the result

回答2:

Some modyfication RRUZ's solution (complete component, less writing):

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;

来源：https://stackoverflow.com/questions/9995080/delphi-xe2-vcl-styles-remove-a-style-or-disable-a-class-skinning-from-a-tlabel