Как сделать анимацию GIF на «пожалуйста, подожди»?

Question

Я хотел бы сделать быстрый неблокируемый модальный диалог, который появляется, выполняя некоторые задачи, и уходит, когда задачи заканчиваются.

Есть некоторые трудности, присущие:

• Не блокировать основной поток пользовательского интерфейса;
• Не оставляйте окна системных призраков;
• Перемещение задач в отдельный поток;
• Разрешить обновлять ожидающее сообщение пользователю;
• Обработка исключений из потока в приложение;
• Показать анимированный 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;