首页  编辑  

字幕控件

Tags: /超级猛料/VCL/Control.控件使用开发和第三方控件/自定义控件/   Date Created:

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-2 do

   begin

     totaltime:=totaltime+path[i].waittime;

     {如果在某点的等待时间内}

     if curpage<=totaltime then

       begin

         result:=0;

         exit;

       end;

     {计算当前点到下一点需要的时间}

       t:=gettwopointlength(path[i].locate,path[i+1].locate) /path[i].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-8 do

 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-1 do

   begin

     ledtextdialog.path[i].locate:=path[i].locate;

     ledtextdialog.path[i].waittime:=path[i].waittime;

     ledtextdialog.path[i].speed:=path[i].speed;

   end;

   unit1.showpath:=true;

 if totalpath<>0 then

   begin

     properdlg.pathcombox.Items.clear;

     for i:=0 to totalpath-1 do

     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-1 do

   begin

   if i<>strs.count-1 then

     begin

     caption:=caption+strs[i]+#13+#10;

     end

       else caption:=caption+strs[i];

   end;

 transparent:=properdlg.transbtn.checked;

 font:=ledtextdialog.ledfont;

 setcontrolnamestr(name,properdlg.edit1.text);

 {设置开始时间}

 {设置路径属性}

 totalpath:=ledtextdialog.totalpath;

   setlength(path,totalpath);

     for i:=0 to totalpath-1 do

   begin

     path[i].locate:=ledtextdialog.path[i].locate;

     path[i].waittime:=ledtextdialog.path[i].waittime;

     path[i].speed:=ledtextdialog.path[i].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-1 do

     begin

       if totalpath=0 then break;

       {画路径线}

       form1.canvas.Pen.color:=clred;

       form1.Canvas.lineto(path[i].locate.x,path[i].locate.y);

       form1.canvas.moveto(path[i].locate.x,path[i].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.