asked on

"Progress Bar" form that can be called often throughout an application

I'd like a 'progress bar' that pops up in my application that offers some visual feedback to the user.
For example if I know a process has 5 steps, I can do something like this:

DoProgressBar(5 steps);

ProgressBarStatusMessage('Initiating connection to server...');

Then after each step:
IncrementProgressBar(1);
ProgressBarStatusMessage('Authenticating user');

...

IncrementProgressBar(1);
ProgressBarStatusMessage('Fetching products...');

...

IncrementProgressBar(1);
ProgressBarStatusMessage('Checking balances...');

etc

Perhaps somebody already has a unit and form that can do this?

Geert G

lol, i have a unit ...
i can display it's own progressbar or the one passed to the procedure.
now where did i put it ?

SOLUTION

Geert G

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

ASKER CERTIFIED SOLUTION

Geert G

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Geert G

you could change the procedure names easily to fit your procedure names

increment and set name is a one step procedure:
SplashIncrement('Authenticating user');

Geert G

found a secondary one for loading data:

it's with devexpress components

unit frmWaitScreen;

interface

uses
  Windows, Forms, Translator, Classes, Controls, ExtCtrls, StdCtrls, Messages,
  cxControls, cxContainer, cxEdit, cxProgressBar, ImgList, Graphics;

type
  TfrmWait = class(TForm)
    pbWait: TcxProgressBar;
    pnl: TPanel;
    lblTop: TLabel;
    lblMessage: TLabel;
    lblMiddle: TLabel;
    lblStepMessage: TLabel;
    procedure FormShow(Sender: TObject);
  private
    fStartTime: TDateTime;
    procedure WMHitCaption(var Msg: TMessage); message WM_NCHITTEST;
  public
    constructor Create(AOwner: TComponent); override;
  end;

var
  frmWait: TfrmWait;

procedure DataWait(Step: Integer = 0; StepType: Integer = 0; StepMessage: string = '');
procedure EndDataWait;

implementation

uses SysUtils;

{$R *.DFM}

constructor TfrmWait.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fStartTime := Now;
end;

procedure TfrmWait.FormShow(Sender: TObject);
begin
  fStartTime := Now;
  pbWait.Visible := False;
end;

// Steptype: 0 = not visible, 1 = step, 2 = max
procedure DataWait(Step: Integer = 0; StepType: Integer = 0; StepMessage: string = '');
begin
  Screen.Cursor := crHourglass;
  if not Assigned(frmWait) then
    frmWait := TfrmWait.Create(Application);
  if Assigned(frmWait) then
    with frmWait do
    begin
      lblStepMessage.Caption := StepMessage;
      if Visible and not pbWait.Visible and (Now - fStartTime > 2 / 24 / 60 / 60) then // 2 sec then
        pbWait.Visible := True;
      case StepType of
        1:
        begin
          if pbWait.Position + Step < pbWait.Properties.Max then
            pbWait.Position := pbWait.Position + Step
          else
            pbWait.Position := pbWait.Properties.Max;
        end;
        2:
        begin
          pbWait.Position := 0;
          pbWait.Properties.Max := Step;
        end;
      end;
      Show;
      Update;
      pbWait.Update;
      Update;
    end;
end;

procedure EndDataWait;
begin
  if Assigned(frmWait) then
    frmWait.Hide;
  Screen.Cursor := crDefault;
end;

procedure TfrmWait.WMHitCaption(var Msg: TMessage);
begin
  Msg.Result := HTCAPTION;
end;

end.

Open in new window

Geert G

dfm

forgive me for not translating the dutch words ... :)

object frmWait: TfrmWait
  Left = 396
  Top = 387
  Cursor = crHourGlass
  BorderStyle = bsNone
  Caption = 'Even geduld ...'
  ClientHeight = 129
  ClientWidth = 337
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -13
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poMainFormCenter
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 16
  object pbWait: TcxProgressBar
    Left = 0
    Top = 105
    Align = alBottom
    Properties.BeginColor = 11522520
    Style.BorderStyle = ebsNone
    Style.TextStyle = [fsBold]
    TabOrder = 0
    Width = 337
  end
  object pnl: TPanel
    Left = 0
    Top = 0
    Width = 337
    Height = 105
    Align = alClient
    BevelInner = bvLowered
    TabOrder = 1
    object lblTop: TLabel
      Left = 2
      Top = 2
      Width = 333
      Height = 16
      Align = alTop
      Alignment = taCenter
      ExplicitWidth = 4
    end
    object lblMessage: TLabel
      Left = 2
      Top = 18
      Width = 333
      Height = 33
      Align = alTop
      Alignment = taCenter
      Caption = 'Even geduld ...'
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -27
      Font.Name = 'Tahoma'
      Font.Style = []
      ParentFont = False
      ExplicitWidth = 177
    end
    object lblMiddle: TLabel
      Left = 2
      Top = 51
      Width = 333
      Height = 16
      Align = alTop
      Alignment = taCenter
      ExplicitWidth = 4
    end
    object lblStepMessage: TLabel
      Left = 2
      Top = 67
      Width = 333
      Height = 25
      Align = alTop
      Alignment = taCenter
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -21
      Font.Name = 'Tahoma'
      Font.Style = []
      ParentFont = False
      ExplicitWidth = 7
    end
  end
end

Open in new window

rfwoolf

ASKER

Geert

Thanks but I'm a bit confused - none of the methods in the splash screen can be called, I why have you overloaded all these methods?

Geert G

overload ?
for backward compatibility for my projects

how do you mean, they can't be called ?

rfwoolf

ASKER

Arrghh I was being an idiot...
I was trying to call a method of the form instead of a method of the unit.
Thanks :)

Geert G

ungh ... your welcome ...
i dunno about the idiot part ... don't know you that well ... but if you insist, ok ... :)

rfwoolf

ASKER

Once I removed the intitialization and finilization section to make it no longer a Splash form, then it's perfect :)

Thank-you!

&quot;Progress Bar&quot; form that can be called often throughout an application

"Progress Bar" form that can be called often throughout an application