delphi - 线程不在打开的非模态表单上执行

Question

下面是“进度”表单的部分代码。
除了 ProgressBars(从代码中删除)之外，它还有一个 TLabel (LblDots)，我想更改其中的标题(点的数量增加)。
在 FormShow/FormClose 中，TDotterThread 被创建和销毁。

问题:
我看到 Synchronize(DoUpdate) 过程仅在程序不执行繁重工作时才调用更新标签。

这是进度表:

unit FrmBusy;

interface

uses
   System.SyncObjs, Windows, Messages, SysUtils, System.Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type
   TUpdateEvent = procedure of object;    // 'of object' to prevent 'Incompatible types: regular procedure and method pointer'

type
   TDotterThread = class(TThread)         // Thread to update LblDots
   private
      FTick: TEvent;
      FUpdater: TUpdateEvent;
   protected
      procedure Execute; override;
      procedure DoUpdate;
   public
      constructor Create;
      destructor Destroy; override;
      property Updater: TUpdateEvent read FUpdater write FUpdater;
      procedure Stop;
   end;

type
  TFormBusy = class(TForm)
    LblDots: TLabel;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    FShowDots: Boolean;
    FDotterThread: TDotterThread;
    procedure UpdateDots;
  public
    property ShowDots: Boolean write FShowDots;
  end;

implementation

{$R *.DFM}

procedure TFormBusy.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   if FShowDots then FDotterThread.Stop; // Calls Terminate and is FreeOnTerminate
end;

procedure TFormBezig.UpdateDots;
var s: String;
begin
   s := LblDots.Caption;
   if Length(s) = 50 then s := '' else s := s + '.';
   LblDots.Caption := s;
   Application.ProcessMessages;
end;

procedure TFormBusy.FormShow(Sender: TObject);
begin
   LblDots.Caption := '';
   if FShowDots then
   begin
      FDotterThread := TDotterThread.Create;
      FDotterThread.Updater := Self.UpdateDots;
      FDotterThread.Start;
   end;
   BringWindowToTop(Self.Handle);
end;

{ TDotterThread }

constructor TDotterThread.Create;
begin
  FTick := TEvent.Create(nil, True, False, '');
  FreeOnTerminate := true;
  inherited Create(true);  // Suspended
end;

destructor TDotterThread.Destroy;
begin
  FTick.Free;
  inherited;
end;

procedure TDotterThread.DoUpdate;
begin
   if Assigned(FUpdater) then FUpdater;
end;

procedure TDotterThread.Execute;
begin
  while not Terminated do
  begin
     FTick.WaitFor(1000);
     Synchronize(DoUpdate);
  end;
end;

procedure TDotterThread.Stop;
begin
   Terminate;
   FTick.SetEvent;
end;

end.

表单的调用和创建如下:

procedure TFrmTest.FormCreate(Sender: TObject);
begin
  FFormBusy := TFormBusy.Create(nil);
end;

procedure TFrmTest.FormDestroy(Sender: TObject);
begin
   FFormBusy.Free;
end;

procedure TFrmTest.BtnCompareClick(Sender: TObject);
begin
   FrmTest.FFormBusy.ShowDots := true;
   FrmTest.FFormBusy.Show;
   FrmTest.FFormBusy.Update label/progress bar
   DoHeavyWork1();
   FrmTest.FFormBusy.Update label/progress bar
   DoHeavyWork2();
   etc.
end;      

我做错了什么？
TIA

Answer 1

如您所知，所有 UI 代码都必须在主 GUI 线程上执行。这就是您调用 Synchronize 来更新 GUI 的原因。同步工作大致如下:

1. 要在主线程上执行的任务被放置在队列中。
2. 主线程收到信号以指示同步任务正在等待处理。
3. 后台线程阻塞。
4. 当主线程接下来检查是否有挂起的同步任务时，它会执行它们。
5. 后台线程收到信号以指示任务已执行。
6. 后台线程停止阻塞并继续执行。

这是一个相当复杂的小舞蹈。

您的问题是您的主线程正忙于执行一些长时间运行的任务。大概是在对 DoHeavyWork1 和 DoHeavyWork2 的调用中。这意味着 GUI 线程无法及时执行第 4 项。而且，主线程会阻塞后台线程，这在一定程度上否定了线程的效用。

从根本上来说，您的问题是您的主 GUI 线程正忙于执行除为 GUI 提供服务之外的其他操作。您应该将 GUI 线程专门用于为 GUI 提供服务。它不应该承担任何其他任务，当然也不应该承担任何长时间运行的任务。一旦您成功地将所有非 GUI 任务从 GUI 线程发送到后台线程，您就会发现您的应用程序具有响应能力。

最后，我建议您从 UpdateDots 中删除对 Application.ProcessMessages 的调用。您添加它可能是为了尝试处理无响应的 GUI。但这根本没有帮助，因为您的问题是 UpdateDots 没有及时执行。