文字走马灯效果
作者: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.