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

  • 主题发起人 主题发起人 pla250
  • 开始时间 开始时间
P

pla250

Unregistered / Unconfirmed
GUEST, unregistred user!
Delphix可以实现吗?怎样使用可以给个例子或者简单的代码吗,谢谢了!
!!!!!!!!!!!!!!!!!!!!!!!!!
我对问题的描述有些偏差:我希望在10秒内画1000条线,每次画之前先擦除上一条,不能用for循环,因为这样是在全部画完后才显示的.我要的效果就好象一个快速旋转的表针,我试了用timer,和delphix中的定时器每隔10ms做一次画和擦的动作,结果总的消耗时间超过了20秒,我希望得到改进,就这样,先谢谢了!!!!!!

问题没有彻底解决:
1/采用这样的方法画的线不够平滑;在快速画线时出现抖动(在同一时刻看到了两跟线)
2/采用hb_wshsh,的时钟,当设定的时间间隔过小时,系统开始反映迟钝,并且画线过程中有停顿感(在进行鼠标操作,或者运行其他程序时)
我现在想用DELPHIX做了,今天试着用DELPHIX写了相同的程序,线条画的非常漂亮,但存在如下问题:
1)DELPHIX的时钟定时精度好象最快是15ms,是否可以有其他的方法改进精度,我试着用hb_wshsh,的时钟,结果DELPHX不画线了??????不明白为什么
2)在DELPHIX中如何实现图层显示,也就是说,我要在不同的图层上动态显示不同的内容,如何实现,
请帮忙啊!!!!!
帮忙啊,事成之后再加100分.
 
Delphix可以实现吗?怎样使用可以给个例子或者简单的代码吗,谢谢了!
!!!!!!!!!!!!!!!!!!!!!!!!!
我对问题的描述有些偏差:我希望在10秒内画1000条线,每次画之前先擦除上一条,不能用for循环,因为这样是在全部画完后才显示的.我要的效果就好象一个快速旋转的表针,我试了用timer,和delphix中的定时器每隔10ms做一次画和擦的动作,结果总的消耗时间超过了20秒,我希望得到改进,就这样,先谢谢了!!!!!!

问题没有彻底解决:
1/采用这样的方法画的线不够平滑;在快速画线时出现抖动(在同一时刻看到了两跟线)
2/采用hb_wshsh,的时钟,当设定的时间间隔过小时,系统开始反映迟钝,并且画线过程中有停顿感(在进行鼠标操作,或者运行其他程序时)
我现在想用DELPHIX做了,今天试着用DELPHIX写了相同的程序,线条画的非常漂亮,但存在如下问题:
1)DELPHIX的时钟定时精度好象最快是15ms,是否可以有其他的方法改进精度,我试着用hb_wshsh,的时钟,结果DELPHX不画线了??????不明白为什么
2)在DELPHIX中如何实现图层显示,也就是说,我要在不同的图层上动态显示不同的内容,如何实现,
请帮忙啊!!!!!
帮忙啊,事成之后再加100分.
 
直接画,一秒钟也可以画完吧。
要不开几个线程同时画。
呵呵
 
不行,没办法的,直接用Lineto画,我用了20秒
 
先把线画到一个 Bitmap 上,再 BltBit 贴上去,能快不少。
写了一个简单的类,你把它的 Draw 方法改成画线就行了。
unit DrawUtils;

interface

uses Windows, Graphics;

const
deltaw = 3;
deltah = 3;
deltaw2 = deltaw * 3;

type
TMemoryBitmap = class(TBitmap)
public
constructor Create; override;
procedure CopyTo(hdcDest: HDC);
procedure Draw; reintroduce;
end;

implementation

uses SysUtils;

{ TMemoryBitmap }

constructor TMemoryBitmap.Create;
begin
inherited Create;
PixelFormat := pf24bit;
end;

procedure TMemoryBitmap.CopyTo(hdcDest: HDC);
begin
BitBlt(hdcDest, 0, 0, Width, Height, Canvas.Handle, 0, 0, SRCCOPY);
end;

