Mega Code Archive
Paint a moving progress bar using a background thread
<![CDATA[
Question:
I am trying to display records in a dbgrid. Due to amount of data it takes a while for the query to execute. Is there any way to show a progress bar with a timer that increments position but continues to work while the query is being executed?
Answer:
by Peter Below, TeamB
A progress bar would not be an ideal choice since you cannot determine upfront 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).
The unit AniThread implements a thread with a progress bar and at the bottom you see an example how to use this class.
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; { TAnimationThread.Create }
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; { with }
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; { if }
end; { case incRight }
incLeft:
begin
Inc(left, increment);
if left >= right then
begin
left := right;
Inc(state);
end; { if }
end; { case incLeft }
decLeft:
begin
Dec(left, increment);
if left <= 0 then
begin
left := 0;
Inc(state);
end; { if }
end; { case decLeft }
decRight:
begin
Dec(right, increment);
if right <= 0 then
begin
right := 0;
state := incRight;
end; { if }
end; { case decLeft }
end; { case }
Brush.Color := FfgColor;
FillRect(Rect(left, imagerect.top, right, imagerect.bottom));
end; { with }
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; { TAnimationThread.Execute }
end.
//============================ HOW to USE IT ============================
{
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.
]]>