Question

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

存在一些固有的困难：

不要阻止主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;

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;

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

1 个答案: