Avatar of danival_lucas
danival_lucas
 asked on

Endless ProgressBar

Hi,

How to make on delphi a endless progress bar like WinXP boot screen?
I mean, to tell the user that the process is running but the system doesn't know when it will be finished.

Thanks
Delphi

Avatar of undefined
Last Comment
OliwareZ

8/22/2022 - Mon
SteveBay

There are several ways to do this. Here's one:
Use a TTimer with  a short interval (like 5ms) and do something like this:
procedure TForm1.Timer1Timer(Sender: TObject);
begin
     if ProgressBar1.Position = 100 then
          ProgressBar1.Position := 0;
     ProgressBar1.Position := ProgressBar1.Position + 1;
     ProgressBar1.Refresh;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
     Timer1.Enabled := not Timer1.Enabled;
end;

Open in new window

danival_lucas

ASKER
but I want something like that bar from winxp boot... with those 3 blocks running from left to right...
any ideas?
need to use animation?
SteveBay

Yeah, I get what your asking. That would quite a bit more complicated. I don't know of any standard Delphi components that would do that so a custom component may be what you are after.
All of life is about relationships, and EE has made a viirtual community a real community. It lifts everyone's boat
William Peck
ASKER CERTIFIED SOLUTION
SteveBay

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
GET A PERSONALIZED SOLUTION
Ask your own question & get feedback from real experts
Find out why thousands trust the EE community with their toughest problems.
TheRealLoki

Drop a TAnimate on the form, and choose 1 of the existing windows avi's
set it to active...

danival_lucas

ASKER
but there's not progressbar animation on TAnimate
bokist

Here is the way how I am doing it, in case the task is time demanding (running more then few seconds)  :
The attached code is usually in separate unit(for instance : Unit1)

in processing unit :

drop a TPanel (Panel1) on the form and resize it progress bar like (thin and long).

uses
   Unit1 (where the animation thread is)

procedure TForm1.Button1Click(Sender : TObject);
var
    Rect : TRect;
begin
    Color_nr := 0;
    Panel1.Visible := True;
    Rect := Panel1.ClientRect;
    Animation := TAnimationThread.Create(Panel1, Rect, Panel1.Color, Color_nr, 30);

    Sleep(10000);     //  do_some_stuff (process data)

    Animation.Terminate;
    Panel1.Visible := False;
end;

Regards,  
Steve

P.S. Sorry about my poor english

type
    TAnimationThread = class(TThread)
  private
    FWnd: HWND;
    FPaintRect: TRect;
    FInterval: Integer;
    FbkColor, FfgColor: TColor;
    procedure DrawGradient(ACanvas: TCanvas; Rect: TRect; Horizontal: Boolean; Colors: array of TColor);
  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;
 
var
  Animation : TAnimationThread;
  Color_nr : integer;
 
  Color_codes : array[0..6] of Tcolor =
        ($00CCFFCC,$0099CC99,$0099FFCC,$00056557,$00BAFF6F,$0099FFCC,$00CCFFCC);
 
 
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
  DC: HDC;
  image: TBitmap;
  imagerect: TRect;
  Alt_col : TColor;
  left, right, increment : Integer;
  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;
     state := Low(State);
     increment := imagerect.right div 50;
     while not Terminated do
        begin
        with Image.Canvas do
             begin
             Brush.Color := FbkColor;
             DrawGradient(Image.Canvas, imagerect, True, [FbkColor, FbkColor]);
             Case state of
                incRight:  begin
                           FfgColor := Color_codes[Color_nr];
                           Alt_col  := Color_codes[Color_nr + 1];
                           Inc( right, increment );
                           if right > imagerect.right then
                              begin
                              right := imagerect.right;
                              Inc(state);
                            end;
                           end;
                incLeft:   begin
                           FfgColor := Color_codes[Color_nr];
                           Alt_col  := Color_codes[Color_nr + 1];
                           Inc( left, increment );
                           if left >= right then
                              begin
                              left := right;
                              Inc(state);
                              Inc(Color_nr);
                              if Color_nr > 5 then Color_nr := 0;
                            end;
                           end;
                decLeft:   begin
                           FfgColor := Color_codes[Color_nr];
                           Alt_col  := Color_codes[Color_nr + 1];
                           Dec( left, increment );
                           if left <= 0 then
                              begin
                              left := 0;
                              Inc(state);
                            end;
                           end;
                decRight:  begin
                           FfgColor := Color_codes[Color_nr];
                           Alt_col  := Color_codes[Color_nr + 1];
                           Dec( right, increment );
                           if right <= 0 then
                              begin
                              right := 0;
                              state := incRight;
                              Inc(Color_nr);
                              if Color_nr > 5 then Color_nr := 0;
                            end;
                           end;
             end;
             Brush.Color := FfgColor;
             DrawGradient(Image.Canvas,Rect(Left,imagerect.Top,Right,imagerect.Bottom),True,[FfgColor,Alt_col]);
         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;
 
