加入收藏 | 设为首页 | 会员中心 | 我要投稿 李大同 (https://www.lidatong.com.cn/)- 科技、建站、经验、云计算、5G、大数据,站长网!
当前位置: 首页 > 大数据 > 正文

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

发布时间:2020-12-15 09:40:15 所属栏目:大数据 来源:网络整理
导读:使用XE2 VCL样式,我想禁用TLabel(或属性sfTextLabelNormal)的外观 我已经尝试过其他问题的所有解决方案,比如使用Engine.UnRegisterStyleHook,但它没有任何效果. 解决方法 TLabel组件不使用样式挂钩,因为它不是 TWinControl后代,因此您无法使用 UnRegisterSty
使用XE2 VCL样式,我想禁用TLabel(或属性sfTextLabelNormal)的外观

我已经尝试过其他问题的所有解决方案,比如使用Engine.UnRegisterStyleHook,但它没有任何效果.

解决方法

TLabel组件不使用样式挂钩,因为它不是 TWinControl后代,因此您无法使用 UnRegisterStyleHook功能.相反,您必须覆盖Paint 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,Rect,Flags)
    else
    begin
      OffsetRect(Rect,1);
      Canvas.Font.Color := clBtnHighlight;
      DrawNormalText(Canvas.Handle,Flags);
      OffsetRect(Rect,-1,-1);
      Canvas.Font.Color := clBtnShadow;
      DrawNormalText(Canvas.Handle,Flags);
    end;
  end;
end;

在使用它之前以这种方式声明一个内插器类

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

这就是结果

(编辑:李大同)

【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容!

    推荐文章
      热点阅读