我希望在10秒钟时间内画1000条线,有没有好的方法, ( 积分: 100 )

  • 主题发起人 主题发起人 pla250
  • 开始时间 开始时间
哈哈 问题超出我的能力范围了 关注关注 感觉很有用的样子
 
有没有搞错,10秒钟画不了1000条线!
另外,for循环怎么就不能边循环边划线?加上application.ProcessMessages;不就可以了
procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
begin
label1.Caption:=datetimetostr(now);
for i:=0 to 999 do
begin
self.Canvas.MoveTo(0,i);
sleep(10);
application.ProcessMessages;
self.Canvas.LineTo(100,i);
end;
label2.Caption:=datetimetostr(now);
end;
 
To cactus123456,肯定可以画出来,但我要求在准确的10S内画完,也就是说每10MS画一条,并且擦除前一条,另外这样画的线如果不是垂直或水平的话,锯齿很厉害,你可以把自己贴的程序稍微修改,加上擦除,就会发现你会看到线在闪烁,这样不符合要求的,所以我在尝试用DIRECTX做,你可以看看DELPHIx中画出的线非常漂亮.
 
不会DX编程,没有任何相关经验。
 
to:hb_wshsh
你给的mmTimer单元也不精确,在我的win2000上测试,误差也在15毫秒以上。测试代码如下:
unit Unit1;

interface

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

type
TForm1 = class(TForm)
MMTimer1: TMMTimer;
Label1: TLabel;
Timer1: TTimer;
Label2: TLabel;
Button1: TButton;
Memo1: TMemo;
Button2: TButton;
procedure MMTimer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
fi, j: integer;
alist: TStrings;
t1, t2: Cardinal;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.MMTimer1Timer(Sender: TObject);
begin
t2 := getTickCount;
alist.Add(IntToStr(t2 - t1));
t1 := t2;
Label1.Caption := IntToStr(fi);
fi := fi + 1;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
fi := 0;
j := 0;
alist := tstringlist.Create;
t1 := getTickCount;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
t2 := getTickCount;
alist.Add(IntToStr(t2 - t1));
t1 := t2;
Label2.Caption := IntToStr(j);
j := j + 1;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
freeandnil(alist)
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
alist.Clear;
//timer1.Enabled:=true;
MMTimer1.Enabled := true;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
//timer1.Enabled:=false;
MMTimer1.Enabled := false;
Memo1.Lines.Clear;
Memo1.Lines.Text := alist.Text;

end;

end.
 
我怎么看不到闪烁呀?是我的眼睛反映太迟钝了?

procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
itop,ileft:integer;
ipretop,ipreleft:integer;
f1,f2,frequency:int64;
begin
label1.Caption:=datetimetostr(now);
for i:=0 to 999 do
begin
self.Canvas.MoveTo(200,200);
queryperformancecounter(f1);
QueryPerformanceFrequency(frequency);
while True do
begin
queryperformancecounter(f2);
if (f2-f1)/frequency > 0.01 then Break;
end;
application.ProcessMessages;
self.Canvas.Pen.Color:=clbtnface;
self.Canvas.LineTo(ipretop,ipreleft);
itop:=200+ round(sin(i/1000*2*pi)*200);
ileft:=200+ round(cos(i/1000*2*pi)*200);
self.Canvas.MoveTo(200,200);
self.Canvas.Pen.Color:=clred;
self.Canvas.LineTo(itop,ileft);
if ipretop<>itop then ipretop:=itop;
if ipreleft<>ileft then ipreleft:=ileft;
end;
label2.Caption:=datetimetostr(now);
end;
 
那就用另一线程吧,既然都可以不用VCL了
同一线程时内嵌ProcessMessages时是不大可能再达到时间上的精准的了
启动另一线程,直接用GetTickCount来控制时间

tmbegin := GetTickCount;
tmend := tmbegin + 10000;
tmcur := tmbegin;
n := 0;
//先画第0条线
while tmcur <= tmend do
begin
//擦除第n条线
n := (tmcur - tmbegin) / 10;
//画第n条线
tmcur := GetTickCount;
end;

这样即便CPU占用很高不能连续处理时,代码也能依据时间来算出应该画哪一条线并准确擦除上一条
不过在效率较高时,10ms能够画很多条线,这段代码没有加入相应判断,会不断的擦除并重画同一条线,可能会造成虚的现象,具体用时再加一点判断并用计算用Sleep休眠的毫秒数会更好
 
另外不是水平或者垂直的直线,就应该有锯齿吧,毕竟线条也占用一个象素的宽度呀
 
关注这个问题 提前一下
 
可否利用人的视觉有暂停效果.改下
将时间改为 15~ 20ms 一次
看看
 
和显卡有关吧,要不调用ActiveX?
同意乖乖兔的,可以和很快画完的啊,用Lineto,Moveto.
 
我昨天作了一个测试,我画9999条线,当然了是从0,0到100,100啊,我也是为了算时间,大概是10毫秒,你说的问题,10秒钟?天啊,你是怎么测试的?你的算法再复杂,再麻烦,你也不可能比mpg或者rm的视频压缩和播放更麻烦吧.

呵呵,你把需求发过来,另外,先画到后台的bmp然后在现实出来,是最快的方式.
 
