Delphi while 循环导致程序停止响应

Question

我正在使用 Delphi 7，我正在编写的程序需要不断地在屏幕上绘制。虽然目前没有画出什么重要的东西，但这在以后的程序中是必需的。但是，当我将绘制屏幕的过程置于只能通过按任意按钮停止的 while 循环中时，程序将完全停止响应。我不明白为什么会这样。当然，既然可以退出while循环，程序应该继续运行就好了。这是源代码：

unit DD04f1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, TeCanvas, ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    procedure Image1OnCreate();
    procedure ScreenRender();
    procedure OnCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  IsDone : Boolean;

implementation

{$R *.dfm}
procedure TForm1.OnCreate(Sender: TObject);
begin
  IsDone := False;
end;

procedure TForm1.Image1OnCreate ();
var
  Count:Integer;
begin
  image1.canvas.Create();
  image1.canvas.Pen.Color:=clBlack;
  image1.canvas.rectangle(0,0,640,480);
  image1.canvas.Pen.Color:=$ed630e; //bgr instead of rgb

  Count:=0;
  While (Count <> 640) do
  begin
    image1.Canvas.moveto(Count,0);
    image1.Canvas.LineTo(Count,480);
    Count:=Count+1;

  end;
end;

procedure TForm1.ScreenRender();
var
  Count : Integer;
begin
  Count:=0;
  While(Count<>640) do
  begin
    image1.Canvas.moveto(Count,0);
    image1.Canvas.LineTo(Count,480);
    Count:=Count+1;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    Image1OnCreate();
    Button1.Visible := False;
    While(IsDone = False) do
    begin
      ScreenRender();
    end;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  IsDone := True;
end;

end.

Answer 1

procedure TForm1.OnCreate(Sender: TObject);
begin
  IsDone := False;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    Image1OnCreate();
    Button1.Visible := False;
    While(IsDone = False) do
    begin
      ScreenRender();
    end;
end;

假设IsDone总是False（否则我们不会进入循环），这个循环无法终止。是无限的。

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  IsDone := True;
end;

您不能从 TForm1.Button1Click 循环内部调用此过程，因此在您进入该循环后永远不会调用它。由于您永远不会退出 TForm1.Button1Click 过程，因此您不允许任何外部代理（如 VCL 中的消息调度循环）被执行并调用该过程。总而言之，一旦您进入循环，就没有任何可执行代码可以更改 IsDone 值。所以，它没有改变。

事件处理程序应该是非常短的过程，几乎立即执行，并放弃 "execution flow control" 回到 VCL 内部。每一个长的（更多的是无限的）处理都会导致程序变得无响应。无论有多少新闻 Windows 可能想告诉程序 - 程序从不要求他们。

曾经有人告诉Windows windows（GDI对象）都生活在"messages storm"的中心，他们必须及时解决问题。每秒有数百条这样的消息传入，Window 过程（在 VCL 类中构建，用于 Delphi 7 种形式）应该在为时已晚之前接收、发送和处理每一条消息.

一旦您通过使其中一个事件处理程序变长甚至无穷无尽来阻止该进程 - 您就违反了 OS 与应用程序之间的基本契约。

你必须做 "inversion of control"，将你的连续工作分成小的短块，并让 Windows 在它认为合适的时候调用这些块。例如，尝试使用 TTimer。

PS。您可以查看一个非常遥远的问题：

跳过那里的所有多线程内容，对于您的情况，重要的是其他线程创建我们必须在表单上绘制的 "chunks of work" 当 Windows 询问我们时以一些合理的帧率（不要太快也不要太慢）这样做。您的工作块根本不同，因此所有与您无关的线程内容。

渲染是在 TTimer 事件中进行的。所以 "framework" 设置定时器，打开和关闭它可能对您有些兴趣。但是，您在 .OnTimer 事件中要做的工作将大不相同（只是绘制一些东西，甚至只是 invalidating 表单的某些部分并等待 Windows 触发 OnPaint 事件.).

Answer 2

您已经很好地回答了为什么您当前的代码不起作用，并且在您的评论中您提到您想从玩家的角度进行光线投射和绘图，所以我假设有某种游戏背景。

我不确定 VCL 是否是游戏的最佳基础。不同的理念和需求。正如 Arioch '所解释的 Delphi 的 VCL 是事件驱动的。事情发生在响应 windows 消息时，甚至是绘画。如果没有什么需要重新粉刷，则不会重新粉刷任何东西。

这与我对游戏引擎的理解大相径庭（我绝不是专家）。即使什么都没发生，他们也会一帧接一帧地不断绘制，以尽可能流畅地呈现。每个帧可能包括基于游戏规则、物理、玩家输入、动画的基础结构更新，但即使它们保持不变，也会绘制一个新帧。基本上三个步骤发生在一个简化的 'game loop'

输入
更新
演示文稿

每一帧都会发生这一切。可能没有输入，没有游戏结构的更新，甚至不需要演示。但所有这三个步骤都属于一起，导致稍后呈现的更新的输入发生在与生成的绘图完全相同的帧中。

这是我发现很难放入 VCL 的东西。作为解决方案必须基于现有的 VCL 循环和 windows 消息。您基本上是尝试在 VCL 中创建这样一个游戏循环。

解决您的直接问题的一种方法 - 您想要根据计算呈现某些内容 - 可能只是使用 VCL 的原理。你想要绘制一些东西。 VCL 控件通常会通过 Invalidate, causing their BoundsRect to be invalidated. You could do that after you have done your calculations. In the following example I'll just use a timer to simulate your calculations are done. Just be aware that Invalidate will cause WM_PAINT 为控件生成的消息传达它们希望被绘制的愿望，但不会导致立即重新绘制。在处理 WM_PAINT 之前可能有消息排队。我正在使用 TPaintBox's OnPaint 来实际进行绘画工作，您可能希望将来在项目进行时对此有自己的控制。

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;

type
  TFormMain = class(TForm)

    procedure FormCreate(Sender: TObject);
  private
    Timer1: TTimer;
    PaintBox1: TPaintBox;
    { Private declarations }
    procedure PaintBox1Paint(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  public
    { Public declarations }
  end;

implementation

{$R *.dfm}

procedure TFormMain.FormCreate(Sender: TObject);
begin
  PaintBox1 := TPaintBox.Create(Self);
  PaintBox1.Parent := Self;
  PaintBox1.Align := alClient;
  PaintBox1.OnPaint := PaintBox1Paint;

  Timer1 := TTimer.Create(Self);
  Timer1.Interval := 100;
  Timer1.OnTimer := Timer1Timer;
  Randomize;
end;

procedure TFormMain.PaintBox1Paint(Sender: TObject);
var
  AColor: TColor;
  I: Integer;
begin
  for I := 0 to PaintBox1.ClientWidth - 1 do
  begin
    AColor := RGB(Random(256), Random(256), Random(256));
    PaintBox1.Canvas.Pen.Color := AColor;
    PaintBox1.Canvas.MoveTo(I, 0);
    PaintBox1.Canvas.LineTo(I, PaintBox1.ClientHeight);
  end;
end;

procedure TFormMain.Timer1Timer(Sender: TObject);
begin
  PaintBox1.Invalidate;
end;

end.

Delphi while 循环导致程序停止响应

Delphi while loop causing program to stop responding

delphi

crash

pascal

while-loop