在任务中执行操作的例程，显示加载屏幕，而不冻结主窗体

Question

我希望构建一个例程，负责使用任务通过过程（Tproc）执行任何操作，同时显示加载屏幕，而不冻结系统的主窗体。一个额外的细节是，它还能够捕获该操作可能生成的可能异常。

我构建了下面的代码，效果很好，但有时会出现问题，加载屏幕最终不会关闭，始终显示在屏幕上。

欢迎任何建议。谢谢。

type
  TLoadingClass= class
  strict private
    class var FForm: TForm;

  public
    class procedure ActionAndWait(Action: Tproc);
  end;

class procedure TLoadingClass.ActionAndWait(Action: Tproc);
var
  aTask: ITask;
  vException: Pointer;
begin
  vException := nil;

  FForm := TLoadingForm.Create(nil);
  try
    aTask := TTask.Run(procedure
      begin
        try
          try
            Action; {Run Action}
          except on E: Exception do
            vException := @E {Capture Exception}
          end
        finally
          while not FForm.Showing do {Wait for the form to be created, if the action is very quick.}
            Sleep(1);
          TLoadingForm(FForm).Hide;
          TLoadingForm(FForm).Close;
        end;
      end);
    TLoadingForm(FForm).ShowModal; {Show the loading form}
  finally
    TTask.WaitForAll(aTask);
    FreeAndNil(FForm);
    if Assigned(vException) then
      raise Exception(@vException);
  end;
end;

调用示例

  TLoadingClass.ActionAndWait(
  procedure
  begin
    try
      Sleep(5000);
      raise Exception.Create('Test');
    except on E: Exception do
      ShowMessage(E.Message);
    end;
  end);

Answer 1

您的代码有几个问题。

首先，您从后台线程访问 UI（表单），这是您永远不应该做的。这样的代码总是需要与主线程同步。

接下来，你没有正确处理任务异常。异常对象由编译器自动处理，您不能只获取指向异常对象的指针并在以后使用它。任务方法中的整个

try...except

毫无用处。如果任务中存在未处理的异常，

Wait

或

WaitForAll

将引发

EAggregatedException

，您可以捕获该异常并在那里处理其内部异常。如果有多个任务引发异常，则会出现多个内部异常。

接下来，您已经在传递给

ActionAndWait

的匿名方法中捕获了异常，因此捕获的异常不会作为

EAgreggatedException

传播。

ShowMessage

中的

ActionAndWait

将在后台线程的上下文中运行，如果您想从那里使用 UI，它还需要与主线程同步。

您已将

FForm

声明为

TLoadingClass

中的字段。最好删除该字段并使用局部变量，就像您在任务中使用的一样。当您调用

FForm

和

TLoadingForm

时，也无需将

Hide

转换为

Close

。除此之外，调用

Close

就足够了，因为它也会隐藏表单。

清理和更正后的代码如下所示：

class procedure TLoadingClass.ActionAndWait(Action: Tproc);
var
  LTask: ITask;
  LForm: TLoadingForm;
begin
  try
    LTask := TTask.Create(procedure
      begin
        try
          Action;
        finally
          TThread.Queue(nil,
            procedure
            begin
              while not LForm.Showing do
                Sleep(1);
              LForm.Close;
            end);
        end;
      end);
    LForm := TLoadingForm.Create(nil);
    try
      LTask.Start;
      LForm.ShowModal;
    finally
      TTask.WaitForAll(LTask);
      LForm.Free;
    end;
  except
    on E: EAggregateException do
      for var i := 0 to E.Count - 1 do
        ShowMessage(E.InnerExceptions[i].Message);
    on E: Exception do
      ShowMessage(E.Message);
  end;
end;

以及调用示例：

  TLoadingClass.ActionAndWait(
  procedure
  begin
    Sleep(5000);
    raise Exception.Create('Test');
  end);