这种“动画”效果最好使用 DirectX
 
我是一个初级者,只会用很简单的方法及语句。不知一下我的简单程序可否对你有点帮助
如想再快就把中间画线的语句复制几遍就成。:)
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button4: TButton;
Timer1: TTimer;
Button1: TButton;

procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button4Click(Sender: TObject);

procedure Button1Click(Sender: TObject);
private
tt:integer { Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
var xx,yy:real;qqqq,xxx,yyy,s,cc:integer;
begin
self.Canvas.Pen.Color:=clbtnface;
cc:=tt-1;
begin
xx:=sin(cc*3.14/180);
yy:=cos(cc*3.14/180);
xxx:=round(xx*50)+600;
yyy:=round(yy*50)+300;
Self.Canvas.MoveTo(600, 300);
Self.Canvas.LineTo(xxx,yyy);

end;
self.Canvas.Pen.Color:=clblack;
tt:=tt+1;
begin
xx:=sin(tt*3.14/180);
yy:=cos(tt*3.14/180);
xxx:=round(xx*50)+600;
yyy:=round(yy*50)+300;
Self.Canvas.MoveTo(600, 300);
Self.Canvas.LineTo(xxx,yyy);

end;

self.Canvas.Pen.Color:=clbtnface;
cc:=tt-1;
begin
xx:=sin(cc*3.14/180);
yy:=cos(cc*3.14/180);
xxx:=round(xx*50)+600;
yyy:=round(yy*50)+300;
Self.Canvas.MoveTo(600, 300);
Self.Canvas.LineTo(xxx,yyy);

end;
self.Canvas.Pen.Color:=clblack;
tt:=tt+1;
begin
xx:=sin(tt*3.14/180);
yy:=cos(tt*3.14/180);
xxx:=round(xx*50)+600;
yyy:=round(yy*50)+300;
Self.Canvas.MoveTo(600, 300);
Self.Canvas.LineTo(xxx,yyy);

end;
self.Canvas.Pen.Color:=clbtnface;
cc:=tt-1;
begin
xx:=sin(cc*3.14/180);
yy:=cos(cc*3.14/180);
xxx:=round(xx*50)+600;
yyy:=round(yy*50)+300;
Self.Canvas.MoveTo(600, 300);
Self.Canvas.LineTo(xxx,yyy);

end;
self.Canvas.Pen.Color:=clblack;
tt:=tt+1;
begin
xx:=sin(tt*3.14/180);
yy:=cos(tt*3.14/180);
xxx:=round(xx*50)+600;
yyy:=round(yy*50)+300;
Self.Canvas.MoveTo(600, 300);
Self.Canvas.LineTo(xxx,yyy);

end;
self.Canvas.Pen.Color:=clbtnface;
cc:=tt-1;
begin
xx:=sin(cc*3.14/180);
yy:=cos(cc*3.14/180);
xxx:=round(xx*50)+600;
yyy:=round(yy*50)+300;
Self.Canvas.MoveTo(600, 300);
Self.Canvas.LineTo(xxx,yyy);

end;
self.Canvas.Pen.Color:=clblack;
tt:=tt+1;
begin
xx:=sin(tt*3.14/180);
yy:=cos(tt*3.14/180);
xxx:=round(xx*50)+600;
yyy:=round(yy*50)+300;
Self.Canvas.MoveTo(600, 300);
Self.Canvas.LineTo(xxx,yyy);

end;
self.Canvas.Pen.Color:=clbtnface;
cc:=tt-1;
begin
xx:=sin(cc*3.14/180);
yy:=cos(cc*3.14/180);
xxx:=round(xx*50)+600;
yyy:=round(yy*50)+300;
Self.Canvas.MoveTo(600, 300);
Self.Canvas.LineTo(xxx,yyy);

end;
self.Canvas.Pen.Color:=clblack;
tt:=tt+1;
begin
xx:=sin(tt*3.14/180);
yy:=cos(tt*3.14/180);
xxx:=round(xx*50)+600;
yyy:=round(yy*50)+300;
Self.Canvas.MoveTo(600, 300);
Self.Canvas.LineTo(xxx,yyy);

end;


end;

procedure TForm1.Button4Click(Sender: TObject);
begin
timer1.Enabled:=true;

end;



procedure TForm1.Button1Click(Sender: TObject);
begin
timer1.Enabled:=false;
end;

end.
 
批评第一楼的。
描述不准确。


后来总算是看明白了。呵。
我猜想 timer 应该是没有问题的。

画线也应该是没有问题的。

在 aspnet中,c# 引入了 委托这个概念。
类似的, 在timer触发的时候,不要去考虑等待画线完成,只是一个触发,告诉你的画线系统,该画线了。

你的画线系统和timer应该在不同的线程内,这样就对timer不会有很大影响。
画线系统要有 sleep(0) 和 前面人家说的,要给Application一个处理消息的权利。

画线系统的运行程序要判断是否完成画线,如果没有完成,则循环等待完成,画好了,就执行新的画线指令。

异步执行,一定可以顺利完成你的要求。委托也是这么干的。这样应该不会闪烁很厉害,时间上可能出现差距,但是总差距应该不会超过画两条线需要的时间,应该不会超过50ms的。
 
后退
顶部