如何在 "please, wait form" 上制作 GIF 动画？

Question

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

存在一些固有的困难：

不要阻塞主UI线程；
不要留下系统幽灵windows;
将任务移到运行到一个单独的线程中；
允许更新等待消息给用户；
处理从线程到应用程序的异常；
在对话框中显示动画 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;

Answer 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;

如何在 "please, wait form" 上制作 GIF 动画？

How to make GIF animate on "please, wait form"?

delphi

gif

animated-gif