队列不刷新 Firemonkey 上的进度条

Question

我正在使用 Queue 在 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，并为下一个表格更新 label.text：'loading form2...'

该应用程序在 Windows 和 Android 中有效。我在两个平台上都看到了相同的行为，屏幕冻结并在进程结束时更新 'loading complete'。我做错了什么？

注意：上次我使用 Synchronize，但我无法在 TTHread 上下文中创建 Forms，然后需要 Synchronize 才能访问全局变量 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

您的代码有两个问题：

您正在对 TThread.Queue() 的一次调用中执行所有 UI 更新，而没有在更新之间处理任何新的 UI 消息。主消息循环被阻塞，直到排队的过程退出。这就是为什么您只看到显示最终更新消息和 none 中间消息的原因。
请注意，TThread.Queue() 在 UI 主线程的上下文中调用时 TThread.Queue() 是 同步的 （请投票给 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;

队列不刷新 Firemonkey 上的进度条

Queue don't refresh progress bar on Firemonkey

windows

multithreading

android

delphi-xe

firemonkey