2

以下是“进度”表单的部分代码。
除了 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

4

1 回答 1

2

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

  1. 要在主线程上执行的任务被放置在一个队列中。
  2. 向主线程发出信号以指示同步任务处于未决状态。
  3. 后台线程阻塞。
  4. 当主线程接下来检查是否有挂起的同步任务时，它会执行它们。
  5. 后台线程发出信号以指示任务已执行。
  6. 后台线程停止阻塞并继续执行。

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

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

从根本上讲，您的问题是您的主 GUI 线程正忙于为 GUI 提供服务之外的其他事情。您应该将您的 GUI 线程专门用于为 GUI 提供服务。它不应该承担任何其他任务，当然也不应该承担任何长期运行的任务。一旦您设法将所有非 GUI 任务从 GUI 线程发送到后台线程，您会发现您的应用程序是响应式的。

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

于 2013-05-08T11:48:20.643 回答