How to paint a moving progress bar using a background thread

Problem/Question/Abstract:

I query several tables and display records in a TDBGrid . However, due to the size of the tables and joins, it takes a while for the query to execute. Is there any way to show a progress bar with a timer that increments the position but continues to work while the query is being executed.

Answer:

A progress bar would not be an ideal choice since you cannot determine up front how long the query will take, so you do not know the range the progress bar has to cover. A simple kind of animation that tells the user basically only that the application is not hung would be more appropriate. One could do such a thing in a secondary thread but it would have to be done using the plain Windows API and no Synchronize calls (since the main thread is blocked in the BDE call). Here is an example:


unit anithread;

interface

uses
  Classes, Windows, Controls, Graphics;

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; {Control to paint on}
      paintrect: TRect; {area for animation bar}
      bkColor, barcolor: TColor; {colors to use}
      interval: Integer {wait in msecs between paints}
      );
  end;

implementation

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;
  finally
    Image.Free;
  end;
  InvalidateRect(FWnd, nil, true);
end;

end.


Usage:

Place a TPanel on a form, size it as appropriate. Create an instance of the TanimationThread call like this:


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(30000); {replace with query.Open or such}
  Button1.Enabled := true;
  ani.Terminate;
  ShowMessage('Done');
end;