DelphiFAQ Home Search:

Paint a moving progress bar using a background thread

 

comments82 comments. Current rating: 3 stars (76 votes). Leave comments and/ or rate it.

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.
You don't like the formatting? Check out SourceCoder then!
Content-type: text/html

Comments:

You are on page 1 of 6, other pages: [1] 2 3 4 5 6
2012-06-30, 01:51:54
anonymous from China  
2012-06-30, 01:53:23
anonymous from China  
2012-06-30, 01:54:42
anonymous from China  
2012-07-23, 22:42:06
anonymous from United States  
2013-01-08, 18:48:07
anonymous from China  
2013-04-02, 14:11:14
 
rating
zbqgdkgx http://paydayloansa..iafsh.com/ payday loans australia llGDO http://paydayloansc..adafsh.ca/ payday loans online :-O http://paydayloansusafsh.com/ payday loan 3614 http://paydayloansu..fsh.co.uk/ instant Payday Loans KhKVEc
2013-04-04, 10:54:51
 
rating
kvdukiw http://buyviagradsb.com/ viagra >:-[ http://buycialisdsb.com/ buy cheap cialis =-]
2013-04-05, 20:45:40
 
rating
dfwbhilp http://genericviagradsb.com/ generic cheap viagra online 5910 http://genericcialisdsb.com/ generic cialis =-]
2013-04-11, 10:54:56
 
rating
ehazobc http://genericviagrafsc.com/ generic viagra 9928 http://genericcialisfsc.com/ generic cialis online hCsRgm
2013-04-16, 10:30:15
 
rating
fymhxhh http://paydayloansa..iadse.com/ payday loans %-[[[ http://paydayloansc..adadse.ca/ payday loans online =-] http://paydayloansusadse.com/ payday loans online 8]]]
2013-04-17, 10:27:52
 
rating
gxjzxgw http://orderviagrafsc.com/ order discount viagra 8949 http://ordercialisfsc.com/ order cialis online HuBTzr
2013-04-17, 14:09:56
anonymous from Thailand  
http://cheapsaledis..t2013.com/ cheap sale discount 2013
2013-04-19, 09:29:00
 
rating
joxnqn http://genericviagrafsc.com/ generic viagra 8108 http://genericcialisfsc.com/ generic cialis :-O
2013-04-19, 11:57:18
 
rating
jiwpayge http://paydayloansusadsg.com/ no fax payday loans DqIpx http://paydayloansa..iadsg.com/ payday loan =-] http://paydayloansc..adadsg.ca/ no fax pay day loans %-[[[ http://paydayloansu..dsg.co.uk/ Bad Credit Loans >:]]
2013-04-27, 13:05:12
 
rating
lnjvostm http://paydayloansusapwa.com/ cash advance 9575 http://paydayloansusapwa.ca/ Cash Advance :-O http://paydayloansu..pwa.co.uk/ payday cash XvXITe http://paydayloansa..iapwa.com/ payday loans online =-]
You are on page 1 of 6, other pages: [1] 2 3 4 5 6

 

 

NEW: Optional: Register   Login
Email address (not necessary):

Rate as
Hide my email when showing my comment.
Please notify me once a day about new comments on this topic.
Please provide a valid email address if you select this option, or post under a registered account.
 

Show city and country
Show country only
Hide my location
You can mark text as 'quoted' by putting [quote] .. [/quote] around it.
Please type in the code:

Please do not post inappropriate pictures. Inappropriate pictures include pictures of minors and nudity.
The owner of this web site reserves the right to delete such material.

photo Add a picture: