Question

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

我已经定义了一个表单来显示该消息（使用此帖子中显示的代码：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为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似乎提供了与你想要的东西非常接近的东西。

希望这有帮助。

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

2 个答案: