滚动式的字幕是如何实现的? 请教。 解决方案 » 免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货 用Timer吧比如在memo1中的字幕滚动procedure TForm.TimerTimer(Sender: TObject);beginSendMessage(Memo1.Handle,WM_VSCROLL,SB_LINEDOWN,0)end;如果只是label滚动在timertimer里对label.left 不停赋值(比如每次加10象素)就可以了。你试试吧 unit cwScrollText;interfaceuses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls;//DsgnIntf;type Tdirection=(BottomToTop,TopToBottom); Tposition=(pLeft,pCenter,pRight); TcwScrollText = class(TGraphicControl) private timer:Ttimer;// fAbout:string; nowx,nowy:integer; FFont:TFont; Fbgcolor:Tcolor; Fspeed:Integer; Flines:Tstrings; Fdirection:Tdirection; Fpos:Tposition; Fpicture:Tbitmap; FVisible:boolean; procedure ScrollText(sender:Tobject); procedure SetLines(Value:Tstrings); procedure SetFont(Value:Tfont); procedure Setbgcolor(Value:Tcolor); procedure SetPicture(Value:Tbitmap); procedure SetSpeed(Value:integer); procedure SetPos(Value:Tposition); procedure SetVisible(Value:boolean); protected { Protected declarations } destructor Destroy; override; public { Public declarations } constructor Create(aOwner : TComponent); override; procedure Paint;override; published { Published declarations } property Font:Tfont read Ffont write Setfont; property Speed:Integer read Fspeed write SetSpeed default 3; property Bgcolor:Tcolor read Fbgcolor write Setbgcolor default clblack; property Lines:Tstrings read Flines write Setlines ; property Direction:Tdirection read Fdirection write Fdirection default BottomTotop; property Position:Tposition read Fpos write Setpos default pCenter; property Picture :Tbitmap read FPicture write SetPicture; property Visible :boolean read FVisible write SetVisible default true; property Align; property Cursor; property ShowHint; property OnClick ; end;procedure Register;implementation{$R scrolltext.res}procedure Register;begin RegisterComponents('Scroll', [TcwScrollText]);end;procedure TcwScrollText.paint;begin canvas.FillRect(canvas.ClipRect);end;procedure TcwScrollText.SetFont(Value:Tfont);begin FFont.Assign(Value); Canvas.Font.Assign(Value); repaint;end;procedure TcwScrollText.SetVisible(Value:Boolean);begin if Fvisible<> Value then begin FVisible:=Value; end; if not (csDesigning in ComponentState) then Timer.Enabled:=Value; if not Value then Hide else show;end;procedure TcwScrollText.SetLines(Value:Tstrings);begin Flines.Assign(Value); repaint; nowy:=1000000;end;procedure TcwScrollText.SetPos(Value:Tposition);begin Fpos:=Value; repaint;end;procedure TcwScrollText.SetPicture(Value:Tbitmap);begin Fpicture.Assign(Value); repaint;end;procedure TcwScrollText.Setbgcolor(Value:Tcolor);begin Fbgcolor:=Value; canvas.Brush.Color:=Value; repaint;end;procedure TcwScrollText.SetSpeed(Value:integer);begin if Value<0 then Fspeed:=0 else Fspeed:=Value; repaint;end;procedure tcwScrolltext.ScrollText(sender:Tobject);var i,txtheight,temp,picheight,f:integer;begin f:=-abs(ffont.height)-1; with self.Canvas do begin for i:=0 to flines.Count-1 do try temp:=nowy-i*Ffont.height; if ( temp>self.height -f) or (temp< f) then continue; case Fpos of pleft :nowx:=2; pCenter:nowx:=(width-TextWidth(Flines[i]))div 2; pRight :nowx:=width-Textwidth(Flines[i])-2; end; TextRect(rect(0,temp,width,temp-f),nowx,temp,Flines[i]); except break; end; if Fpicture.Empty then picheight:=0 else begin if Fpos = pCenter then nowx:=(width-Fpicture.Width)div 2 else if Fpos = pRight then nowx:=(width-Fpicture.width); picheight:=Fpicture.height; end; txtheight:=(Flines.count)*(-F); temp:=temp-F; if Direction=BottomToTop then begin FillRect(rect(0,temp,width,temp+Speed)); if not Fpicture.Empty then begin Draw(nowx,temp,Fpicture); FillRect(rect(0,temp+picheight,width,temp+picheight+fspeed)); end; if (nowy<=-txtheight-picheight) or (nowy>height) then nowy:=height else nowy:=nowy-speed; end else begin if not Fpicture.Empty then Draw(nowx,temp,Fpicture); FillRect(rect(0,nowy-speed,width,nowy)); if (nowy>height) or (nowy< -txtheight-picheight) then nowy:=-txtheight-picheight else nowy:=nowy+speed; end; end;end;constructor Tcwscrolltext.create(aOwner : TComponent);begin inherited create(aOwner); Fpicture:=Tbitmap.Create; FFont:=Tfont.Create; Flines:=Tstringlist.Create; Flines.Add('TcwScrollText'); Flines.Add('Writen by Chenwei'); timer:=Ttimer.Create(self); timer.Enabled:=false; timer.Interval:=100; timer.OnTimer:=Scrolltext; Fspeed:=3; FFont.Size := 14; FFont.Name := 'Times New Roman'; FFont.Style := [fsBold]; Fbgcolor:=clBlack; FFont.Color:=clred; Fpos:=pCenter; Canvas.Brush.Style := bsClear; Canvas.Font.Assign(FFont); timer.Enabled:=true; width:=200; height:=200; nowx:=0; nowy:=100000; canvas.Brush.Color:=Fbgcolor; Visible:=true;end;destructor Tcwscrolltext.destroy;begin timer.Free; Flines.Free; Fpicture.Free; inherited destroy;end;end. 【delphi】关于BOM价格计算的问题 本人求购屏幕画笔源代码 救人如救火啊 DELPHI中是否有类似于网页设计中的session变量? 莫名其妙:dbedit获得焦点后内容变空! 您们都可以帮我的. 我在notebook控件的每一子页上放了一个image做底图,切换子页时图片总要闪一下,有办法解决吗? 怎么在窗体的标题栏中加入一个控件,用delphi来实现 刚接触delphi很多都不会,请大家帮忙写段代码。 关于数据库的一个怪问题。 如何播放字幕文件*.kcs? 超难问题!!!怎样强制读写一个被另一程序用独占模式打开的文件???
procedure TForm.TimerTimer(Sender: TObject);
begin
SendMessage(Memo1.Handle,WM_VSCROLL,SB_LINEDOWN,0)
end;如果只是label滚动
在timertimer里对label.left 不停赋值(比如每次加10象素)就可以了。
你试试吧
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;//DsgnIntf;type
Tdirection=(BottomToTop,TopToBottom);
Tposition=(pLeft,pCenter,pRight);
TcwScrollText = class(TGraphicControl)
private
timer:Ttimer;
// fAbout:string;
nowx,nowy:integer;
FFont:TFont;
Fbgcolor:Tcolor;
Fspeed:Integer;
Flines:Tstrings;
Fdirection:Tdirection;
Fpos:Tposition;
Fpicture:Tbitmap;
FVisible:boolean; procedure ScrollText(sender:Tobject);
procedure SetLines(Value:Tstrings);
procedure SetFont(Value:Tfont);
procedure Setbgcolor(Value:Tcolor);
procedure SetPicture(Value:Tbitmap);
procedure SetSpeed(Value:integer);
procedure SetPos(Value:Tposition);
procedure SetVisible(Value:boolean);
protected
{ Protected declarations }
destructor Destroy; override;
public
{ Public declarations } constructor Create(aOwner : TComponent); override;
procedure Paint;override;
published
{ Published declarations }
property Font:Tfont read Ffont write Setfont;
property Speed:Integer read Fspeed write SetSpeed default 3;
property Bgcolor:Tcolor read Fbgcolor write Setbgcolor default clblack;
property Lines:Tstrings read Flines write Setlines ;
property Direction:Tdirection read Fdirection write Fdirection default BottomTotop;
property Position:Tposition read Fpos write Setpos default pCenter;
property Picture :Tbitmap read FPicture write SetPicture;
property Visible :boolean read FVisible write SetVisible default true;
property Align;
property Cursor;
property ShowHint; property OnClick ; end;
procedure Register;implementation{$R scrolltext.res}
procedure Register;
begin
RegisterComponents('Scroll', [TcwScrollText]);
end;procedure TcwScrollText.paint;
begin
canvas.FillRect(canvas.ClipRect);
end;
procedure TcwScrollText.SetFont(Value:Tfont);
begin
FFont.Assign(Value);
Canvas.Font.Assign(Value);
repaint;
end;procedure TcwScrollText.SetVisible(Value:Boolean);
begin
if Fvisible<> Value then begin
FVisible:=Value;
end;
if not (csDesigning in ComponentState) then
Timer.Enabled:=Value;
if not Value then Hide
else show;
end;
procedure TcwScrollText.SetLines(Value:Tstrings);
begin
Flines.Assign(Value);
repaint;
nowy:=1000000;
end;procedure TcwScrollText.SetPos(Value:Tposition);
begin
Fpos:=Value;
repaint;
end;
procedure TcwScrollText.SetPicture(Value:Tbitmap);
begin
Fpicture.Assign(Value);
repaint;
end;procedure TcwScrollText.Setbgcolor(Value:Tcolor);
begin
Fbgcolor:=Value;
canvas.Brush.Color:=Value;
repaint;
end;procedure TcwScrollText.SetSpeed(Value:integer);
begin
if Value<0 then Fspeed:=0
else Fspeed:=Value;
repaint;
end;procedure tcwScrolltext.ScrollText(sender:Tobject);
var i,txtheight,temp,picheight,f:integer;
begin
f:=-abs(ffont.height)-1;
with self.Canvas do begin
for i:=0 to flines.Count-1 do
try
temp:=nowy-i*Ffont.height;
if ( temp>self.height -f) or (temp< f) then
continue;
case Fpos of
pleft :nowx:=2;
pCenter:nowx:=(width-TextWidth(Flines[i]))div 2;
pRight :nowx:=width-Textwidth(Flines[i])-2;
end;
TextRect(rect(0,temp,width,temp-f),nowx,temp,Flines[i]);
except
break;
end;
if Fpicture.Empty then
picheight:=0
else begin
if Fpos = pCenter then
nowx:=(width-Fpicture.Width)div 2
else if Fpos = pRight then
nowx:=(width-Fpicture.width);
picheight:=Fpicture.height;
end;
txtheight:=(Flines.count)*(-F);
temp:=temp-F;
if Direction=BottomToTop then begin
FillRect(rect(0,temp,width,temp+Speed));
if not Fpicture.Empty then begin
Draw(nowx,temp,Fpicture);
FillRect(rect(0,temp+picheight,width,temp+picheight+fspeed));
end;
if (nowy<=-txtheight-picheight) or (nowy>height) then
nowy:=height
else
nowy:=nowy-speed;
end
else begin
if not Fpicture.Empty then Draw(nowx,temp,Fpicture);
FillRect(rect(0,nowy-speed,width,nowy));
if (nowy>height) or (nowy< -txtheight-picheight) then
nowy:=-txtheight-picheight
else nowy:=nowy+speed;
end;
end;
end;constructor Tcwscrolltext.create(aOwner : TComponent);
begin
inherited create(aOwner);
Fpicture:=Tbitmap.Create;
FFont:=Tfont.Create;
Flines:=Tstringlist.Create;
Flines.Add('TcwScrollText');
Flines.Add('Writen by Chenwei');
timer:=Ttimer.Create(self);
timer.Enabled:=false;
timer.Interval:=100;
timer.OnTimer:=Scrolltext;
Fspeed:=3;
FFont.Size := 14;
FFont.Name := 'Times New Roman';
FFont.Style := [fsBold];
Fbgcolor:=clBlack;
FFont.Color:=clred;
Fpos:=pCenter;
Canvas.Brush.Style := bsClear;
Canvas.Font.Assign(FFont);
timer.Enabled:=true;
width:=200;
height:=200;
nowx:=0;
nowy:=100000;
canvas.Brush.Color:=Fbgcolor;
Visible:=true;
end;destructor Tcwscrolltext.destroy;
begin
timer.Free;
Flines.Free;
Fpicture.Free;
inherited destroy;
end;end.