從非主線程繪制到主窗體畫布

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;