从非主线程绘制到主窗体画布

Question

我正在尝试为我的学校项目制作街机游戏。基本思想是在主要的其他线程中进行所有数学和绘图，并仅将主线程用于输入例程。绘图由保存在外部单元中的过程完成，通过创建位图，然后在位图上绘制环境的一部分并最终在主窗体的画布上破坏位图来完成。当我完成绘图程序时，我试图从主线程运行它，并设法使everythink按预期工作（除了整个应用程序窗口被冻结的事实，但由于主线程工作没有停止，sommething像这是预期的）。然后我试图将该过程放在其他线程中，并且它停止工作（尽管调试例程报告该过程被重复执行，但它没有绘制任何东西）。经过一些添加然后删除的调试例程后，它开始工作没有明显的原因，但不可靠。在大约80％的情况下它运行平稳，但在其余的情况下，它会在10到30帧后停止，有时甚至不会在最后一帧中卡住一些环境部件。

主窗体单元的重要部分如下所示

procedure TForm1.Button1Click(Sender: TObject);

begin
running:=not running;
if running then AppTheard.Create(false);
end;

Procedure AppTheard.execute;

begin
 form1.Button1.Caption:='running';
 while running do begin view.nextframe; end;
 form1.Button1.Caption:='no longer running';

end;

并且其他单元中的nextframe过程看起来像这样

     Camera = class
 owner:Tform;
 focus:GravityAffected;
 Walls:PBlankLevel;
 Creeps:MonsterList;
 FrameRateCap,lastframe:integer;
 Background:TBitmap;
 plocha:TBitmap;
 RelativePosY,RelativePosX:integer;
 constructor create(owner:Tform; focus:GravityAffected; Walls:PBlankLevel; Creeps:MonsterList; FrameRateCap:integer; background:TBitmap);
 procedure nextframe;
end;    



 procedure camera.nextframe;
 var i,i1,top,topinfield, left,leftinfield: integer ;

  procedure Repair
      //some unimportant math here

  Procedure vykresli(co:vec);
   begin
   if co is gravityaffected then
    plocha.Canvas.Draw(co.PositionX*fieldsize+Gravityaffected(co).PosInFieldX-Left*fieldsize+leftinfield-co.getImgPosX,
     co.PositionY*fieldsize+Gravityaffected(co).PosInFieldY-top*fieldsize+topinfield-co.getImgPosY,
     co.image)
   else
     plocha.Canvas.Draw(co.PositionX*fieldsize-Left*fieldsize+leftinfield-co.getImgPosX,
     co.PositionY*fieldsize-top*fieldsize+topinfield-co.getImgPosY,
     co.image);
   end;

 begin
   // some more unimportant math

  vykresli(focus);                                                 

  For i:= Left+1 to left+2+(plocha.Width div fieldsize) do                                                         //vykreslení zdí
   For i1:= Top+1 to top+2+(plocha.Height div fieldsize) do
    if (i< Walls.LevelSizeX) and (i1< Walls.LevelSizeY) and (i>=0) and (i1>=0) and walls.IsZed(i,i1) then
     begin vykresli(walls^.GiveZed(i,i1)^);end;

  while abs((gettickcount() mod high(word))-lastframe) < (1000 div FrameRateCap) do sleep(1); 
  lastframe:=gettickcount mod high (word);

  owner.Canvas.Draw(-fieldsize,-fieldsize,plocha);     

 end;

有人可以告诉我我做错了什么吗？

编辑：我得到了我要求的帮助，但经过几年的努力，我意识到我真正需要的建议是不要使用线程，而是尝试使用this之类的东西。

Answer 1

我认为你的方法有很多不妥之处。

1）所有VCL互动必须在主线程

内完成

您的线程正在直接访问VCL控件。你不能这样做，因为VCL不是线程安全的。您必须将所有事件同步回主线程，并让主线程执行此操作。

2）所有自定义UI绘图（到表单）都必须在表单OnPaint事件中完成。

