队列不刷新Firemonkey上的进度条

Question

我正在使用队列在 Delphi 应用程序初始化中创建许多表单，但它不能正常工作。

下面是一段代码

TThread.Queue(TThread.CurrentThread,
         procedure()
         begin
               Application.CreateForm(TForm1, form1);
               Application.CreateForm(TForm2, form2);
               Application.CreateForm(TForm3, form3);
               .....
               Application.CreateForm(TForm9, form9);
               Application.CreateForm(TDatamodule1, datamodule1);
         end);

我希望在progressBar和label中显示创建的进度。例如： 对于最终创建的每个 Tform，我设置 TProgressBar.Value=TProgressBar.Value + 10，并为下一个 Form 更新 label.text：'loading form2...'

该应用程序适用于 Windows 和 Android。我在这两个平台上看到的相同行为，屏幕冻结并在进程结束时更新“加载完成”。我做错了什么？

---

注意：上次我使用的是 Synchronize，但我无法在 TTHread 上下文中创建 Forms，然后 Synchronize 是访问全局 var Form1 和更新标签所必需的，这不是一个好主意。

完整的代码，

TfrmSplash.create(Sender:TObject);
begin
TThread.Queue(TThread.CurrentThread,
         procedure()
         begin
               Application.CreateForm(TForm1, form1);
               TProgressBar.Value=TProgressBar.Value + 10
               Label1.text:='Loading form2';
               Application.CreateForm(TForm2, form2);
               TProgressBar.Value=TProgressBar.Value + 10
               Label1.text:='Loading form3';
               Application.CreateForm(TForm3, form3);
               TProgressBar.Value=TProgressBar.Value + 10
               Label1.text:='Loading form4';
               .....
               Application.CreateForm(TForm9, form9);
               TProgressBar.Value=TProgressBar.Value + 10
               Label1.text:='Loading data';
               Application.CreateForm(TDatamodule1, datamodule1);
               TProgressBar.Value:=100
               Label1.text:='100% complete';
               Sleep(200);
               frmSplash.hide;
               Form1.show;
         end);
end;

Answer 1

你的代码有两个问题：

1. 您将在一次调用 TThread.Queue() 中执行所有 UI 更新，而不会在更新之间处理任何新的 UI 消息。主消息循环被阻塞，直到排队的过程退出。这就是为什么您只看到显示最终更新消息而看不到任何中间消息的原因。

2. 请注意，TThread.Queue() 在主 UI 线程的上下文中调用时是同步的（请投票给RSP-15427 Add an option to let TThread.Queue() run asynchronously when called by the main UI thread）。因此，假设您是在主线程中而不是在工作线程中创建 TfrmSplash 对象，那么在完全创建 TfrmSplash 对象之前，您的所有 UI 更新都不会显示。

在创建对象时，您需要让消息队列处理新消息（至少绘制消息）。您可以在创建每个对象之间调用Application.ProcessMessages()（不推荐）或启动表单的Update() 方法（首选）。

试试类似的方法：

procedure TfrmSplash.Create(Sender: TObject);
begin
  TThread.CreateAnonymousThread(
    procedure
    begin
      TThread.Queue(nil, CreateObjects);
    end
  ).Start;
end;

procedure TfrmSplash.SetProgress(Progress: Integer; const Text: string);
begin
  TProgressBar.Value := Progress;
  Label1.Text := Text;
  //Application.ProcessMessages;
  Update;
end;

procedure TfrmSplash.CreateObjects;
begin
  SetProgress(0, 'Loading form1');
  Application.CreateForm(TForm1, form1);

  SetProgress(10, 'Loading form2');
  Application.CreateForm(TForm2, form2);

  SetProgress(20, 'Loading form3');
  Application.CreateForm(TForm3, form3);

  SetProgress(30, 'Loading form4');
  ...

  SetProgress(80, 'Loading form9');
  Application.CreateForm(TForm9, form9);

  SetProgress(90, 'Loading data');
  Application.CreateForm(TDatamodule1, datamodule1);

  SetProgress(100, '100% complete');

  Hide;
  Form1.Show;
end;