Draw Animation Thread

uses XPMan

type
  TAnimationThread = class(TThread)
  private
    { Private declarations }
    FWnd: HWND;
    FPaintRect: TRect;
    FbkColor, FfgColor: TColor;
    FInterval: integer;
  protected
    procedure Execute; override;
  public
    constructor Create(paintsurface : TWinControl;
      paintrect : TRect;
      bkColor, barcolor : TColor;
      interval : integer);
  end;
  
//

constructor TAnimationThread.Create(paintsurface : TWinControl;
  paintrect : TRect; bkColor, barcolor : TColor; interval : integer);
begin
  inherited Create(True);
  FWnd := paintsurface.Handle;
  FPaintRect := paintrect;
  FbkColor := bkColor;
  FfgColor := barColor;
  FInterval := interval;
  FreeOnterminate := True;
  Resume;
end;

procedure TAnimationThread.Execute;
var
  image : TBitmap;
  DC : HDC;
  left, right : integer;
  increment : integer;
  imagerect : TRect;
  state : (incRight, incLeft, decLeft, decRight);
begin
  Image := TBitmap.Create;
  try
    with Image do 
    begin
      Width := FPaintRect.Right - FPaintRect.Left;
      Height := FPaintRect.Bottom - FPaintRect.Top;
      imagerect := Rect(0, 0, Width, Height);
    end;
    left := 0;
    right := 0;
    increment := imagerect.right div 50;
    state := Low(State);
    while not Terminated do 
    begin
      with Image.Canvas do
      begin
        Brush.Color := FbkColor;
        FillRect(imagerect);
        case state of
          incRight: 
          begin
            Inc(right, increment);
            if right > imagerect.right then
            begin
              right := imagerect.right;
              Inc(state);
            end;
          end;
          incLeft: 
          begin
            Inc(left, increment);
            if left >= right then 
            begin
              left := right;
              Inc(state);
            end;
          end;
          decLeft: 
          begin
            Dec(left, increment);
            if left <= 0 then 
            begin
              left := 0;
              Inc(state);
            end;
          end;
          decRight:
          begin
            Dec(right, increment);
            if right <= 0 then 
            begin
              right := 0;
              state := incRight;
            end;
          end;
        end;
        Brush.Color := FfgColor;
        FillRect(Rect(left, imagerect.top, right, imagerect.bottom));
      end;
      DC := GetDC(FWnd);
      if DC <> 0 then
        try
          BitBlt(DC,
            FPaintRect.Left,
            FPaintRect.Top,
            imagerect.right,
            imagerect.bottom,
            Image.Canvas.handle,
            0, 0,
            SRCCOPY);
        finally
          ReleaseDC(FWnd, DC);
        end;
      Sleep(FInterval);
    end; { While }
  finally
    Image.Free;
  end;
  InvalidateRect(FWnd, nil, True);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  ani : TAnimationThread;
  r : TRect;
  begin  
  r := panel1.ClienTRect;
  InflateRect(r, - panel1.bevelwidth, - panel1.bevelwidth);
  ani := TanimationThread.Create(panel1, r, panel1.color, clBlue, 25);
  Button1.Enabled := False;
  Application.ProcessMessages;
  Sleep(3000);          // replace with query.Open or such
  Button1.Enabled := True;
  ani.Terminate;
  ShowMessage('Done');
end;