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

我正试图在应用程序繁忙（加载查询）时显示一条信息消息和一个动画gif（沙漏）

我已经定义了一个表单来显示该消息（使用本文中显示的代码：）。这是构造函数

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作为TfrmMessage）；要绘制每个帧，请等待主线程完成（即使在同步过程中没有调用它们）

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

---

谢谢。

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

如果它只是用于查询，而您使用的是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;

我没有试过，但似乎提供了一些非常接近你想要的东西

---

希望这能有所帮助。

我不会说数据组件可以做到这一点。如果您谈论的是绑定的数据感知控件，那么只需解除它们的绑定，在工作线程中执行工作并将它们绑定回来。或者，如果组件支持异步执行，您可以尝试一下。事实上，肯定不是所有组件，也不是少数组件。它们中的许多本质上是锁定主线程的。我指的不是绑定或数据感知组件。只要在一个有数百万条记录的表上执行一个简单的查询就足以锁定主线程——当然，这取决于所使用的组件。我从来没有见过你说的。如果在工作线程中执行查询，通常不会阻止主线程。我们需要更多关于所用技术的信息，以使其更具体。@Victoria确切地说，这就是为什么我建议将其作为一种解决方案。在最初的问题中：“问题是，当主线程忙（加载查询）时，动画Gif仍然保持静止。”我不理解您的评论。解决方案是相同的，即使对于其他与数据库无关的组件也是如此。这是一个需要在后台工作的REST调用（请参阅对我的问题注释的回答）。此外，FireDAC提供异步执行模式，但不适用于这种情况。在这里，您正确地交换了逻辑。您使用的是FireDAC还是其他库？是的，FireDAC（调用返回数据集的Datasnap远程方法）。那么，需要在后台工作的不是数据组件，而是REST调用（为什么需要在服务器上显示这样的对话框？）。FireDAC支持异步模式，但对于REST服务器则不需要。据我记忆所及，它有一些线程模型。然后创建一个线程，在其中等待执行事件，执行REST调用并将收到的数据集作为消息的参数发布到由

AllocateHwnd

创建的不可见窗口，或者使用

Synchronize

将数据集传递到主线程。动画将继续在主线程中运行。在线程启动时创建该窗体，在线程终止或开始等待另一次执行时销毁该窗体。不，只要长时间运行的同步调用阻止主线程消息循环，任何工作线程都不会帮助您（

Synchronize

将在此类调用完成后执行）。负责任UI的经验法则是，保持主线程没有任何长时间运行的阻塞调用（REST调用就是这样的，所以将该调用移动到工作线程）。为什么要在REST服务器上使用异步执行？REST客户端调用需要在后台运行（并显示该对话框）。@Victoria我可以想出很多理由。我自己的一个项目是信用卡机器的仿真器，里面有一个REST服务器，接收命令。@Victoria我还没有见过REST。我的示例中的TForm3类表明我们使用的是一个典型的VCL重客户端应用程序。这是。