滚动字幕占用内存太大,急。(100分)

  • 主题发起人 主题发起人 richoo
  • 开始时间 开始时间
R

richoo

Unregistered / Unconfirmed
GUEST, unregistred user!
procedure TForm1.Timer1Timer(Sender: TObject);
begin

gox:=gox-1;
if gox<-canvas.TextWidth(memo1.text) then gox:=image1.ClientWidth;

image1.Canvas.font.size:=11;
image1.Canvas.font.color:=$0022ff;
image1.canvas.TextOut(gox,1,strlist)
end;

strlist是个大字符串变量,存量了6K的数据,结果让它滚动时,占用了6M的的资源,请问有其他办法做滚动字幕吗?
小弟是菜鸟,分也不多,能得到大家的帮忙只能用两行眼泪的表达了。
 
只有一个空白窗体的程序运行都要占5M多的内存了。
你的程序6M是很正常的啊。
 
不多!不多!多乎哉?不多矣!
 
做一张 gif 动画图片也能实现滚动字幕的效果。
 
加入一个timer控件,在on timer下加入下面的代码,我试过了可以减小不少内存
procedure TForm1.Timer2Timer(Sender: TObject);
begin
if Win32Platform = VER_PLATFORM_WIN32_NT then
begin //整理内存
SetProcessWorkingSetSize(GetCurrentProcess, $FFFFFFFF, $FFFFFFFF);
end;

end;
 
晕,用image1.canvas.TextOut(gox,1,strlist);这样是不行的.还是考滤image1.canvas.DRAW....之类的吧
 
一运行,CPU占用达到100%

TO:41426277
image1.canvas.DRAW....之类 如何做?能说详细点吗?
 
可以参考一下:
http://www.delphibbs.com/keylife/iblog_show.asp?xid=17050
 
学习,听课
SetProcessWorkingSetSize(GetCurrentProcess, $FFFFFFFF, $FFFFFFFF);
为什么啊
The working set of the specified process can be emptied by specifying the value 0xffffffff for both the minimum and maximum working set sizes.
 
听说SetProcessWorkingSetSize会造成系统不稳定。
 
网上有个Banner控件,用这个 不点什么资源。
你可以用一下。它就是实现滚动字幕的效果,功能也比较强。
还可以研究一下它的源码。
 
创建一个临时Bitmap,一次用DrawText把文本Draw到Bitmap上,Timer里面就移动Bitmap的高度,再draw就行了,毕竟文本不是经常改变的。
 
我的做法就是用临时Timage,将字符全画上,再通过Canvas.CopyRect拷贝区域(显示TImage的大小)到显示TImage中。
 
你可以用线程来控件paintbox的canvas的实现移动,以下是我的线程代码,因为canvas是线程安全的,所以不需要使用Synchronize
constructor Tpcross.create(canvas: TCanvas;rect:Trect);
begin
inherited create(false);
Fcanvas:=canvas;
FreeOnTerminate:=true;
Frect:=rect;
i:=412;
end;

procedure Tpcross.Execute;
begin
while (i<>0) and (not Terminated) do
begin
//Fcanvas.FillRect(Frect);
Fcanvas.Lock;
Fcanvas.TextOut(200,i,'aaaaaaaaa');
Fcanvas.TextOut(200,i+15,'aaaaaaaaa');
Fcanvas.TextOut(200,i+30,'aaaaaaaaa');
Fcanvas.TextOut(200,i+45,'aaaaaaaaa');
Fcanvas.Unlock;
dec(i,2);
sleep(50);
if i=0 then
begin
i:=412;
Fcanvas.FillRect(Frect);
end;

end; { Place thread code here }
end;
 
谢谢,楼上各位。但是问题是我需要的滚动是左右滚动,不是上下滚动,没办法计算宽度,然后切断字符串,再做成Bitmap.如果一个很长的Bitmap会不会也很占用资源呢?
我试试再告诉大家。
比较我这条字符串有6K.
 
如果要少占用资源,那就分段处理。一段文本长度可以用于滚动几屏。在每段文本Canvas.TextOut前用Canvas.TextWidth得到宽度,然后设置Image的宽度用于TextOut.
二段之间中间可以有一部分重复,方便两段文本的衔接。
如果用两个临时Image,分段文本就可不必重复,且简单点。
 
最好是用TBitmap 做临时变量
因为你哪个6k的字光是画到TBitmap就需要很多时间 (这里就只画了一次而已)

如果是滚一下再画一下的话哪不就是死惨了吗。

再通过
CopyRect(Rect(0, 0, 800/*屏幕宽度*/, 30/*字体高度通过TextHeight获得*/) ,Bitmap.Canvas, Rect(0+j,0,800,30+j); //j 为你滚屏的速度

一屏一屏的复制,就快多了哈
 
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Timer1: TTimer;
Label1: TLabel;
Button1: TButton;
TrackBar1: TTrackBar;
Label2: TLabel;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TrackBar1Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Bit:TBitmap;
i,gox,hh:Integer;
strlist: string;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);


begin
Bit := TBitmap.Create;
Bit.Height := 30;


gox:=form1.clientwidth;
strlist:='第一第二第三第四第五第六第七第八第九第十';

strlist:=strlist+strlist;
strlist:=strlist+strlist;
strlist:=strlist+strlist;
strlist:=strlist+strlist;
strlist:=strlist+strlist;
strlist:=strlist+strlist;
strlist:=strlist+strlist;

hh :=Canvas.Textwidth(strlist);
Bit.Width:=hh;
label1.Caption:=inttostr(hh);
setbkmode(bit.canvas.handle,transparent);
bit.Canvas.TextOut(1,1,strlist);

TrackBar1.Max:=500;
TrackBar1.Min:=10;



end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
gox:=gox-1;
Canvas.Draw(gox,0,Bit);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
bit.Free;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
Timer1.Interval:=TrackBar1.Position;
label2.caption:=inttostr(TrackBar1.Position);
end;

end.

经过这番改进之后,资源降到8%,而且很流畅。但是刚开始运行的时候还是很慢。
 
不要用Canvas.Draw哪个bitmap大了的话一样的慢
最好用Canvas.CopyRect 或直接用Bitblt拷屏

你可以试试,至少拷屏的时间更快,比用 Canvas.Draw快
 
那如何实现透明字幕呢?
 

Similar threads

后退
顶部