代码之家 › 专栏 › 技术社区 › Marc Guillot

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

delphi-10.1-berlin delphi

Marc Guillot · 技术社区 · 7 年前

我试图在应用程序繁忙(加载查询)时显示信息消息和动画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;

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

非常感谢。

2 回复 | 直到 7 年前

Jerry Dodge 7 年前

Etsitpab Nioliv 7 年前

如果它只是用于查询,并且您正在使用FireDAC,那么请查看 http://docwiki.embarcadero.com/RADStudio/Berlin/en/Asynchronous_Execution_(FireDAC) 这似乎是可能的。

要处理任何长时间的处理,可以使用线程单元。您没有在主线程中完成工作,因此可以正确显示UI。

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 似乎提供了与你想要的非常接近的东西。