【初学者有关问题】如何自己重画TLabel控件，实现Label带下划线？不改字体

【菜鸟问题】怎么自己重画TLabel控件，实现Label带下划线？不改字体
想自己重画Tlabel，让整个控件带个下边框线的效果，但完全没有经验，本人连重写哪个函数都无从查找，也不知道如何去重写。
还是说要自己从TCustomLabel的父类开始弄？
[解决办法]

type
  TUnderLineLabel = class(TLabel)
  protected
      procedure Paint; override;
  end;


procedure TUnderLineLabel.Paint;
begin
  inherited;
  with Canvas do begin
    Pen.Style := psSolid;  //实线
    Pen.Color := clBlack;   //线条颜色
    MoveTo(0 , ClientRect.Bottom-1);
    LineTo(ClientRect.Right,ClientRect.Bottom-1);
  end;
end;

[解决办法]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TmyLabel = class(TLabel)
    procedure Paint; override;
  end;
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TmyLabel }

procedure TmyLabel.Paint;
begin
  inherited;
  self.Canvas.Pen.Color := clred;
  self.Canvas.MoveTo(0,self.Height - 1);
  self.Canvas.LineTo(self.Width,self.Height - 1);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 with TmyLabel.Create(self) do
 begin
      AutoSize := False;
      Caption := '测试';
   Width := 100;
   Height := 13;
   left := 50;

   top := 50;
   Parent := self;
 end;
end;

end.
这个？？？
[解决办法]

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TmyLabel = class(TLabel)
    procedure Paint; override;
    procedure DoDrawText(var Rect: TRect; Flags: Longint);override;
  end;
  TForm1 = class(TForm)
    Button1: TButton;

    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TmyLabel }

procedure TmyLabel.DoDrawText;
begin
  inherited;
  self.Canvas.Pen.Color := clred;
  self.Canvas.MoveTo(0,self.Height - 1);
  self.Canvas.LineTo(self.Width,self.Height - 1);

end;

procedure TmyLabel.Paint;
begin
  inherited;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 with TmyLabel.Create(self) do
 begin
      AutoSize := False;
      Caption := '测试';
   Width := 100;
   Height := 13;
   left := 50;

   top := 50;
   Parent := self;
 end;
end;

end.

不懂你意思。

查看更多 下一篇