如何在“请，等待表单”上制作 GIF 动画？答案

【问题标题】：How to make GIF animate on "please, wait form"?如何在“请，等待表单”上制作 GIF 动画？
【发布时间】：2015-11-14 03:56:13
【问题描述】：

我想做一个快速的不可关闭的模态对话框，在执行某些任务时弹出，并在任务完成后消失。

存在一些固有的困难：

不要阻塞主 UI 线程；
不要离开系统幽灵窗口；
将任务移动到单独的线程中运行；
允许向用户更新等待消息；
处理从线程到应用程序的异常；
在对话框中显示动画 GIF；

如何绕过这些陷阱？

下面是我如何使用它的实际示例：

TWaiting.Start('Waiting, loading something...');
try
  Sleep(2000);
  TWaiting.Update('Making something slow...');
  Sleep(2000);
  TWaiting.Update('Making something different...');
  Sleep(2000);
finally
  TWaiting.Finish;
end;

【问题讨论】：

Sleep(2000) 是问题所在。不要阻塞主 UI 线程。您需要将长时间运行的任务移到单独的线程中。
好的，我明白了，但是将我正在运行的任务移到一个单独的线程中可能很难...有办法让 TWaiting 运行到一个单独的线程中吗？
没有。那样不行。您需要停止阻塞 UI 线程。那是你的问题。
也许这听起来很菜鸟问题，但是，TWaiting 使用CreateWindow() (WinAPI) 来创建对话框和控件，而不是使用 VCL。可能有用吗？
可以的。

标签： delphi gif animated-gif

【解决方案1】：

type
  TWaiting = class(TForm)
    WaitAnimation: TImage;
    WaitMessage: TLabel;
    WaitTitle: TLabel;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  strict private
    class var FException: Exception;
  private
    class var WaitForm : TWaiting;
    class procedure OnTerminateTask(Sender: TObject);
    class procedure HandleException;
    class procedure DoHandleException;
  public
    class procedure Start(const ATitle: String; const ATask: TProc);
    class procedure Status(AMessage : String);
  end;

implementation

{$R *.dfm}

procedure TWaiting.FormCreate(Sender: TObject);
begin
  TGIFImage(WaitAnimation.Picture.Graphic).Animate := True;
end;

procedure TWaiting.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

class procedure TWaiting.Start(const ATitle: String; const ATask: TProc);
var
  T : TThread;
begin
  if (not Assigned(WaitForm))then
    WaitForm := TWaiting.Create(nil);

  T := TThread.CreateAnonymousThread(
  procedure
  begin
    try
      ATask;
    except
      HandleException;
    end;
  end);

  T.OnTerminate := OnTerminateTask;
  T.Start;

  WaitForm.WaitTitle.Caption := ATitle;
  WaitForm.ShowModal;

  DoHandleException;
end;

class procedure TWaiting.Status(AMessage: String);
begin
  TThread.Synchronize(TThread.CurrentThread,
  procedure
  begin
    if (Assigned(WaitForm)) then
    begin
      WaitForm.WaitMessage.Caption := AMessage;
      WaitForm.Update;
    end;
  end);
end;

class procedure TWaiting.OnTerminateTask(Sender: TObject);
begin
  if (Assigned(WaitForm)) then
  begin
    WaitForm.Close;
    WaitForm := nil;
  end;
end;

class procedure TWaiting.HandleException;
begin
  FException := Exception(AcquireExceptionObject);
end;

class procedure TWaiting.DoHandleException;
begin
  if (Assigned(FException)) then
  begin
    try
      if (FException is Exception) then
        raise FException at ReturnAddress;
    finally
      FException := nil;
      ReleaseExceptionObject;
    end;
  end;
end;
end.

用法：

procedure TFSales.FinalizeSale;
begin
  TWaiting.Start('Processing Sale...',
  procedure
  begin
    TWaiting.Status('Sending data to database'); 
    Sleep(2000);
    TWaiting.Status('Updating Inventory');
    Sleep(2000);
  end);
end;

【讨论】：