Processing Window 1

[tjc240e]

Does anyone have a simple Processing window form procedure they could share?

I would like something that either has a progression bar filling along the screen or maybe even more simply number counting...

TIA

 

[Zathras]

Not exactly "simple" but here is what I use:

unit LongWait;

interface

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

{
  This object may be used by any application that needs to advise
  the user when a long-running phase is in control.

  Minimum requirements for use are:

     begin
       LongWaitBox := TLongWaitBox.Create(' ...(some descriptive text)...');
       while processing do
         begin
           :
           LongWaitBox.Counter := nMyCounter;
           :
         end;
       LongWaitBox.Free;
     end;

  To allow for cancel or stop, use lwMayCancel or lwMayStop as parameter number
      two with the Create method.  Both have the same effect, but the caption
      of the button is different.
  To display a progress bar, enter a value for parameter number three with the
      Create method, or set the CountOf property.
  To change the refresh rate from once a second (1000 milliseconds) to some
      other value, enter a value for parameter number four with the Create
      method of set the TimerInterval property.
  To see whether the user has clicked the button, check the StopRequested or
      CancelRequested property.  Both point to the same value.  Use
      whichever one makes the program code clearer.
  To disable showing of the LongWaitBox, set the LongWaitNeverShow variable to True.
      For example, a unit that uses LongWait may be used in either a batch
      application or an interactive application.  The batch application can
      set LongWaitNeverShow to True to allow it to run faster and without trying
      to show messages on the console.
}

type
  TLongWaitButton = (lwMayCancel,lwMayStop,lwNoButton);

  TLongWaitBox = class(TForm)
    Memo1: TMemo;
    Label1: TLabel;
    pbCancelOrStop: TButton;
    ProgressBar1: TProgressBar;
    Timer1: TTimer;
    procedure pbCancelOrStopClick(Sender: TObject);
    procedure pbCancelOrStopMouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    FCancelOrStopRequestPending:boolean;
    FMayStop:boolean;
    FMayCancel:boolean;
    FTimerInterval:integer;
    FCounter:integer;
    FCountOf:integer;
    FBaseText:string;
    function GetWaitText():string;
    procedure SetWaitText(WaitText:string);
    procedure SetCounter(CounterValue:integer);
    procedure SetCountOf(MaxCount:integer);
    procedure SetMayCancelOrStop(Index:integer;MayCancelOrStop:boolean);
    function GetCancelorStopRequest():Boolean;
  public
    { Public declarations }
    constructor Create( BaseText:string; Button:TLongWaitButton=lwNoButton;
                 TotalCount:integer = 0; Timer:integer = 1000); reintroduce;
    destructor Destroy;  override;
    property MayStop:boolean index 1 read FMayStop write SetMayCancelOrStop;
    property MayCancel:boolean index 2 read FMayCancel write SetMayCancelOrStop;
    property TimerInterval:integer read FTimerInterval write FTimerInterval;
    property Counter:integer read FCounter write SetCounter;
    property CountOf:integer read FCountOf write SetCountOf;
    property CancelRequested:boolean read GetCancelOrStopRequest;
    property StopRequested:boolean read GetCancelOrStopRequest;
    property Text:string read GetWaitText write SetWaitText;
    procedure IncrementCount;
  end;

var
  {Global variable to inhibit long wait box display in batch jobs.  (Set True for batch job.)}
  LongWaitNeverShow:boolean;


implementation

{$R *.DFM}

{ TLongWaitBlox }

{Application calls this method to set up and show the long wait box.}
constructor TLongWaitBox.Create( BaseText:string; Button:TLongWaitButton=lwNoButton;
                 TotalCount:integer = 0; Timer:integer = 1000);
var
  bButtonVisible:boolean;
begin
  inherited Create(nil);
  if LongWaitNeverShow then Exit;
  // Initialize fields...
  Text := BaseText;
  if Button = lwMayCancel then MayCancel := True
  else if Button = lwMayStop then MayStop := True
  else MayCancel := False;
  FCancelOrStopRequestPending := False;
  CountOf := TotalCount;
  Counter := 0;
  TimerInterval := Timer;
  // Set up window...
  Memo1.Text := FBaseText;
  bButtonVisible := pbCancelOrStop.Visible;  // To keep from seeing
  pbCancelOrStop.Visible := False;           // a "hole" in the box
  Show;
  pbCancelOrStop.Visible := bButtonVisible;  // where the button goes.
  Screen.Cursor := crSQLWait;
  // Set up timer
  with Timer1 do begin
    Enabled := False;
    if FTimerInterval < 50 then
      Interval := FTimerInterval * 1000  // user entered seconds...
    else                                 // ...instead of...
      Interval := FTimerInterval;        // ...milliseconds.
    Enabled := True;
  end;
  Memo1.Repaint;
  pbCancelOrStop.Repaint;
  Label1.Repaint;