procedure TAnimationThread.DrawGradient(ACanvas: TCanvas; Rect: TRect;
                   Horizontal: Boolean; Colors: array of TColor);
type
  RGBArray = array[0..2] of Byte;
var
  A: RGBArray;
  Faktor: Double;
  Pen_color: TColor;
  Pen_width: Integer;
  Pen_style: TPenStyle;
  B: array of RGBArray;
  x, y, z, mx, pos_nr, size_nr, till_nr,  faColorsh: Integer;
begin
  mx := High(Colors);
  if mx > 0 then
    begin
    if Horizontal then     size_nr := Rect.Right - Rect.Left
    else                            size_nr := Rect.Bottom - Rect.Top;
    SetLength(b, mx + 1);
    for x := 0 to mx do
      begin
      Colors[x] := ColorToRGB(Colors[x]);
      b[x][0]   := GetRValue(Colors[x]);
      b[x][1]   := GetGValue(Colors[x]);
      b[x][2]   := GetBValue(Colors[x]);
    end;
    Pen_width     := ACanvas.Pen.Width;
    Pen_style     := ACanvas.Pen.Style;
    Pen_color     := ACanvas.Pen.Color;
    ACanvas.Pen.Width := 1;
    ACanvas.Pen.Style := psSolid;
    faColorsh := Round(size_nr / mx);
    for y := 0 to mx - 1 do
      begin
      if y = mx - 1 then  till_nr := size_nr - y * faColorsh - 1
      else                        till_nr := faColorsh;
      for x := 0 to till_nr do
        begin
        pos_nr := x + y * faColorsh;
        faktor := x / till_nr;
        for z := 0 to 2 do
            a[z] := Trunc(b[y][z] + ((b[y + 1][z] - b[y][z]) * Faktor));
        ACanvas.Pen.Color := RGB(a[0], a[1], a[2]);
        if Horizontal then
           begin
           ACanvas.MoveTo(Rect.Left + pos_nr, Rect.Top);
           ACanvas.LineTo(Rect.Left + pos_nr, Rect.Bottom);
           end
        else begin
          ACanvas.MoveTo(Rect.Left, Rect.Top + pos_nr);
          ACanvas.LineTo(Rect.Right, Rect.Top + pos_nr);
        end;
      end;
    end;
    b := nil;
    ACanvas.Pen.Width := Pen_width;
    ACanvas.Pen.Style := Pen_style;
    ACanvas.Pen.Color := Pen_color;
  end;
 end;

Open in new window

⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
danival_lucas

ASKER
Thanks for this answer!
I made my continuous progressbar with the code on the page you sent.
I just made an image (printscreen of a progressbar I liked) and used that procedure (UpdateImageProgress) to animate the image.
Very good and simple!
OliwareZ

This code will show you how to solve the problem : (100 = the speed of the animation)
procedure TForm1.Button1Click(Sender: TObject);
 
const
  PBS_MARQUEE = $08;
  PBM_SETMARQUEE = WM_USER + 10;
 
Var
  L : Integer;
 
Begin
  L := GetWindowLong (ProgressBar1.Handle, GWL_STYLE);
  SetWindowLong (ProgressBar1.Handle, GWL_STYLE, L Or PBS_MARQUEE);
 
  SendMessage (ProgressBar1.Handle, PBM_SETMARQUEE, 1, 100);
End;

Open in new window