Delphi 10.4 FMX App 用 Thread 替换 Application.ProcessMessage()

Question

我正在尝试运行一个简单的示例 Delphi 10.4 FMX 程序，该程序根据 Android and Application.ProcessMessages 和 Does application.processmessages behaviour differ between VCL and FMX? 的建议取消了 Application.ProcessMessages()。

该按钮仅更新标签 3 次。继Background Operations on Delphi Android, with Threads and Timers 之后，它按预期工作，只需要一级更改，而不是两级更改。

有人能指出我做错了什么吗？我已将代码留下Application.ProcessMessages() 以显示所需的效果。

function Measure1sec(wait: integer): boolean;
var
  sw: TStopwatch;
begin
  sw := TStopwatch.StartNew;
  while sw.ElapsedMilliseconds < wait do sw.ElapsedMilliseconds;
  Result := TRUE;
end;
    
procedure TForm1.EndProgress(Sender: TObject);
var
  Thread: TThread;
begin
  Measure1sec(500);
  label1.text := 'orange';
end;
    
procedure TForm1.Button1Click(Sender: TObject);
var
  Thread: TThread;
begin
  {
  //////////////////  Using Application.ProcessMessages //////////////
  label1.text := 'apple';
  // Application.ProcessMessages;   // with this works without not
  Measure1sec(500);
  label1.text := 'orange';
  // Application.ProcessMessages;   // with this works without not
  Measure1sec(500);
  label1.text := 'done';
  // Application.ProcessMessages;   // with this works without not
  Measure1sec(500);
  }
    
  //////////////////  Using Threads //////////////////////////////////
  Thread := TThread.CreateAnonymousThread(
    procedure
    begin
      TThread.Synchronize(TThread.Current,
        procedure
        begin
          label1.text := 'apple';
        end
      );
    end
  );
  Thread.OnTerminate := EndProgress;
  Thread.Start;
end;

Answer 1

首先，您的Measure1sec() 函数效率低下。而不是在繁忙的循环中使用TStopWatch，而是可以重写为使用TThread.Sleep()，例如：

procedure Measure1sec(wait: integer); inline;
begin
  TThread.Sleep(wait);
end;

在这种情况下，你不妨干脆把Measure1sec()去掉，例如：

label1.text := 'apple';
// Application.ProcessMessages;
TThread.Sleep(500);
label1.text := 'orange';
// Application.ProcessMessages;
TThread.Sleep(500);
label1.text := 'done';
// Application.ProcessMessages;
TThread.Sleep(500);

现在，回答您的问题 - 您没有看到所有标签更新，因为您的工作线程仅执行 1 次标签更新。对于您正在尝试的内容，您需要让线程执行多个标签更新，例如：

procedure TForm1.Button1Click(Sender: TObject);
begin
  TThread.CreateAnonymousThread(
    procedure
    begin
      TThread.Synchronize(nil,
        procedure
        begin
          label1.text := 'apple';
        end
      );
      TThread.Sleep(500);
      TThread.Synchronize(nil,
        procedure
        begin
          label1.text := 'orange';
        end
      );
      TThread.Sleep(500);
      TThread.Synchronize(nil,
        procedure
        begin
          label1.text := 'done';
        end
      );
      TThread.Sleep(500);
    end
  ).Start;
end;

但是，这在很大程度上是对工作线程的浪费，因为大部分工作都在主 UI 线程中执行。因此，我建议完全摆脱TThread，改用TThread.ForceQueue()，例如：

procedure TForm1.Button1Click(Sender: TObject);
begin
  Step1;
end;

procedure TForm1.Step1;
begin
  label1.text := 'apple';
  TThread.ForceQueue(nil, Step2, 500);
end;

procedure TForm1.Step2;
begin
  label1.text := 'orange';
  TThread.ForceQueue(nil, Step3, 500);
end;

procedure TForm1.Step3;
begin
  label1.text := 'done';
end;

或者：

procedure TForm1.Button1Click(Sender: TObject);
begin
  label1.text := 'apple';
  TThread.ForceQueue(nil,
    procedure
    begin
      label1.text := 'orange';
    end,
    500
  );
  TThread.ForceQueue(nil,
    procedure
    begin
      label1.text := 'done';
    end,
    1000
  );
end;