end;

{Done with long wait box.  Stop timer and free form resources.}
destructor TLongWaitBox.Destroy;
begin
  Hide;
  Timer1.Enabled := False;
  Screen.Cursor := crDefault;
  inherited Destroy;
end;

{Application sets Counter property to show progress.}
procedure TLongWaitBox.SetCounter(CounterValue: integer);
begin
  if LongWaitNeverShow then Exit;
  FCounter := CounterValue;
  if ProgressBar1.Visible then ProgressBar1.Position := FCounter;
  Application.ProcessMessages;
end;

{Build memo text from base text plus Counter and CountOf if available.}
function TLongWaitBox.GetWaitText: string;
begin
  Result := FBaseText;
  if FCounter > 0 then
    begin
      Result := Result + #13 + #10 + #13 + #10 + 'Count: ' + IntToStr(FCounter);
      if FCountOf > 0 then
        Result := Result + ' of ' + IntToStr( FCountOf );
    end;
end;

{If application sets base wait text, refresh memo field.}
procedure TLongWaitBox.SetWaitText(WaitText: string);
begin
  FBaseText := WaitText;
  Memo1.Text := GetWaitText;
  Application.ProcessMessages;
end;

{If application checks cancel/stop request pending, re-set pending flag.}
function TLongWaitBox.GetCancelorStopRequest: Boolean;
begin
  if FCancelOrStopRequestPending then
    begin
      Result := True;
      FCancelOrStopRequestPending := False;
    end
  else
    Result := False;
end;

{If user changes max count, hide or show progress bar.}
procedure TLongWaitBox.SetCountOf(MaxCount: integer);
begin
  FCountOf := MaxCount;
  with ProgressBar1 do
    if FCountOf = 0 then Visible := False
    else begin
      Min := 0;
      Max := FCountOf;
      Position := 0;
      Visible := True;
    end;
  Application.ProcessMessages;
end;

{Set up the push-button for cancel, stop or no-show.}
procedure TLongWaitBox.SetMayCancelOrStop(Index:integer; MayCancelOrStop:boolean);
  {1 - Enable button and set caption to Stop or Cancel.}
  {1} procedure EnableButton( BCaption:string );
  {1} begin
  {1}   with pbCancelOrStop do
  {1}     begin
  {1}       Enabled := True;
  {1}       Visible := True;
  {1}       Caption := BCaption;
  {1}     end;
  {1} end;
  {2 - Disable button and hide it.}
  {2} procedure DisableButton;
  {2} begin
  {2}   with pbCancelOrStop do
  {2}     begin
  {2}       Enabled := False;
  {2}       Visible := False;
  {2}     end;
  {2} end;
begin
  case Index of
    1: begin {Stop}
        FMayStop := MayCancelOrStop;
        if MayCancelOrStop then EnableButton('Stop') else DisableButton;
       end;
    2: begin {Cancel}
         FMayCancel := MayCancelOrStop;
         if MayCancelOrStop then EnableButton('Cancel') else DisableButton;
       end;
  end; {case}
end;

{Add 1 to the count}
procedure TLongWaitBox.IncrementCount;
begin
  Counter := FCounter + 1;
end;

{If user hovers over button, change cursor to default pointer.}
procedure TLongWaitBox.pbCancelOrStopMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  Screen.Cursor := crDefault;
end;

{If user moves away from button, re-establish hour-glass.}
procedure TLongWaitBox.FormMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  Screen.Cursor := crSQLWait;
end;

{If user clicks button, capture event in a field for app to test.}
procedure TLongWaitBox.pbCancelOrStopClick(Sender: TObject);
begin
  FCancelOrStopRequestPending := True;
end;

{On WM_TIMER, update memo text and allow WM_PAINT to process.}
procedure TLongWaitBox.Timer1Timer(Sender: TObject);
begin
  Memo1.Text := GetWaitText;
  Application.ProcessMessages;
