文字走马灯效果

文字走马灯效果

作者:lzcx

最近碰到的问题,由于Label的Size固定,而Label.caption太长,无法完整显示出来,要求实现文字走马灯效果,依次显示出完整的内容。

文字走马灯效果有几种方法:

1、通过移动Label.Left值实现,但Label会移动。不符合要求

2、不断复制Lable.Caption来实现,对于caption只是ASCII字符的字符串,显示是没问题的,但如果出现中文字符就会产生乱码现象,还有字体的不同也有影响。不符合要求

 

通过一个上午的摆弄,终于整出了一个自适应走马灯效果的程序。自动判断caption的显示长度和label的固定宽度来决定是否实现走马灯效果。下面给出一个走马灯Demo。

 

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Rect: TRect;
    TextWidth: Integer;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Label1.Caption := Edit1.Text;
  TextWidth := Label1.Canvas.TextWidth(Label1.Caption);
  Label1.Caption := '';
  Timer1.Enabled := True;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Label1.Refresh;
  if (Rect.Left + TextWidth <= 0) then Rect.Left := Label1.Width;

  Rect.Left := Rect.Left - 15;
  DrawText(Label1.Canvas.Handle, PChar(Edit1.Text), Length(Edit1.Text), Rect, DT_LEFT);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Rect.Left := 0;
  Rect.Top := 0;
  Rect.Right := Label1.Width;
  Rect.Bottom := Label1.Height;
end;

end.

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值