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

Question

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

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

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;

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

编辑：我有我要求帮助，但再过几年后，我意识到我真正需要的建议是不是在所有使用线程和尝试像这样来代替。

Answer 1

我看到你的方法有很多不妥之处。

1）所有VCL交互必须在主线程内完成

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

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

这解释了为什么它有时而不是其他时间有效。 表单会自动绘制，如果您不使用此事件，则您的自定义图形将仅由VCL绘制。

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

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

4）线程应完全独立

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

结论

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

---

编辑

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

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

Answer 2

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

• 可以将其视为“双缓冲区”方法，这将防止图形上出现任何闪烁。 所以...

   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;