Italian community of Lazarus and Free Pascal

  { TBaseForm_WaitThread }

  TBaseForm_WaitThread = class(TThread)
  private
    FIndex: integer;
    FCanvas: TCanvas;
    FOffsetX, FOffsetY: integer;
    FWaitImageList: TImageList;
    procedure BlankArea;
    procedure ShowStatus;
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended: boolean);
    procedure SetCanvas(ACanvas: TCanvas; x, y: integer);
    property WaitImageList: TImageList read FWaitImageList write FWaitImageList;
  end;


constructor TBaseForm_WaitThread.Create(CreateSuspended: boolean);
begin
  inherited Create(CreateSuspended);
  FreeOnTerminate := True;
end;

procedure TBaseForm_WaitThread.SetCanvas(ACanvas: TCanvas; x, y: integer);
begin
  FCanvas := ACanvas;
  FOffsetX:=x;
  FOffsetY:=y;
end;

procedure TBaseForm_WaitThread.BlankArea;
begin
  FCanvas.Pen.Color:=clBtnFace;
  FCanvas.Brush.Color:= clDefault; //  RGBToColor(228,236,241);
  FCanvas.Rectangle(FOffsetX, FOffsetY, FOffsetX + 16, FOffsetY + 16);
end;

procedure TBaseForm_WaitThread.ShowStatus;
begin
  BlankArea;
  WaitImageList.Draw(FCanvas, FOffsetX, FOffsetY, FIndex);
end;

procedure TBaseForm_WaitThread.Execute;
var FromIndex, ToIndex: integer;
begin
   FromIndex := 0;
   ToIndex   := WaitImageList.Count - 1;
   FIndex    := -1;
   while not Terminated do begin
      inc(FIndex);
      if FIndex >= ToIndex then
         FIndex := FromIndex;
      Synchronize(@Showstatus);
      sleep(200);
   end;

   if Terminated then
      BlankArea;
end;

  TfmBaseForm = class(TForm)
   ...
   private
    FWaitThread: TBaseForm_WaitThread;
   ...
    function GetActiveWaitAnimation: boolean;
    procedure SetActiveWaitAnimation(AValue: boolean);
   ...

   public
    property ActiveWaitAnimation: boolean read GetActiveWaitAnimation write SetActiveWaitAnimation;

   end;


function TfmBaseForm.GetActiveWaitAnimation: boolean;
begin
   result := FWaitThread <> nil;
end;

procedure TfmBaseForm.SetActiveWaitAnimation(AValue: boolean);
begin

   case AValue of
      TRUE: begin
          if GetActiveWaitAnimation then
             exit
          else begin
             FWaitThread := TBaseForm_WaitThread.Create(TRUE);
             if Assigned(FWaitThread.FatalException) then
               raise FWaitThread.FatalException;
             FWaitThread.WaitImageList := ToolBox.WaitImageList;;
             FWaitThread.SetCanvas(Canvas, 200,2);
             FWaitThread.Start;
          end;
      end;

      FALSE: begin
          if not GetActiveWaitAnimation then
             exit
          else begin
             FWaitThread.Terminate;
             FWaitThread.Free;
             FWaitThread := nil;
          end;

      end;
   end;
end;

  ActiveWaitAnimation:=TRUE;

  ActiveWaitAnimation:=FALSE;