如何做滚动的字框(50分)

俺想做这样个控件，一个平滑滚动的字框（就相WINAMP中的），我用MEMO和TIMER做，但效果不好有别的法子吗！
THANK U！

用richedit，这样在颜色上可能比较好一点，也没有什么抖动了，结合timer
就完美了，我已经试过了，效果好好！！！！！！！！！

unit YDONGScrollLabel;


interface

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

type
Directiontype=(FromLeftToRight,FromRightToLeft);

TYDONGScrollLabel = class(TLabel)
private
{ Private declarations }
fflag:boolean;
fhold:integer;
FDirection:directiontype;
FTimer:Ttimer;
FScroll:boolean;
Finterval:integer;
Foldcaption:string;
FLastScroll:string;
procedure ftimertimer(sender:tobject);
function Autoscroll:string;
protected
{ Protected declarations }
public
{ Public declarations }
constructor create(aowner:tcomponent); override;
procedure BeginScroll;
Procedure EndScroll;
published
{ Published declarations }
property Direction:directiontype read fdirection write fdirection;
property Interval:integer read finterval write finterval;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('ydong', [TYDONGScrollLabel]);
end;


constructor tydongscrolllabel.create(aowner:tcomponent);
begin
inherited create(aowner);
finterval:=200;
fscroll:=false;
fdirection:=fromlefttoright;
fflag:=false;
flastscroll:='';
end;

procedure tydongscrolllabel.BeginScroll;
var
oldwidth,i:integer;
s:string;
begin
foldcaption:=caption;
fflag:=false;
if fscroll then exit
else
begin
ftimer:=ttimer.Create(self);
ftimer.Enabled:=false;
ftimer.OnTimer:=ftimertimer;
ftimer.Interval:=finterval;
if not autosize then
begin
oldwidth:=width;
s:=caption;
autosize:=true;
update;
fhold:=(length(caption)*oldwidth) div width;
if fhold>length(caption) then
begin
setlength(s,fhold);
for i:=length(caption)+1 to fhold do
s:=' ';
caption:=s;
end
else
begin
fflag:=true;
caption:=foldcaption;
end;
autosize:=false;
width:=oldwidth;
update;
end;
ftimer.Enabled:=true;
fscroll:=true;
flastscroll:=caption;
end;
end;

procedure tydongscrolllabel.EndScroll;
begin
if not fscroll then exit
else
begin
ftimer.Enabled:=false;
ftimer.free;
fscroll:=false;
end;
end;


function tydongscrolllabel.Autoscroll:string;
var
ch1,ch2:char;
i:integer;
size:integer;
s:string;
begin
s:=flastscroll;
// s:=caption;
size:=length(s);
if fdirection=fromrighttoleft then
begin
ch1:=s[size];
if ord(s[1])>161 then
begin
ch2:=s[size-1];
s[size-1]:=s[1];
s[size]:=s[2];
for i:=1 to size-4 do
s:=s[I+2];
s[size-2]:=ch1;
s[size-3]:=ch2;
end
else
begin
s[size]:=s[1];
for i:=1 to size-2 do
s:=s[i+1];
s[size-1]:=ch1;
end;
end
else
begin
ch1:=s[1];
if ord(s[size])<=161 then
begin
s[1]:=s[size];
for i:=size downto 3 do
s:=s[i-1];
s[2]:=ch1;
end
else
begin
ch2:=s[2];
s[1]:=s[size-1];
s[2]:=s[size];
for i:=size downto 5 do
s:=s[i-2];
s[3]:=ch1;
s[4]:=ch2;
end;
end;
flastscroll:=s;
result:=s;
end;


procedure tydongscrolllabel.ftimertimer(sender:tobject);
var
s:string;
begin
if fscroll then
begin
if not fflag then caption:=autoscroll
else
begin
s:=autoscroll;
s:=copy(s,1,fhold);
caption:=s;
end;
end;
end;



end.

在 timer1.ontimer事件中使用:

label1.caption:=copy(label1.caption, 2, 255)+label1.Caption[1];

就可以实现了. 不闪动.

如果想要效果更好的, 可以用以下代码:
label1.hide;
label1.caption:=copy(label1.caption, 2, 255)+label1.Caption[1];
label1.show;


要注意的是Timer1.interval不能小于50, 一般设在100以上.
这是人眼的生理原理决定的,图象大于 1/20变化的时候就会看到动感的
东西了, 所以要有滚动的效果,就必须要小于1/20, 使前一图象的
视觉残留完全消失后再显示下一图象.

用 label 就挺好的。

推荐一个现成的BUPACK中的BUScrollText。
http://202.114.98.12/pub/program/bupack13_d5.exe(4.5M,200多个
Components)

如果要使字幕上、下滚动呢？

看你的是一行上下动还是一个字一个字的动，还有字的方向也改？
一行上下动就不用说了，改 Top 就行了。
一个字一行的，中间加#13#10, 然后改Top.
字的方向也改，得找一下。

jackal,用PaintBox,我已EMail给你了！

dexter,收到了！拿分吧！

我也想要一个同样的,dexter 能给我也email一个吗?

dexter
方便的话，也寄我一份，多谢！ a_fi@027.net