这解释了为什么它有时会起作用而不是其他时候起作用。表单会自动绘制，如果您不使用此活动，您的自定义绘图将由VCL绘制。

3）所有UI绘图必须在主线程中完成

这将我们带回到第1点和第2点.VCL不是线程安全的。您的辅助线程应该只负责执行计算，但不负责绘制UI。执行一些计算或做一些冗长的工作后，必须将结果同步回主线程，并让主线程执行绘图。

4）该主题应完全独立

你不应该在这个辅助线程中放置任何代码，这些代码知道它将如何显示。在您的情况下，您明确引用表单。您的帖子甚至不知道表单是否正在使用它。您的线程应该只执行冗长的计算工作，并且绝对考虑用户界面。当您需要指示重绘时，将事件同步回主表单。

<强>结论

您需要研究线程安全性。通过这样做，您将能够回答大部分问题。严格地使这个线程只是为了处理繁重的工作，否则会使UI陷入困境。不要担心用户界面缓慢，大多数现代计算机都能在很短的时间内完成复杂的绘图。这并不需要在一个单独的线程中。

---

修改

经过几年的经验，我逐渐意识到上面的＃3不一定是真的。实际上，在许多情况下，它是从线程内执行详细绘图的一种很好的方法，但是主线程只负责将该图像呈现给用户。

当然，这是一个完整的话题。您需要能够安全地将在一个线程中管理的图像绘制到另一个线程。这也需要使用Synchronize。

Answer 2

• 创建一个TThread子类并传递构造函数中所需的所有变量。
• 将这些变量存储在TThread子类的私有部分中。
• 根据需要在构造函数和析构函数中创建并释放它们。
• 创建一个事件处理程序（ex OnThreadPaint）。您也可以在构造函数中传递它。
• 如上所述，您的主题必须完全自包含（变量，代码等）。
• 将代码放在线程的Execute过程中。您可以构建一个Bitmap或其他任何东西，在它上面绘制（就像在实际的（前TForm）画布中一样。记住调整TBitmap实例的大小。
• 最后，调用传递事件处理程序（OnThreadPaint）的Synchronized方法。 这将在主线程中执行事件。

• 这可以被视为“双缓冲”＆＃39;方法，可以防止绘图时出现任何闪烁。 所以......

  TDrawThread = class(TThread)
      private
          FOnThreadPaint: TNotifyEvent;
          FVar: Integer;
          FBitamp: TBitmap;
      protected
          procedure Execute; override;
          procedure SynchProc;
      public
         constructor Create(aVar: Integer; onPaint:TNotifyEvent);
         destructor Destroy; override;
         property Bmp:TBitMap read FBitMap;
  end;
  
  constructor TDrawThread.Create(aVar: Integer; onPaint:TNotifyEvent);
  begin
      inherited Create(False);
      FreeOnTerminate := True;
      FVar := aVar;
      FOnThreadPaint := onPain;
      FBitMap := TBitMap.Create;
      // FVarOther := TVarOther.Create;
      // FVarOther.. assign
  end;       
  
  destructor TDrawThread.Destroy;
  begin
      FBitMap.Free;
      // FVarOther.Free;
      inherited;
  end;        
  
  procedure TDrawThread.Execute;
  begin
      FBitMap.width := ..
      FBitMap.height := ..
      // do more Drawing on the FBitmpap here
      if Assigned(FOnThreadPaint) then Synchronize(SynchProc);            
  end;       
  
  procedure TDrawThread.SynchProc;
  begin
      FOnThreadPaint(Self);
  end;
  

以你的主要形式......

TForm1 = class(TForm)
private
  { Private declarations }
  procedure onMyPaint(Sender: TObject);
...

procedure TForm1.onMyPaint(Sender: TObject);
begin
    with Sender as TDrawThread do begin
        Canvas.Draw(0, 0, Bmp);
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    TDrawThread.Create(30, onMyPaint);
end;