Solved

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

Posted on 2010-08-19
11
521 Views
Last Modified: 2012-05-10
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?
0
Comment
Question by:rfwoolf
  • 8
  • 3
11 Comments
 
LVL 36

Expert Comment

by:Geert Gruwez
ID: 33476002
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 ?
0
 
LVL 36

Assisted Solution

by:Geert Gruwez
Geert Gruwez earned 500 total points
ID: 33476109
it's actually a splash form with that functionality


unit SplashScreenForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, ComCtrls, jpeg, StdCtrls;

type
  TFrmSplashScreen = class(TForm)
    Panel1: TPanel;
    ProcessLabel: TLabel;
    Label1: TLabel;
    ProgressBarSplash: TProgressBar;
    pnlDecor: TPanel;
    Image1: TImage;
  private
    procedure MakeVisible;
    procedure Start(const maxVal,stepVal:integer); overload;
    procedure Start(const maxVal,stepVal:integer; const ProcessLabelText:string); overload;
    procedure Increment(n: integer = 1); overload;
    procedure Increment(ProcessLabelText: string; n: integer = 1); overload;
    procedure SetProcessLabel(const ProcessMessage: string);
  public
    constructor Create(AOwner: TComponent); override;
  end;

var
  FrmSplashScreen : TFrmSplashScreen = nil;

procedure SplashStart(const MaxVal, StepVal: integer); overload;
procedure SplashStart(const MaxVal, StepVal: Integer; ProcessLabelText: string); overload;
procedure SplashIncrement(n: integer = 1); overload;
procedure SplashIncrement(ProcessLabelText: string; n: integer = 1); overload;
procedure SplashSetProcessLabel(const ProcessMessage: string);
procedure SplashStop;

implementation

uses Variants;

{$R *.DFM}

procedure TFrmSplashScreen.Increment(n: integer = 1);
begin
  ProgressBarSplash.StepBy(n);
  ProgressBarSplash.Update;
  MakeVisible;
end;

procedure TFrmSplashScreen.Start(const maxVal, stepVal: integer);
begin
  with ProgressBarSplash do
  begin
    Min := 0;
    Max := maxVal;
    Step := stepVal;
  end;
  MakeVisible;
end;

procedure TFrmSplashScreen.SetProcessLabel(const ProcessMessage: string);
begin
  ProcessLabel.Caption := ProcessMessage;
  MakeVisible;
end;

procedure TFrmSplashScreen.Start(const maxVal, stepVal: integer;
  const ProcessLabelText: string);
begin
  Start(MaxVal, StepVal);
  SetProcessLabel(ProcessLabelText);
end;

procedure TFrmSplashScreen.Increment(ProcessLabelText: string; n: integer);
begin
  ProgressBarSplash.StepBy(n);
  SetProcessLabel(ProcessLabelText);
end;

constructor TFrmSplashScreen.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Increment;
end;

function SplashInit(Create: Boolean = True): Boolean;
begin
  if (FrmSplashScreen = nil) and Create then
  begin
    FrmSplashScreen := TFrmSplashScreen.Create(Application);
    FrmSplashScreen.Show;
    FrmSplashScreen.Update;
  end;
  Result := FrmSplashScreen <> nil;
end;

procedure SplashStart(const MaxVal, StepVal: integer);
begin
  if SplashInit then
    FrmSplashScreen.Start(MaxVal, StepVal);
end;

procedure SplashStart(const MaxVal, StepVal: Integer; ProcessLabelText: string);
begin
  if SplashInit then
    FrmSplashScreen.Start(MaxVal, StepVal, ProcessLabelText);
end;

procedure SplashIncrement(n: integer = 1);
begin
  if SplashInit then
    FrmSplashScreen.Increment(n);
end;

procedure SplashIncrement(ProcessLabelText: string; n: integer = 1);
begin
  if SplashInit then
    FrmSplashScreen.Increment(ProcessLabelText, n);
end;

procedure SplashSetProcessLabel(const ProcessMessage: string);
begin
  if SplashInit then
    FrmSplashScreen.SetProcessLabel(ProcessMessage);
end;

procedure SplashKill;
begin
  if SplashInit(False) then
    FreeAndNil(FrmSplashScreen);
end;

procedure SplashStop;
begin
  SplashKill;
end;

procedure TFrmSplashScreen.MakeVisible;
begin
  Invalidate;
  BringToFront;
  Refresh;
  Update;
end;

initialization
  SplashInit;
finalization
  if SplashInit(False) then SplashStop;
end.

Open in new window

0
 
LVL 36

Accepted Solution

by:
Geert Gruwez earned 500 total points
ID: 33476148
and dfm


object FrmSplashScreen: TFrmSplashScreen
  Left = 391
  Top = 366
  BorderIcons = []
  BorderStyle = bsNone
  ClientHeight = 163
  ClientWidth = 406
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 406
    Height = 163
    Align = alClient
    BevelWidth = 2
    BorderWidth = 1
    TabOrder = 0
    object ProcessLabel: TLabel
      Left = 78
      Top = 111
      Width = 85
      Height = 16
      HelpType = htKeyword
      Caption = 'Even geduld ...'
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -13
      Font.Name = 'Tahoma'
      Font.Style = [fsItalic]
      ParentFont = False
    end
    object Label1: TLabel
      Left = 78
      Top = 87
      Width = 249
      Height = 23
      HelpType = htKeyword
      Caption = 'Programma aan het laden, ...'
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -19
      Font.Name = 'Tahoma'
      Font.Style = []
      ParentFont = False
    end
    object ProgressBarSplash: TProgressBar
      Left = 78
      Top = 134
      Width = 241
      Height = 22
      TabOrder = 0
    end
    object pnlDecor: TPanel
      Left = 16
      Top = 12
      Width = 374
      Height = 68
      BevelOuter = bvNone
      Color = clWhite
      TabOrder = 1
      object Image1: TImage
        Left = -1
        Top = -3
        Width = 194
        Height = 67
        Center = True
      end
    end
  end
end

Open in new window

0
 
LVL 36

Expert Comment

by:Geert Gruwez
ID: 33476171
you could change the procedure names easily to fit your procedure names

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

Expert Comment

by:Geert Gruwez
ID: 33476267
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

0
Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

 
LVL 36

Expert Comment

by:Geert Gruwez
ID: 33476275
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

0
 
LVL 13

Author Comment

by:rfwoolf
ID: 33484195
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?
0
 
LVL 36

Expert Comment

by:Geert Gruwez
ID: 33484217
overload ?
for backward compatibility for my projects


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

0
 
LVL 13

Author Comment

by:rfwoolf
ID: 33484234
Arrghh I was being an idiot...
I was trying to call a method of the form instead of a method of the unit.
Thanks :)
0
 
LVL 36

Expert Comment

by:Geert Gruwez
ID: 33484242
ungh ... your welcome ...
i dunno about the idiot part ... don't know you that well ... but if you insist, ok ... :)
0
 
LVL 13

Author Comment

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

Thank-you!
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
Here's a very brief overview of the methods PRTG Network Monitor (https://www.paessler.com/prtg) offers for monitoring bandwidth, to help you decide which methods you´d like to investigate in more detail.  The methods are covered in more detail in o…

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now