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的原因。同步工作大致如下：

要在主线程上执行的任务放在队列中。
发出主线程信号，表示同步任务正在等待。
后台线程阻止。
当主线程接下来检查是否有待处理的同步任务时，它会执行它们。
发出后台线程信号，表示任务已执行。
后台线程停止阻塞并继续执行。

这是一个非常复杂的小舞蹈。

你的问题是你的主线程忙于执行一些长时间运行的任务。大概是在致DoHeavyWork1和DoHeavyWork2的电话中。这意味着GUI线程不会及时执行第4项。更重要的是，主线程阻塞了后台线程，在某种程度上否定了线程的实用性。

从根本上说，您的问题是您的主GUI线程正在忙于执行除服务GUI之外的其他操作。您应该将GUI线程专用于为GUI提供服务。它不应该采取任何其他措施，当然也不应该是任何长期运行的任务。一旦您设法将所有非GUI任务从GUI线程发送到后台线程，您就会发现应用程序是响应式的。

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

线程不在打开的非模态窗体上执行

1 个答案: