我有个资料，看看这个控件怎么样？？
baxp(一头雾水) (2001-4-15 12:15:00) 得0分
以前做显示屏的时候做的，试试看
可以选择路径，速度，停留时间！
unit aledtextclass;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,stdctrls,fileoperdll,ledtextdialog,aledcommonfuc;
type
TTextMoveStyle=(msdown,msup);
{关键点结构}
{ keypoint=record
locate : tpoint;
//关键点位置
waittime : integer;
//在关键点停留时间
speed : integer;
//从本点出发的速度
end;
}
{文字对象}
TLedText=class(TLabel)
public
code : string;
//对象唯一标志符
starttime : integer;
//开始演播时间
totalpath : integer;
//关键点总数
path : array of keypoint;
//关键点数组
oldpage : integer;
//上次中断帧
stime : extended;
selected : boolean;
//是否被选中
showpath : boolean;
//是否显示路径
mousedown:boolean;
//鼠标是否被按下
oldx,oldy:integer;
newtext:boolean;
//新建文本
times:integer;
published
properdlg:Tledtextproperdlg;
constructor Create(AOwner : TComponent);
override;
destructor destroy;
override;
procedure WMSetFocus(var Message: TWMLBUTTONUP);
message WM_LBUTTONUP;
procedure WMPaint(var Message: TWMPaint);
message WM_Paint;
procedure WMLButtonDown(var Message: TWMLBUTTONDOWN);
message WM_LBUTTONDOWN;
procedure WMMOUSEMOVE(var Message: TWMMOUSEMOVE);
message WM_MOUSEMOVE;
function savetostrings:tstrings;
procedure loadfromstrings(strs:tstrings);
procedure setnamestr(str:string);
procedure setselected(sel:boolean);
function GetNameStr:string;
public
{显示设置对话框}
function SetProperty:boolean;
function GetStep(curpage: integer;var step:integer): integer;
{对象演示函数}
procedure play(curpage:integer;cas:tcanvas);
end;
function GetPoint(t:extended;s:integer;p1,p2:tpoint):tpoint;
function GetTwoPointLength(p1,p2:tpoint):extended;
implementation
uses unit1,main;
{ TLedText }
constructor TLedText.Create(AOwner: TComponent);
begin
inherited;
times:=0;
showpath:=true;
end;
destructor TLedText.destroy;
begin
inherited;
end;
{
返回值：-1 表示不在该路径的内部
0 表示处于某点的等待状态
1 表示处于某段
}
function TLedText.GetNameStr: string;
var
str:string;
sel:integer;
begin
getcontrolnamestr(name);
result:=str;
end;
function TLedText.GetStep(curpage: integer;var step:integer): integer;
var
i:integer;
temptotaltime,t,totaltime:extended;
begin
{计算每段需要花费的时间}
if totalpath<=1 then
begin
result:=-1;
exit;
end;
totaltime:=starttime;
for i:=0 to totalpath-2do
begin
totaltime:=totaltime+path.waittime;
{如果在某点的等待时间内}
if curpage<=totaltime then
begin
result:=0;
exit;
end;
{计算当前点到下一点需要的时间}
t:=gettwopointlength(path.locate,path[i+1].locate) /path.speed ;
temptotaltime:=totaltime;
totaltime:=totaltime+t;
{在两点中间时候}
if curpage<=totaltime then
begin
stime:=curpage*1.0-temptotaltime;
step:=i+1;
result:=1;
exit;
end;
end;
result:=-1;
end;
procedure TLedText.loadfromstrings(strs: tstrings);
var
i:integer;
str:string;
begin
if strs.count<6 then
exit;
font.name:=strs[1];
font.height:=strtoint(strs[2]);
font.color:=strtoint(strs[3]);
left:=strtoint(strs[4]);
top:=strtoint(strs[5]);
if strs[6]='不透明' then
transparent:=false
else
transparent:=true;
caption:='';
str:='';
for i:=0 to strs.count-8do
begin
if i=strs.count-8 then
str:=str+strs[i+7]
else
str:=str+strs[i+7]+#13+#10;
end;
caption:=str;
end;
procedure TLedText.play(curpage:integer;cas:tcanvas);
var
i,step,ret:integer;
p:tpoint;
begin
{计算在时刻 curpage 时文字应处于的位置}
ret:=GetStep(curpage,step);
// form1.Label4.caption:=inttostr(step);
if (ret=-1) then
begin
left:=path[0].locate.x;
top:=path[0].locate.y;
end;
if ret<>1 then
exit;
{获取文本位置}
if step=2 then
begin
end;
p:=GetPoint(stime,path[step-1].speed,path[step-1].locate,path[step].locate);
left:=p.x;
top:=p.y;
// form1.label1.caption:='x:'+inttostr(left);
// form1.label2.caption:='y:'+inttostr(top);
end;
function TLedText.savetostrings: tstrings;
var
strs:tstrings;
i:integer;
str,tempstr:string;
begin
strs:=tstringlist.create;
strs.add('[文本]');
strs.Add(font.name);
strs.add(inttostr(font.height));
strs.add(inttostr(font.color));
strs.add(inttostr(left));
strs.add(inttostr(top));
if transparent then
strs.add('透明')
else
strs.add('不透明');
strs.add(caption);
result:=strs;
end;
procedure TLedText.setnamestr(str: string);
var
tempstr:string;
begin
tempstr:=copy(name,1,4);
name:=tempstr+str;
end;
function TLedText.SetProperty:boolean;
var
strs:tstrings;
sel,i,ret:integer;
str:string;
begin
application.CreateForm(Tledtextproperdlg,properdlg);
try
showpath:=false;
ledtextdialog.ledtransparent:=transparent;
properdlg.Memo1.font:=font;
properdlg.memo1.lines.clear;
properdlg.editstart.text:=inttostr(starttime);
if not newtext then
begin
properdlg.memo1.lines.add(Caption);
properdlg.Edit1.text:=getcontrolnamestr(name);
end;
properdlg.edit1.text:=getcontrolnamestr(name);
{设置运动属性}
ledtextdialog.totalpath:=totalpath;
setlength(ledtextdialog.path,totalpath);
for i:=0 to totalpath-1do
begin
ledtextdialog.path.locate:=path.locate;
ledtextdialog.path.waittime:=path.waittime;
ledtextdialog.path.speed:=path.speed;
end;
unit1.showpath:=true;
if totalpath<>0 then
begin
properdlg.pathcombox.Items.clear;
for i:=0 to totalpath-1do
begin
properdlg.pathcombox.Items.add(inttostr(i+1));
end;
end
else
begin
properdlg.pathcombox.items.clear;
properdlg.Editx.text:='';
properdlg.Edity.text:='';
properdlg.Editspeed.text:='';
properdlg.Editstay.text:='';
end;
properdlg.newtext:=newtext;
properdlg.textname:=getcontrolnamestr(name);
if newtext then
begin
properdlg.memo1.font.color:=clred;
end;
ret:=properdlg.showmodal;
str:=caption;
caption:='';
code:=properdlg.Edit1.text;
if ret=mrok then
result:=true else
result:=false;
if ret<>mrok then
begin
caption:=str;
exit;
end;
strs:=properdlg.memo1.lines;
for i:=0 to strs.count-1do
begin
if i<>strs.count-1 then
begin
caption:=caption+strs+#13+#10;
end
else
caption:=caption+strs;
end;
transparent:=properdlg.transbtn.checked;
font:=ledtextdialog.ledfont;
setcontrolnamestr(name,properdlg.edit1.text);
{设置开始时间}
{设置路径属性}
totalpath:=ledtextdialog.totalpath;
setlength(path,totalpath);
for i:=0 to totalpath-1do
begin
path.locate:=ledtextdialog.path.locate;
path.waittime:=ledtextdialog.path.waittime;
path.speed:=ledtextdialog.path.speed;
end;
showhint:=true;
hint:=code;
finally
properdlg.Destroy;
showpath:=false;
form1.Invalidate;
selected:=true;
end;
end;
procedure TLedText.setselected(sel: boolean);
var
str1,str2:string;
len:integer;
begin
name:=setcontrolselected(name,sel);
end;
procedure TLedText.WMLButtonDown(var Message: TWMLBUTTONDOWN);
begin
inherited;
mousedown:=true;
oldx:=mouse.cursorpos.x;
oldy:=mouse.cursorpos.y;
end;
procedure TLedText.WMMOUSEMOVE(var Message: TWMMOUSEMOVE);
var
p,p1:tpoint;
begin
inherited;
if mousedown then
begin
{将文本移动到指定位置}
p:=mouse.CursorPos;
left:=left+p.x-oldx;
top:=top+p.y-oldy;
oldx:=p.x;
oldy:=p.y;
end;
end;
procedure TLedText.WMPaint(var Message: TWMPaint);
var
rect:trect;
r,g,b,i:integer;
begin
inherited;
{}
rect.left:=0;
rect.Top:=0;
rect.Right:=width;
rect.bottom:=height;
if selected then
begin
canvas.Brush.Style:=bsclear;
canvas.Pen.Style:=psDot;
canvas.pen.color:=clwhite+10;
canvas.Rectangle(rect);
end;
showpath:=false;
if showpath then
begin
form1.canvas.moveto(path[0].locate.x,path[0].locate.y);
for i:=1 to totalpath-1do
begin
if totalpath=0 then
break;
{画路径线}
form1.canvas.Pen.color:=clred;
form1.Canvas.lineto(path.locate.x,path.locate.y);
form1.canvas.moveto(path.locate.x,path.locate.y);
end;
end;
end;
procedure tledtext.WMSetFocus(var Message: TWMLBUTTONUP);
begin
inherited;
mousedown:=false;
selected:=not selected;
Invalidate;
{如果处于文字状态则修改}
setselected(selected);
if mainform.textbutton.down then
begin
newtext:=false;
setproperty;
end;
end;
{通用函数}
{计算两点已经经历的时间的位置}
function GetPoint(t:extended;s:integer;p1,p2:tpoint):tpoint;
var
p:tpoint;
thr,temp,len,tempreal:real;
intx,floatx:integer;
thrthr:real;
begin
if (p2.x=p1.x) then
begin
end;
temp:=(p2.y-p1.y) / (p2.x-p1.x);
tempreal:=temp;
thr:=arctan(abs(temp));
thrthr:=thr;
if tempreal>0 then
begin
if p1.x>p2.x then
temp:=p1.x-(t*s)*cos(thrthr)
else
temp:=p1.x+(t*s)*cos(thrthr);
val(floattostr(temp),intx,floatx);
p.x:=intx;
if p1.y>p2.y then
temp:=p1.y-(t*s)*sin(thrthr)
else
temp:=p1.y+(t*s)*sin(thrthr);
val(floattostr(temp),intx,floatx);
p.y:=intx;
end
else
begin
if p1.x>p2.x then
temp:=p1.x-(t*s)*cos(thrthr)
else
temp:=p1.x+(t*s)*cos(thrthr);
val(floattostr(temp),intx,floatx);
p.x:=intx;
if p1.y>p2.y then
temp:=p1.y-(t*s)*sin(thrthr)
else
temp:=p1.y+(t*s)*sin(thrthr);
val(floattostr(temp),intx,floatx);
p.y:=intx;
end;
result:=p;
end;
{计算当前时刻位于哪两点之中}
function GetTwoPointLength(p1,p2:tpoint):extended;
var
x:extended;
begin
x:=sqr(p2.y-p1.y)+sqr(p2.x-p1.x);
result:=sqrt(x);
end;
end.
