?
Solved

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

Posted on 2010-08-19
11
Medium Priority
?
558 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 8
  • 3
11 Comments
 
LVL 38

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 38

Assisted Solution

by:Geert Gruwez
Geert Gruwez earned 2000 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 38

Accepted Solution

by:
Geert Gruwez earned 2000 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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 38

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 38

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
 
LVL 38

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 38

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 38

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

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

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…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
In this brief tutorial Pawel from AdRem Software explains how you can quickly find out which services are running on your network, or what are the IP addresses of servers responsible for each service. Software used is freeware NetCrunch Tools (https…
In this video, Percona Director of Solution Engineering Jon Tobin discusses the function and features of Percona Server for MongoDB. How Percona can help Percona can help you determine if Percona Server for MongoDB is the right solution for …
Suggested Courses
Course of the Month13 days, 8 hours left to enroll

801 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