关于绘制直线的CPU占用高的问题

Question

这是我绘制直线的代码发现运行时CPU占用很高，有什么方法能优化一下效率吗？PS：不使用XOR方式
var
  TempBmp1,TempBmp2:TBitMap;
  bDown:Boolean;
  orgx,orgy:Integer;
procedure TForm1.FormCreate(Sender: TObject);
begin
  self.PaintBox1.Canvas.FillRect(self.PaintBox1.Canvas.ClipRect);
  bDown:=false;
  Tempbmp1:=TBitmap.Create;
  Tempbmp1.Width:=self.PaintBox1.Width;
  Tempbmp1.Height:=self.PaintBox1.Height;
  Tempbmp2:=TBitmap.Create;
  Tempbmp2.Width:=self.PaintBox1.Width;
  Tempbmp2.Height:=self.PaintBox1.Height;
end;procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  bDown:=true;
  Tempbmp1.Canvas.CopyRect(PaintBox1.Canvas.ClipRect, PaintBox1.Canvas, PaintBox1.Canvas.ClipRect);
  orgx:=x;
  orgy:=y;
end;procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if bDown then
  begin
    Tempbmp2.Assign(Tempbmp1);
    Tempbmp2.Canvas.MoveTo(orgx,orgy);
    Tempbmp2.Canvas.LineTo(x,y);
    self.PaintBox1.Canvas.Draw(0,0,Tempbmp2);
  end;
end;
procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  bDown:=false;
end;

Answer 1

思想要这样的话，看要让它的进程先设置成优先级“低于标准”。你运行这个程序时，调出windows任务管理器，到进程。点右键。

Answer 2

饿，好像没什么区别，还是一样的高啊我想关键在于鼠标移动时
    Tempbmp2.Assign(Tempbmp1); 
    Tempbmp2.Canvas.MoveTo(orgx,orgy); 
    Tempbmp2.Canvas.LineTo(x,y); 
    self.PaintBox1.Canvas.Draw(0,0,Tempbmp2); 
这几句要怎么优化，是不是有其它的替代方式

Answer 3

如果256色足够, 加上bitmap.PixelFormat := pf8bit;
在画虚线时速度能大幅提高self.PaintBox1.Canvas.Draw(0,0,Tempbmp2); 
这句很慢吧,是不是可以换个方式试试

Answer 4

没人回，得!
自己想了办法，欺骗性地加上Sleep(10)解决之

Answer 5

你的画法有问题，你就是画线，就直接在FORM的canvas上画好了，还搞什么二次缓冲啊。你在onpaint里画应该CPU占用就不高了。

Answer 6

同意15樓的，就是畫直線嘛，搞那麼麻煩。
你把你想要做什麼，說清楚一點。如果單純畫直線，直接在鼠標事件裡moveto lineto就可以了。 

Answer 7

试了你的代码，并无发现你说的问题，cpu使用的并不多，而且你这简单的画线也不会占用太多的cpu
程序不多大问题，楼上的几位方法也可以试试，当然看你的兴趣！

Answer 8

我当然知道moveto lineto这个问题的关键不在于怎么画直线而是在于最后的效果
用双缓冲是为了画面不闪动
单单程序运行起来当然不会慢，问题在于如果窗口最大化，别外还有其它程序运行时怎么办。
这个程序在运行时，鼠标移动过程中CPU占用自然就高了起来，不信可以试试（PS：双核CPU占用50%，单核就是100%）

Answer 9

估计问题在于:  Tempbmp2.Assign(Tempbmp1); 每次鼠标移动都调用了这个，花的时间比较多。修改的代码如下
var
  TempBmp1,TempBmp2:TBitMap;
  bDown:Boolean;
  orgx,orgy:Integer;
  prevx, prevy: integer;
procedure TForm1.FormCreate(Sender: TObject);
begin
  bDown:=false;
  Tempbmp1:=TBitmap.Create();
  Tempbmp2:=TBitmap.Create();
  Tempbmp2.Canvas.Pen.Color := $00C0C0;
  Tempbmp2.Canvas.Pen.Mode := pmXor;
end;procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  bDown:=true;
  Tempbmp2.Canvas.Draw(0, 0, Tempbmp1);
  orgx:=x;
  orgy:=y;
  prevx := -1;
  prevy := -1;
end;procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if bDown then
  begin
    // 消除之前画在 Tempbmp2上的临时线
    if prevx >= 0 then
    begin
      Tempbmp2.Canvas.MoveTo(orgx, orgy);
      Tempbmp2.Canvas.LineTo(prevx, prevy);
    end;
    Tempbmp2.Canvas.MoveTo(orgx,orgy);
    Tempbmp2.Canvas.LineTo(x,y);
    prevx := x; prevy := y;
    PaintBox1Paint(nil);
  end;
end;
procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if bDown then
  begin
    bDown:=false;
    Tempbmp1.Canvas.MoveTo(orgx,orgy);
    Tempbmp1.Canvas.LineTo(x,y);
    PaintBox1Paint(nil);
  end;
end;procedure TForm1.FormResize(Sender: TObject);
begin
  Tempbmp1.Width:=self.PaintBox1.Width;
  Tempbmp1.Height:=self.PaintBox1.Height;
  Tempbmp2.Width:=self.PaintBox1.Width;
  Tempbmp2.Height:=self.PaintBox1.Height;