procedure TMemoryBitmap.Draw;
var
i, j: Longint;
p: PByteArray;
begin
for i := 0 to Height - 1 do
begin
p := ScanLine;
j := 0;
while j < Width * 3 do
begin
p[j] := 255 - (i div deltah * deltah) * (j div deltaw2 * deltaw);
p[j + 1] := 255 - j div deltaw2 * deltaw;
p[j + 2] := 255 - i div deltah * deltah;
Inc(j, 3);
end;
end;
end;

用起来很简单:
procedure TForm1.FormCreate(Sender: TObject);
begin
FbmpBuf := TMemoryBitmap.Create;
FbmpBuf.Width := Width;
FbmpBuf.Height := Height;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
FbmpBuf.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
FbmpBuf.Draw;
FbmpBuf.CopyTo(GetDC(Handle));
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
I, L, T, iStart: Integer;
begin
iStart := GetTickCount;
L := 0;
T := 40;
for I := 1 to 1000 do
begin
Canvas.MoveTo(L, T);
Canvas.LineTo(L + 100, T);
T := T + 2;
if I mod 200 = 0 then
begin
L := L + 102;
T := 40;
end;
end;
Edit2.Text := IntToStr(GetTickCount - iStart);
Edit1.Text := IntToStr((GetTickCount - iStart) div 1000);
end;
测试一下不到一秒啊! 十几毫秒而已啊.
 
大家又没有做过大图生成的比较快的方法?局部生成?
 
直接用函数生成不行?
 
速度慢了,我测试需要20-30秒,在DELPHIX中画不出来,对DELPHIX没整明白,我用
DXDraw.canvas.lineto怎么画不出东西来?
用系统的TIMER和DELPHIX的TIMMER把间隔时间设置成了1MS结果画1000条仍然需要20多秒.
 
Delphi的TTimer的精度大约在15毫秒左右,如果在不是真正多任务操作系统的98下精度更是大打折扣,使用下面的计时器,间隔设为1毫秒,纯画线的话1秒左右搞定。
unit MMTimer;

interface

uses
Windows, SysUtils, Classes, MMSystem;

type
EMMTimer = class(Exception);
TMMTimer = class(TComponent)
private
uTimerID: MMRESULT;
FInterval: Cardinal;
FResolution: Cardinal;
FOnTimer: TNotifyEvent;
FEnabled: Boolean;
procedure UpdateTimer;
procedure SetEnabled(Value: Boolean);
procedure SetInterval(Value: Cardinal);
procedure SetOnTimer(Value: TNotifyEvent);
procedure SetResolution(Value: Cardinal);
protected
procedure Timer; dynamic;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Enabled: Boolean read FEnabled write SetEnabled default True;
property Interval: Cardinal read FInterval write SetInterval default 1000;
property Resolution: Cardinal read FResolution write SetResolution default 10;
property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Showshine', [TMMTimer]);
end;

procedure TimerCallback(uTimerID, uMessage: Cardinal; dwUser, dw1, dw2: Cardinal); stdcall;
var
MMTimer: TMMTimer;
begin
MMTimer := TMMTimer(dwUser);
if Assigned(MMTimer) then
MMTimer.Timer;
end;

{ TMMTimer }

constructor TMMTimer.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FEnabled := True;
FInterval := 1000;
FResolution := 10;
uTimerID := 0;
end;

destructor TMMTimer.Destroy;
begin
FEnabled := False;
UpdateTimer;
inherited Destroy;
end;

procedure TMMTimer.SetEnabled(Value: Boolean);
begin
if Value <> FEnabled then
begin
FEnabled := Value;
UpdateTimer;
end;
end;

procedure TMMTimer.SetInterval(Value: Cardinal);
begin
if Value <> FInterval then
begin
FInterval := Value;
UpdateTimer;
end;
end;

procedure TMMTimer.SetOnTimer(Value: TNotifyEvent);
begin
FOnTimer := Value;
UpdateTimer;
end;

procedure TMMTimer.SetResolution(Value: Cardinal);
var
Caps: TTimeCaps;
begin
if (Value <> FResolution) and (timeGetDevCaps(@Caps, Sizeof(TTimeCaps)) = TIMERR_NOERROR) then
begin
if Value < Caps.wPeriodMin then //小于最小分辨率
Value := 0
else if Value > Caps.wPeriodMax then //大于最小分辨率
Value := Caps.wPeriodMax;
FResolution:=Value;
UpdateTimer;
end;
end;

