Delphi XE2 VCL样式，从TLabel删除样式或禁用类外观

问题描述

使用XE2 VCL样式，我想禁用TLabel(或sfTextLabelNormal属性)的外观

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

我已经尝试了其他问题的各种解决方案，例如使用Engine.UnRegisterStyleHook，但没有效果.

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

推荐答案

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

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 DoDrawText method.

更新

这里有一个示例，说明如何替代TLabel的绘制过程.

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;

在使用它之前，以这种方式声明一个 interposer类

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;

这就是结果

这篇关于Delphi XE2 VCL样式，从TLabel删除样式或禁用类外观的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！