基于Tasks实现带加载屏的无阻塞动作执行及异常捕获问题排查

问题根源分析 #

你的代码存在几个核心问题，直接导致加载屏偶尔卡住：

• 跨线程操作VCL控件：TTask工作线程直接调用窗体的Hide、Close方法，VCL控件仅允许在创建它的主线程中操作，跨线程访问会导致控件状态紊乱。
• 异常捕获逻辑错误：用指针捕获局部异常对象，线程执行完毕后局部对象会被销毁，指针变为野指针，后续抛出时会引发未知错误。
• 类变量线程不安全：全局类变量FForm如果被多线程同时调用，会互相覆盖实例，引发逻辑混乱。
• 同步逻辑不合理：等待窗体显示的循环不可靠，且模态窗口与任务的关闭流程未正确同步。

修正后的代码实现 #

type
  TLoadingClass = class
  public
    class procedure ActionAndWait(Action: TProc);
  end;

class procedure TLoadingClass.ActionAndWait(Action: TProc);
var
  LoadingForm: TLoadingForm;
  TaskException: Exception;
  aTask: ITask;
begin
  TaskException := nil;
  LoadingForm := TLoadingForm.Create(nil);
  try
    aTask := TTask.Run(procedure
      begin
        try
          Action; // 执行用户自定义动作
        except
          on E: Exception do
          begin
            // 复制异常对象，避免局部变量销毁后失效
            TaskException := Exception.Create(E.Message);
            TaskException.ClassType := E.ClassType;
          end;
        end;

        // 必须在主线程操作VCL控件，用Queue异步通知主线程关闭窗体
        TThread.Queue(nil, procedure
          begin
            if LoadingForm.Showing then
              LoadingForm.Close;
          end);
      end);

    // 显示模态加载屏，直到任务通知主线程关闭
    LoadingForm.ShowModal;
  finally
    // 等待任务彻底完成，确保所有操作收尾
    if Assigned(aTask) then
      TTask.WaitForAll(aTask);
    LoadingForm.Free;

    // 重新抛出捕获到的异常
    if Assigned(TaskException) then
    begin
      try
        raise TaskException;
      finally
        TaskException.Free;
      end;
    end;
  end;
end;

关键修改说明 #

• 移除全局类变量：改用局部变量LoadingForm，避免多线程调用时的实例冲突。
• 线程安全操作窗体：用TThread.Queue将关闭窗体的逻辑委托给主线程执行，完全符合VCL控件的线程安全要求，这是解决加载屏卡住的核心。
• 正确捕获异常：创建新的Exception实例保存错误信息和类型，避免原局部异常对象销毁后指针失效的问题。
• 优化同步逻辑：模态窗口等待主线程收到任务的关闭通知后自动退出，确保流程同步可靠。

调用示例（优化版） #

不需要在Action内部捕获异常，上层可以统一处理：

try
  TLoadingClass.ActionAndWait(
    procedure
    begin
      Sleep(5000);
      raise Exception.Create('测试异常');
    end);
except
  on E: Exception do
    ShowMessage('捕获到异常：' + E.Message);
end;

内容的提问来源于stack exchange，提问作者Rafael