Author: Tomas Rutkauskas
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:
1 unit anithread;
2
3 interface
4
5 uses
6 Classes, Windows, Controls, Graphics;
7
8 type
9 TAnimationThread = class(TThread)
10 private
11 { Private declarations }
12 FWnd: HWND;
13 FPaintRect: TRect;
14 FbkColor, FfgColor: TColor;
15 FInterval: Integer;
16 protected
17 procedure Execute; override;
18 public
19 constructor create(
20 paintsurface: TWinControl; {Control to paint on}
21 paintrect: TRect; {area for animation bar}
22 bkColor, barcolor: TColor; {colors to use}
23 interval: Integer {wait in msecs between paints}
24 );
25 end;
26
27 implementation
28
29 constructor TAnimationThread.create(paintsurface: TWinControl;
30 paintrect: TRect; bkColor, barcolor: TColor; interval: Integer);
31 begin
32 inherited Create(true);
33 FWnd := paintsurface.Handle;
34 FPaintRect := paintrect;
35 FbkColor := bkColor;
36 FfgColor := barColor;
37 FInterval := interval;
38 FreeOnterminate := True;
39 Resume;
40 end;
41
42 procedure TAnimationThread.Execute;
43 var
44 image: TBitmap;
45 DC: HDC;
46 left, right: Integer;
47 increment: Integer;
48 imagerect: TRect;
49 state: (incRight, incLeft, decLeft, decRight);
50 begin
51 Image := TBitmap.Create;
52 try
53 with Image do
54 begin
55 Width := FPaintRect.Right - FPaintRect.Left;
56 Height := FPaintRect.Bottom - FPaintRect.Top;
57 imagerect := Rect(0, 0, Width, Height);
58 end;
59 left := 0;
60 right := 0;
61 increment := imagerect.right div 50;
62 state := Low(State);
63 while not Terminated do
64 begin
65 with Image.Canvas do
66 begin
67 Brush.Color := FbkColor;
68 FillRect(imagerect);
69 case state of
70 incRight:
71 begin
72 Inc(right, increment);
73 if right > imagerect.right then
74 begin
75 right := imagerect.right;
76 Inc(state);
77 end;
78 end;
79 incLeft:
80 begin
81 Inc(left, increment);
82 if left >= right then
83 begin
84 left := right;
85 Inc(state);
86 end;
87 end;
88 decLeft:
89 begin
90 Dec(left, increment);
91 if left <= 0 then
92 begin
93 left := 0;
94 Inc(state);
95 end;
96 end;
97 decRight:
98 begin
99 Dec(right, increment);
100 if right <= 0 then
101 begin
102 right := 0;
103 state := incRight;
104 end;
105 end;
106 end;
107 Brush.Color := FfgColor;
108 FillRect(Rect(left, imagerect.top, right, imagerect.bottom));
109 end;
110 DC := GetDC(FWnd);
111 if DC <> 0 then
112 try
113 BitBlt(DC, FPaintRect.Left, FPaintRect.Top, imagerect.right,
114 imagerect.bottom,
115 Image.Canvas.handle, 0, 0, SRCCOPY);
116 finally
117 ReleaseDC(FWnd, DC);
118 end;
119 Sleep(FInterval);
120 end;
121 finally
122 Image.Free;
123 end;
124 InvalidateRect(FWnd, nil, true);
125 end;
126
127 end.
Usage:
Place a TPanel on a form, size it as appropriate. Create an instance of the
TanimationThread call like this:
128 procedure TForm1.Button1Click(Sender: TObject);
129 var
130 ani: TAnimationThread;
131 r: TRect;
132 begin
133 r := panel1.clientrect;
134 InflateRect(r, -panel1.bevelwidth, -panel1.bevelwidth);
135 ani := TanimationThread.Create(panel1, r, panel1.color, clBlue, 25);
136 Button1.Enabled := false;
137 Application.ProcessMessages;
138 Sleep(30000); {replace with query.Open or such}
139 Button1.Enabled := true;
140 ani.Terminate;
141 ShowMessage('Done');
142 end;
|
