在应用程序繁忙时显示带有消息和动画图像的表单

Question

我正在尝试在我的应用程序忙（加载查询）时显示信息消息和动画 gif（沙漏）。

我已经定义了一个表单来显示该消息（使用 post: How to use Animated Gif in a delphi form 中显示的代码）。这是构造函数。

constructor TfrmMessage.Show(DisplayMessage: string);
begin
  inherited Create(Application);
  lblMessage.Caption := DisplayMessage;
  // Set the Message Window on Top
  SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NoMove or SWP_NoSize);
  Visible := True;
  // Animate the HourGlass image
  (imgHourGlass.Picture.Graphic as TGIFImage).Animate := True;
  Update;
end;

问题是当主线程忙（加载查询）时动画 Gif 保持静止。

我试过在单独的线程上手动绘制动画。

type
  TDrawHourGlass = class(TThread)
    private
      FfrmMessage: TForm;
    public
      constructor Create(AfrmMessage: TForm);
      procedure Execute; override;
      procedure ShowFrame1;
      procedure ShowFrame2;
      procedure ShowFrame3;
      procedure ShowFrame4;
      procedure ShowFrame5;
  end;

constructor TDrawHourGlass.Create(AfrmMessage: TForm);
begin
  inherited Create(False);
  FfrmMessage := AfrmMessage;
end;

procedure TDrawHourGlass.Execute;
var FrameActual: integer;
begin
  FrameActual := 1;
  while not Terminated do begin
    case FrameActual of
      1: Synchronize(ShowFrame1);
      2: Synchronize(ShowFrame2);
      3: Synchronize(ShowFrame3);
      4: Synchronize(ShowFrame4);
      5: Synchronize(ShowFrame5);
    end;
    FrameActual := FrameActual + 1;
    if FrameActual > 6 then FrameActual := 1;
    sleep(200);
  end;
end;

procedure TDrawHourGlass.ShowFrame1;
begin
  (FfrmMessage as TfrmMessage).imgHourGlass.Picture.Bitmap.Assign((FfrmMessage as TfrmMessage).Frame1.Picture.Graphic);
  (FfrmMessage as TfrmMessage).imgHourGlass.Update;
end;

implementation

procedure TDrawHourGlass.ShowFrame2;
begin
  (FfrmMessage as TfrmMessage).imgHourGlass.Picture.Bitmap.Assign((FfrmMessage as TfrmMessage).Frame2.Picture.Graphic);
  (FfrmMessage as TfrmMessage).imgHourGlass.Update;
end;

procedure TDrawHourGlass.ShowFrame3;
begin
  (FfrmMessage as TfrmMessage).imgHourGlass.Picture.Bitmap.Assign((FfrmMessage as TfrmMessage).Frame3.Picture.Graphic);
  (FfrmMessage as TfrmMessage).imgHourGlass.Update;
end;

procedure TDrawHourGlass.ShowFrame4;
begin
  (FfrmMessage as TfrmMessage).imgHourGlass.Picture.Bitmap.Assign((FfrmMessage as TfrmMessage).Frame4.Picture.Graphic);
  (FfrmMessage as TfrmMessage).imgHourGlass.Update;
end;

procedure TDrawHourGlass.ShowFrame5;
begin
  (FfrmMessage as TfrmMessage).imgHourGlass.Picture.Bitmap.Assign((FfrmMessage as TfrmMessage).Frame5.Picture.Graphic);
  (FfrmMessage as TfrmMessage).imgHourGlass.Update;
end;

但我得到了相同的结果，虽然主线程很忙，但动画仍然静止，因为调用 (FfrmMessage as TfrmMessage).imgHourGlass.Update; 来绘制每一帧，等待主线程完成（即使没有在同步中调用它们）。

你有什么建议我也可以试试吗？

谢谢。

Answer 1

非常不幸的是，Delphi 中的许多组件基本上鼓励糟糕的应用程序设计（阻塞主线程）。在这种情况下，您应该认真考虑交换线程的目的，以便所有冗长的处理都在一个线程（或多个）内完成，并将所有绘图留给主 UI 线程。在处理任意数量的数据时，没有多少干净的方法可以使主线程响应。

Answer 2

如果它仅用于查询并且您使用的是 FireDAC，那么请查看 http://docwiki.embarcadero.com/RADStudio/Berlin/en/Asynchronous_Execution_(FireDAC) 似乎是可行的。

要处理任何类型的冗长处理，您可以使用线程单元。您不在主线程中进行工作，因此 UI 可以正确显示。

这个例子并不完美（您可能应该使用某种回调），但是 gif 正在旋转。

procedure TForm3.ButtonProcessClick(Sender: TObject);
begin
  // Block UI to avoid executing the work twice
  ButtonProcess.Enabled := false;
  TTask.Create(
    procedure
    begin
      Sleep(10000);
      // Enable UI again
      ButtonProcess.Enabled := true;
    end).Start();
end;

首先要让 gif 旋转，我使用：

procedure TForm3.FormCreate(Sender: TObject);
begin
  (GifLoading.Picture.Graphic as TGIFImage).Animate := true;
end;

我没试过，但 this link 似乎提供了与您想要的非常接近的东西。

希望这对您有所帮助。

在应用程序繁忙时显示带有消息和动画图像的表单

Show a Form with a message and an animated image while the application is busy

delphi

delphi-10.1-berlin