procedure TMMTimer.Timer;
begin
if Assigned(OnTimer) then
FOnTimer(Self);
end;

procedure TMMTimer.UpdateTimer;
var
lpTimerProc: TFNTimeCallBack;
begin
if uTimerID <> 0 then
timeKillEvent(uTimerID); //销毁
if (FInterval > 0) and FEnabled and Assigned(FOnTimer) then
begin
lpTimerProc := @TimerCallback;
uTimerID := TimeSetEvent(FInterval, FResolution, lpTimerProc, DWORD(Self), TIME_PERIODIC);
if uTimerID = 0 then
begin
FEnabled := FALSE;
raise EMMTimer.Create('定时器创建失败!');
end;
end;
end;
end.

procedure TForm1.Button1Click(Sender: TObject);
begin
i:=0;
mmtimer1.Enabled:=true;
caption:=formatdatetime('hh:mm:ss',now);
end;
测试:
procedure TForm1.MMTimer1Timer(Sender: TObject);
begin
canvas.FillRect(clientrect);
canvas.MoveTo(random(100),random(20));
canvas.LineTo(random(500),random(500));
inc(i);
if i=1000 then
begin
caption:=caption+formatdatetime('hh:mm:ss',now);
mmtimer1.Enabled:=false;
end;
end;
 
10秒种还画不完1000条线?不可能吧?
 
将你的代码贴上来看看
 
是TIMER精度的问题,试试一个周期多画几条,比如20条,约就可以在一秒内完成
hb_wshsh说得没错,可信精度不要小于20ms
 
汗。。。。非常抱歉啊,对于画线这类的我还真没研究过。。。-_-! 最多也就用个textout之类的东西

不过记时器不要用timer了,搜索以前的帖子,有个媒体记时器,我记得能精确到微妙级的。。。
 
To:hb_wshsh :请教,我想在image上画,并且在该image上面还叠加若干透明图层,问题来了,叠加的图层上的东西随着画线,出现闪烁,如何解决??
我尝试把image放在一个Panel上,Panel设置了双缓存,但可能是双缓存导致了定时精度出现问题,原本平滑的画线过程,出现跳跃,帮帮忙啊,先谢谢了哦
 
你的计时器,有问题,Timer监控到30毫秒以下就会有问题的,建议你使用多媒体计时器或者自己用回调函数
 
这个和机器本身的时钟和操作系统有关系,实现起来会比较困难,因为最小单位可能超过10毫秒,所以没有办法作到
 
procedure TForm1.Button1Click(Sender: TObject);
var S:integer;
begin
for S := 10 to 1010 do
with Self.Canvas do
begin
MoveTo(10, S+1);
LineTo(200, S+1);
end;
end;
这个不到一秒钟就画完了,你怎么20秒还画不完,这不可能吧。
要慢也就是你的 Timer 把程序拖慢了!
 
不要用timer计时
程序开始执行的时候取得系统时间now()
执行完了取系统时间。
两个用formatdatetime('mmsszzz')得到详细的时间间隔。
转成int相减即可,绝对准确。毫秒级
 
问题没有彻底解决:
1/采用这样的方法画的线不够平滑;在快速画线时出现抖动(在同一时刻看到了两跟线)
2/采用hb_wshsh,的时钟,当设定的时间间隔过小时,系统开始反映迟钝,并且画线过程中有停顿感(在进行鼠标操作,或者运行其他程序时)
3/我试着用DELPHIX写了相同的程序,但存在问题
1)DELPHIX的时钟定时精度好象最快是15ms,是否可以有其他的方法改进精度,我试着用hb_wshsh,的时钟,结果DELPHX不画线了??????不明白为什么
2)在DELPHIX中如何实现图层显示,也就是说,我要在不同的图层上动态显示不同的内容,如何实现,
请帮忙啊!!!!!
帮忙啊,事成之后再加100分.
 
后退
顶部