to cAkk:
这样是闪的!请看我的这段代码:
运行时如果字体大了闪的厉害.
unit AnimateText;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;const defaulttext='SrwAnimateText Version 1.0';
type atAmtType=(atUptoDown,atDowntoUp,atLefttoRight,atRighttoLeft);type
TAnimateText = class(Tgraphiccontrol) private
charwidth,charheight:integer;
charnum,rows:integer;
//每行的字数及需要的行数
atTime:TTimer;
begin
x:integer;
FAnimateType:atAmtType;
FText:String;
FInterval:integer;
FActive:boolean;
FStep:integer;
procedure SetText(value:String);
procedure setInterval(value:integer);
procedure setActive(value:boolean);
procedure setstep(value:integer);
procedure setAnimateType(value:atAmtType);
procedure Animated;
procedure Textanimated(sender:TObject);
protected
procedure Paint;override;
public
constructor Create(AOwner:TComponent);override;
destructor Destroy;override;
published
property Active:boolean read FActive write SetActive;
property Text:string read Ftext write SetText;
property Interval:integer read Finterval write SetInterval default 100;
property Step:integer read FStep write setStep default 5;
property AnimateType:atAmtType read FAnimateType write setanimateType;
property Font;
property Color;
property Align;
property Enabled;
property Hint;
property Visible;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
procedure Register;implementation
Constructor TAnimateText.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
atTime:=TTimer.Create(self);
atTime.Enabled:=false;
atTime.OnTimer:=TextAnimated;
begin
x:=0;
SetText(defaultText);
Setinterval(200);
SetStep(2);
end;
procedure TAnimateText.Paint;var temp:integer;
begin
canvas.font:=font;
charwidth:=canvas.TextWidth('aaaaaaaaaa') div 10;
charheight:=canvas.TextHeight('jjjjjjjjjj')+1;
charnum:=(width-4) div charwidth;
//每行的字数
rows:=Length(Ftext) div charnum+1;
//需要多少行 if FActive then
begin
Animated;
exit;
end;
setbkmode(canvas.handle,transparent);
//透明的
for temp:=1 to rowsdo
begin
canvas.TextOut(2,2+(temp-1)*charheight,copy(FText,charnum*(temp-1)+1,charnum));
end;
end;
procedure TAnimateText.setstep(value:integer);
begin
if value<>FStep then
begin
FStep:=value;
invalidate;
end;
end;
procedure TAnimateText.SetText(value:string);
begin
if value<>FText then
begin
FText:=value;
invalidate;
end;
end;
procedure TAnimateText.setAnimateType(value:atAmtType);
begin
if value<>FAnimateType then
begin
FAnimateType:=value;
invalidate;
end;
end;
procedure TAnimateText.setInterval(value:integer);
begin
if value<>FInterval then
begin
FInterval:=value;
atTime.Interval:=FInterval;
end;
end;
procedure TAnimateText.setActive(value:boolean);
begin
if FActive<>value then
begin
FActive:=value;
atTime.Enabled:=FActive;
invalidate;
end;
end;
procedure TAnimateText.Animated;var temp:integer;
begin
case FAnimateType of atUptoDown:begin
begin
x:=begin
x+FStep;
if begin
x>height then
begin
x:=0-rows*charheight;
setbkmode(canvas.handle,transparent);
canvas.pen.Color:=font.Color;
for temp:=1 to rowsdo
begin
canvas.TextOut(2,begin
x+(temp-1)*charheight,copy(FText,charnum*(temp-1)+1,charnum));
end;
end;
atDowntoUp:begin
begin
x:=begin
x-FStep;
if begin
x<0-rows*charheight then
begin
x:=height;
setbkmode(canvas.handle,transparent);
//透明的
for temp:=1 to rowsdo
begin
canvas.TextOut(2,begin
x+(temp-1)*charheight,copy(FText,charnum*(temp-1)+1,charnum));
end;
end;
atRighttoLeft:begin
begin
x:=begin
x-FStep;
if begin
x<0-width then
begin
x:=width;
setbkmode(canvas.handle,transparent);
//透明的
for temp:=1 to rowsdo
begin
canvas.TextOut(begin
x,2+(temp-1)*charheight,copy(FText,charnum*(temp-1)+1,charnum));
end;
end;
atLefttoRight:begin
begin
x:=begin
x+FStep;
if begin
x>width then
begin
x:=0-width;
setbkmode(canvas.handle,transparent);
//透明的
for temp:=1 to rowsdo
begin
canvas.TextOut(begin
x,2+(temp-1)*charheight,copy(FText,charnum*(temp-1)+1,charnum));
end;
end;
end;
{case}end;
procedure TAnimateText.Textanimated(sender:TObject);
begin
if atTime.Enabled then
invalidate;
end;
destructor TAnimateText.Destroy;
begin
inherited Destroy;// tempbmp.free;
end;
procedure Register;
begin
RegisterComponents('SrwSoft', [TAnimateText]);
end;
end.