end;

end.

And the .dfm

object LongWaitBox: TLongWaitBox
  Left = 94
  Top = 63
  Width = 479
  Height = 222
  BorderIcons = []
  BorderStyle = bsSizeToolWin
  Caption = 'Working'
  Color = clWhite
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnMouseMove = FormMouseMove
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 16
    Top = 160
    Width = 87
    Height = 16
    Caption = 'Please wait...'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = 'System'
    Font.Style = []
    ParentFont = False
  end
  object Memo1: TMemo
    Left = 24
    Top = 16
    Width = 425
    Height = 81
    TabStop = False
    BorderStyle = bsNone
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = 'Arial'
    Font.Style = [fsBold]
    Lines.Strings = (
      'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA'
      'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA'
      'AAAAAAAAAAAAAAA')
    ParentFont = False
    TabOrder = 1
  end
  object pbCancelOrStop: TButton
    Left = 200
    Top = 144
    Width = 75
    Height = 25
    Caption = 'Cancel'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = 'System'
    Font.Style = []
    ParentFont = False
    TabOrder = 0
    OnClick = pbCancelOrStopClick
    OnMouseMove = pbCancelOrStopMouseMove
  end
  object ProgressBar1: TProgressBar
    Left = 32
    Top = 104
    Width = 409
    Height = 20
    Min = 0
    Max = 100
    TabOrder = 2
  end
  object Timer1: TTimer
    OnTimer = Timer1Timer
    Left = 408
    Top = 160
  end
end

 

[tjc240e]

I'm really sorry about this next question... please for give me....

DOes the first part of the code go into a unit with a form?
What do i have to put on the form?
you said add the .dfm, could you explain what the .dfm is?

TIA

 

[Zathras]

The following assumes you have Delphi 7. If you have another version, you may need to make some adjustments.

1. Add a form to your appliation.
2. Remove the form from the Auto-Create list.
3. Drop these five components on it:
TMemo
TLabel
TButton
TProgressBar
TTimer
4. Rename Button1 as pbCancelOrStop.
5. Double-click the Click and MouseMove events for the TButton to cause Delphi to create the handlers and the links to the handlers.
6. Save the unit as LongWait.pas
7. Exit Delphi.
8. Open the LongWait.pas in notepad.
9. Replace everything with the code from the first box above and save the file.
10. Open the LongWait.dfm in notepad. (was created automatically by Delphi)
11. Replace everything with the code from the second box above and save the file.
12. Delete the LongWait.dcu file if it exists. (It won't be there unless you tried to compile before step 7 above.)
13. Restart Delphi.
14. Open your project and see if everything works ok. (Follow the instructions in the LongWait.pas file for how to use it.)

 

[tjc240e]

Yes i am using delphi 7.

Everything worked as far as getting it into the program and i setup the three min lines of code you stated above. But the program is no telling me that LongWaitBox is undeclared identifier.

Where do i have to declare the LongWaitBox?

I'm guessing i have to put LongWait under the uses section as well?

Also is nMyCounter just a integer? Is it to tell the computer how many times i've gone through the loop or is that the one for if i'm letting them use the cancel/stop button?

TIA

 

[Zathras]

Yes, add LongWait to the "uses" clause.

nMyCounter is the position in the progress bar that you want to indicate. It's value should vary from zero to tne value used in the "TotalCount" parameter when Creating the TLongWaitBox. There is also an IncrementCounter method that you could use instead of needing to keep track with your own variable.

So, for example something like this:
[tt]
procedure SomeLongRunningThing;
var
oLongWaitBox:TLongWaitBox;
i:integer;
begin
Screen.Cursor := crHourGlass;
oLongWaitBox := TLongWaitBox.Create('Performing update of widgets.', lwNoButton, MyList.Count);
try
for i := 0 to MyList.Count - 1 do
begin
// Do something with each item of MyList....
:
:
oLongWaitBox.IncrementCounter;
end;
finally
Screen.Cursor := crDefault;
oLongWaitBox.Free;
end;
end;
[/tt]

 

[tjc240e]

Zathras you are a GENIUS!!!!!

THANK YOU THANK YOU THANK YOU....

It works awesomely!!!

KUDOS KUDOS KUDOS!!!!