初学者，大家帮帮忙吧，谢谢(在线等待)

[ADWARDS00]

一个让CAPTION里面的字滚动的LABEL。不过问题是当这些字还没完成一次滚动前，FORM上的其他控件都无法使用，也就是如果这些字反复滚动，那整个FORM上的其他控件都不能使用了，连这个FORM都无法关闭，不知道是不是因为进程的关系？滚动的方法是'beginmove'


unit mylabel;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, StdCtrls;

type
movelabel = class(TLabel)
private
{ Private declarations }
protected
{ Protected declarations }
public
constructor create(aowner:tcomponent);override;
destructor Destroy;override;
procedure beginmove;
{ Public declarations }
published
{ Published declarations }
end;

procedure Register;

implementation
constructor movelabel.create(aowner:tcomponent);
begin
inherited create(aowner);
alignment:=tacenter;
update;
end;
destructor movelabel.Destroy;
begin
inherited Destroy;
end;

procedure movelabel.beginmove;
var
text_length,i:integer;
begin
if (length(caption)=0) then
caption:='<<<<<滚动的标签控件>>>>>';
text_length:=length(caption);
for i:=0 to text_length do
begin
text:=copy(caption,2,text_length-1);
update;
sleep(500);
end;
end;


procedure Register;
begin
RegisterComponents('Standard', [movelabel]);
end;

end.

[BlueTrees]

建议用Timer组件，在时间到来的时候处理，你这样处理，主线程根本没有机会处理其他事情，当然看不到

[ADWARDS00]

这个我是用别的代码根据自己想象加工的，要加入TIMER我不知道怎么加，能帮我改一下吗？谢谢

[ADWARDS00]

我想能不能开辟一个进程给控件呢，因为一串字符滚动一次需要不少时间，在这段时间内其他控件都不能使用，我想就算用TIMER也许也未必能解决问题

[BlueTrees]

楼上的，Timer组件基于消息机制的，其他组件消息必然得到响应。

给出了一个完美的解决代码。注意，label的AutoSize设置为False;

unit Unit1;

interface

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

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

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
var
S,Blank:string;
J:Integer;
begin
J:=Label1.Width div Label1.Canvas.TextWidth(' ');
Blank:=StringOfChar(' ',J);
S:=Blank+Edit1.Text;
Label1.Caption:=copy(S,I,Length(S)-I);
I:=(I+1)mod(Length(S));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Timer1.Enabled:=True;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Timer1.Enabled:=False;
end;

end.

[BlueTrees]

修正上面的一个错误
procedure TForm1.Timer1Timer(Sender: TObject);
var
S,Blank:string;
J:Integer;
begin
J:=Label1.Width div Label1.Canvas.TextWidth(' ');
Blank:=StringOfChar(' ',J);
S:=Blank+Edit1.Text;
Label1.Caption:=copy(S,I,Length(S)-I+1);//这里修改为+1，原来没有+1，最后一个字符丢失
I:=(I+1)mod(Length(S));
end;

[ADWARDS00]

狂晕。。。各位大哥误解我的意思了，我上面的代码安装后是一个控件，我是要修改控件的源代码然后封装好，不是通过外部的控件来加工

[sixgj]

………………我也晕~~~~~~~~

[BlueTrees]

我更加晕，你就不能参照我的原理，写出一个元件！！！！！！！！！！？？？

[ADWARDS00]

to ahjoe(强哥)
Application.ProcessMessages();
什么意思？
编译出错，提示application没有声明

[xiaocha]

to ADWARDS00(大拇指)
加入uses forms
application就定义了

[ahjoe]

改,把Sleep改为Delay：
procedure Delay(msec: integer);
var
endtime: integer;
begin
endtime := GetTickCount() + msec;
While endtime > GetTickCount() do
Application.ProcessMessages();
end;

procedure movelabel.beginmove;
var
text_length,i:integer;
ScrollText: string;
begin
if (length(caption)=0) then
ScrollText := '<<<<滚动的标签控件>>>>'
else
ScrollText := caption;
text_length:=length(ScrollText);
for i:=1 to text_length div 2 do
begin
caption := copy(ScrollText, i*2, text_length);
// update;
Delay(500);
end;
end;

[darkhorsedba]

The GetTickCount function retrieves the number of milliseconds that have elapsed since Windows was started.

[gzice]

用线程来完美解决:
unit label1;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, StdCtrls;

type
TMoveThread = class(TThread)
private
FLabel: TLabel;
protected
procedure Execute; override;
public
constructor Create(ALabel: TLabel);
end;

Tmovelabel = class(TLabel)
private
{ Private declarations }
protected
{ Protected declarations }
public
constructor create(aowner:tcomponent);override;
destructor Destroy;override;
procedure beginmove; //此过程被修改了
{ Public declarations }
published
{ Published declarations }
end;

procedure Register;

implementation

{ TMoveThread }

constructor TMoveThread.Create(ALabel: TLabel);
begin
FLabel := ALabel;
FreeOnTerminate := True;
inherited Create(False);
end;

procedure TMoveThread.Execute;
var
text_length,i:integer;
begin
if (length(FLabel.caption)=0) then
FLabel.caption:='<<<<<滚动的标签控件>>>>>';
text_length:=length(FLabel.caption);
for i:=0 to text_length do
begin
if Terminated then Break;
FLabel.Caption:=copy(FLabel.caption,2,text_length-1);
FLabel.update;
sleep(500);
end;
end;

{ TTmovelabel}

constructor Tmovelabel.create(aowner:tcomponent);
begin
inherited create(aowner);
alignment:=tacenter;
update;
end;
destructor Tmovelabel.Destroy;
begin
inherited Destroy;
end;

procedure Tmovelabel.beginmove;
{var
text_length,i:integer;
begin
if (length(caption)=0) then
caption:='<<<<<滚动的标签控件>>>>>';
text_length:=length(caption);
for i:=0 to text_length do
begin
text:=copy(caption,2,text_length-1);
update;
sleep(500);
end;}
begin
TMoveThread.Create(Self);
end;


procedure Register;
begin
RegisterComponents('Standard', [Tmovelabel]);
end;

end.

[gzice]

调用:
procedure TForm1.Button1Click(Sender: TObject);
begin
if not Assigned(FMoveLabel) then
begin
FMoveLabel := TMoveLabel.Create(Self);
FMoveLabel.Parent := Self;
FMoveLabel.Left := 200;
FMoveLabel.Top := 200;
end;
FMoveLabel.beginmove;
end;

[gzice]

已经解决,请给分

[ADWARDS00]

恩，出现一个问题，就是滚动后控件的CAPTION没能刷新，还有残留字符。不知道为什么
还有FLabel: TLabel;为什么要这个变量呢？有什么用？
不能直接用MOVELABEL1代替吗？

[ADWARDS00]

还有很奇怪的事情，我每点一次，移动速度就会快一些。这是什么缘故

[bitsbird]

大拇指兄的对科学一丝不苟的态度，真叫小弟佩服！

[ADWARDS00]

to ahjoe(强哥)
线程占用的问题还是没解决
TO BlueTrees(蜗牛)
呵呵，我不知道元件是怎么回事

[ADWARDS00]

GetTickCount() 在这里有什么用？