end;procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
//  PaintBox1.Canvas.FillRect(PaintBox1.Canvas.ClipRect);
  if bDown then
    PaintBox1.Canvas.Draw(0,0,Tempbmp2)
  else
    PaintBox1.Canvas.Draw(0,0,Tempbmp1);
end;

Answer 10

以上代码的说明: 临时线在Tempbmp2上画, 最终画线在Tempbmp1上，以Tempbmp1为结果。鼠标点下时让Tempbmp2与Tempbmp1相同。
临时线以Xor方式画线，同一位置再画一次就清除之前的线了。

Answer 11

谢谢代码，这样做就只复制一次图片，移动时就省去了图片复制，CPU占用是很低，可问题再于不想采用Xor方式，因为画的过程中效果不太好

Answer 12

试试这个，不用Xor方式画线。
var
  TempBmp1: TBitMap;
  bDown: Boolean;
  orgx,orgy: Integer;
procedure TForm1.FormCreate(Sender: TObject);
begin
  bDown:=false;
  Tempbmp1:=TBitmap.Create();
end;procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  bDown:=true;
  orgx:=x;
  orgy:=y;
end;procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if bDown then
  begin
    PaintBox1Paint(nil);
    PaintBox1.Canvas.MoveTo(orgx,orgy);
    PaintBox1.Canvas.LineTo(x,y);
  end;
end;
procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if bDown then
  begin
    bDown:=false;
    Tempbmp1.Canvas.MoveTo(orgx,orgy);
    Tempbmp1.Canvas.LineTo(x,y);
    PaintBox1Paint(nil);
  end;
end;procedure TForm1.FormResize(Sender: TObject);
begin
  Tempbmp1.Width:=self.PaintBox1.Width;
  Tempbmp1.Height:=self.PaintBox1.Height;
end;procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  PaintBox1.Canvas.Draw(0,0,Tempbmp1);
end;

Answer 13

谢谢代码，真不好意思一直让你发代码，运行起来的结果是画线时会闪烁，但这个程序要求的最后效果比较高所以我也一直没想出办法只能用了Sleep这种不是办法的办法
这个程序要求的是：
1、CPU占用较低
2、不使用Xor方式
3、绘制过程中不能出现闪烁
但Windows自带的绘图程序就不会出现上面的问题，我反汇编过程序，发现自带的绘图程序没有使用到MoveTo LineTo函数。

Answer 14

可以了，不用Assign，也不闪烁
var
  TempBmp1,TempBmp2:TBitMap;
  bDown:Boolean;
  orgx,orgy:Integer;
procedure TForm1.FormCreate(Sender: TObject);
begin
  bDown:=false;
  Tempbmp1:=TBitmap.Create();
  Tempbmp2:=TBitmap.Create();
end;procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  bDown:=true;
  Tempbmp2.Canvas.Draw(0, 0, Tempbmp1);
  orgx:=x;
  orgy:=y;
end;procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if bDown then
  begin
    Tempbmp2.Canvas.Draw(0, 0, Tempbmp1);
    Tempbmp2.Canvas.MoveTo(orgx,orgy);
    Tempbmp2.Canvas.LineTo(x,y);
    PaintBox1Paint(nil);
  end;
end;
procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if bDown then
  begin
    bDown:=false;
    Tempbmp1.Canvas.MoveTo(orgx,orgy);
    Tempbmp1.Canvas.LineTo(x,y);
    PaintBox1Paint(nil);
  end;
end;procedure TForm1.FormResize(Sender: TObject);
begin
  Tempbmp1.Width:=self.PaintBox1.Width;
  Tempbmp1.Height:=self.PaintBox1.Height;
  Tempbmp2.Width:=self.PaintBox1.Width;
  Tempbmp2.Height:=self.PaintBox1.Height;
end;procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
//  PaintBox1.Canvas.FillRect(PaintBox1.Canvas.ClipRect);
  if bDown then
    PaintBox1.Canvas.Draw(0,0,Tempbmp2)
  else
    PaintBox1.Canvas.Draw(0,0,Tempbmp1);
end;

Answer 15

大哥这个方法CPU占用并不会改善，其实跟我发的代码一样
你发的三种方法第一种使用的Xor
第二种出现的闪烁
第三种CPU占用高了
还是谢谢，我还是采用Sleep(10)的方法，
好像这个问题基本无解

Answer 16

那个会闪烁的代码，如果在 OnCreate 里加上 DoubleBuffered := True; 会不会好

Answer 17

个人认为cpu占用高的原因主要是硬件差和代码效率不高,应当从这两方面改善
sleep虽然可以使cpu暂时喘口气,但对其总的占用却是有增无减
最重要的是要减少画线和拷贝图形的次数和图形的大小范围

Answer 18

确实如此，首先硬件方面是不自己能改善的，减少画线也是不可能的，必竟这就是一个画线的程序
剩下拷贝次数，这个好像可以欺骗性地做成每隔两点执行，MouseMove中的代码
图形的大小范围好像也能控制，只复制和画改变的部分，就像屏幕录像一样

Answer 19

可以用Timer事件来触发刷新显示。比Sleep好点

Answer 20

好像不是说Timer事件的响应速度很慢吗
没啥招了，只能采用局部刷新的方式，这样CPU也能降下来，线太长时只好多加上Sleep

Answer 21

self.PaintBox1.Canvas.Draw(0,0,Tempbmp2); 
这句有严重的问题,
不需要在move时总执行

Answer 22

跟我目前在做的东西一样,速度是很快的,cpu占用也不高

Answer 23

怎么做呢，指点指点，或是关键部分代码发给我看看[email protected]