Progress dialog

Edited text of question

I also did something like you want to do. I think your 'main' proces is eating to much processor time.
Maybe you can try to insert at a few places in the 'eating' routine the following (e.g.) :




// be sure that the progesswindow is visible

repeat
  // do something
  Application.ProcessMessages;
  // do something else
  // update your progress bar
  Application.ProcessMessages;
  // again do something;
until ...




It's probably not the best solution, but it worked in my case.
Another thing you can try, is to use a thread.

Hope this helps...

What you're asking for is impossible by definition and by logic!

quoted from Delphi help: "Use ShowModal to show a form as a modal form, which means the user must put the form away before the application can continue to run."

How would that be supposed to work? You want to call Formx.ShowModal and then do your calculations? How and where would you get the ModalResult?? ShowModal is a FUNCTION! How can you continue processing the next line before its return value is determined? Imagine the following:
res:=Formx.ShowModal;
IF (res<>mrAbort) THEN DoCalculations;
..

Enough about the porblems, I have a workaround to suggest:

You can "fake" a modal window by keeping the user from closing it - it's not quite as effective as a "real" modal window, but it'll do the trick.
Unfortunately, i cannot post the forms for you, so you'll have to create 2 simple forms for testing... I purposely didn't rename any components.

FORM1: Button1, Button2 -> just used to call your "calculations" and to check if a button can be clicked...

procedure TForm1.Button1Click(Sender: TObject);
  VAR i,j,k,p:integer;
begin
  p:=0;
  Form2.Show;
  WHILE (p<100) AND (NOT Form2.AbortClicked) DO BEGIN
    INC(p,5);
    Form2.ProgressBar1.Position:=p;
    k:=0;
    FOR i:=1 TO 100 DO BEGIN
      FOR j:=1 TO 100000 DO INC(k,1);     // very bad style, but in this case: simulate complex calculations...
      Application.ProcessMessages;        // avoid blocking the application
    END;
  END;
  IF Form2.AbortClicked THEN ShowMessage('Aborted') ELSE ShowMessage('Done');
  Form2.Hide;
end;

procedure TForm1.Button2Click(Sender: TObject); //just to test if it can be clicked
begin
  ShowMessage('Hi');
end;



FORM2:
  public
    AbortClicked:boolean;


procedure TForm2.FormDeactivate(Sender: TObject);
begin
  IF (ProgressBar1.Position<ProgressBar1.Max) AND (NOT AbortClicked) THEN self.Show;
end;

procedure TForm2.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose:=(ProgressBar1.Position=ProgressBar1.Max) OR (AbortClicked);
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
  AbortClicked:=true;
  Self.Close;
end;

procedure TForm2.FormShow(Sender: TObject);
begin
  AbortClicked:=false;
end;

The first two handlers won't allow the form to close unless
a) "Abort" was clicked
b) calculation is done

the next handler sets the flag for "AbortClicked", FormShow initializes the flag to false

That's the "easiest" and - imho - most effective way of doing this.

If you need a "really modal" window (blocking all actions on other windows (incl. a "ping")), that can be done as well, but at a higher work 6 performance cost.
1) You'd have to split your calculations into steps that can be executed one by one
2) Your modal window needs a timer to call each one of the steps and update its status
3) in order to do so, your modal window needs to take a pointer to a function that executes some portion of your calculation and then returns the percentage that is complete

Point 1) is the hardest and since I don't know if that can even be easily done, I won't elaborate on this solution...

Let me know if you get my code to work (of course I tested it) and if that helps...

2Holger: Are you know about threads?
First thread can show window as modal,
and second thread can make calculation and
update progress bar.
>> You want to call Formx.ShowModal and then do your calculations.
You can start background thread first and then call
ShowModal.

>>What you're asking for is impossible by definition and by logic!
What about Windows Explorer?
When you copy files   progress window is modal, isn't it?

ok, ok, I "change" my answer:
It IS possible, but of course a lot more complicated: you'd need to create a new class for performing your calculations (or at least for calling functions that do your calculations) that can be instantiated to do your calculations while "the rest of the proram" continues "business as usual" (or vice versa)

Will this program "ship" professionally?

Let me know what you want - if you want a sample using threads, it would be helpful if you could let me know a little bit about the type of "background process" you want to occur so I won't post a sample that you can't use....

ok, I guess I've done wayyy to much web development lately... that's where you use "workarounds" all the time. I still say that the above probably is the simplest solution if you write a program for yourself or just for fun...

The "cleaner" (and wayyyy more professional) solution would look like this:
* Of course you still need a form that displays your progress.... do it any way you want, the components shouldn't be accessed from anybody else anyway...
then you add:
  private
    { Private declarations }
    FProgress:integer;
    procedure SetProgress(p:integer);
  public
    property Progress:integer read FProgress write SetProgress;

procedure TForm2.SetProgress;
begin
  FProgress:=P;
  ProgressBar1.Position:=P;  //display progress
  IF P=ProgressBar1.Max THEN ModalResult:=mrOK; //close form when done
end;


then, as I said above, you need to create a thread class that does your calculations.
For your own project, you do it by choosing File | New and then Choose "ThreadObject"
Then add your code that does calculations.... I post a unit that you can just Cut&Copy:
unit Unit3;

interface

uses
  Classes, Unit2; //unit2 is the one containing your ProgressForm...

type
  TProgressThread = class(TThread)
  private
    { Private declarations }
    ProgressForm:TForm2;
    Progress:integer;
  protected
    procedure Execute; override;
    procedure UpdateProgress;
  public
    constructor Create(P:TForm2);  //pass it the form to use for progress-display
  end;

implementation

{ Important: Methods and properties of objects in VCL can only be used in a
  method called using Synchronize, for example,

      Synchronize(UpdateCaption);

  and UpdateCaption could look like,

    procedure TProgressThread.UpdateCaption;
    begin
      Form1.Caption := 'Updated in a thread';
    end; }

{ TProgressThread }

constructor TProgressThread.Create;
BEGIN
  ProgressForm:=P;
  FreeOnTerminate:=true; //change this for your calculations to first retrieve results before calling Destroy
  inherited Create(false);  //false meaning to start the thread right away rather than creating it in "suspended" mode
END;

procedure TProgressThread.Execute;
VAR i,j,k:integer;
begin
  { Place thread code here }
  FOR i:=1 TO 100 DO BEGIN
    Progress:=i;
    Synchronize(UpdateProgress);   // tell everybody we're working
    k:=0;
    FOR j:=1 TO 2000000 DO INC(k); //pretend we're working... (a little bit)
    IF Terminated THEN Exit;       //but stop if asked nicely
  END;
end;

procedure TProgressThread.UpdateProgress;
begin
  ProgressForm.Progress:=Progress;
end;

end.
Of course you would need to adjust this Class to take any parameters it needs to perform its task and return any results you want it to return.


In your "main unit" (whichever calls the so-called "background-process" (it's not really in the background if a modal progress box blocks the application in the mean time, is it?)), the call would look like this:

procedure TForm1.Button1Click(Sender: TObject);
  VAR res:integer;
      Pr:TProgressThread;
begin
  pr:=TProgressThread.Create(Form2);
  res:=Form2.ShowModal;
  IF res<>mrOK THEN pr.Terminate;
  IF res<>mrOK THEN ShowMessage('Aborted') ELSE ShowMessage('Done');
  //destroy thread now IF you set FreeonTerminate to false in the Thread's constructor (e.g. to retrieve results) - the thread is either done or was aborted and is no longer needed
end;


Let me know if you like that solution better and if you have any problems/questions...

Good luck!

Quick sample:

unit TheProgressForm;

interface

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

type

  TProgressThread = class(TThread)
  private
    FCount,
    FPos           : LongInt;
    FOnFeedback,
    FOnComplete    : TNotifyEvent;
    procedure GiveFeedback;
  public
    procedure Execute; override;
    constructor Create(Count : LongInt);
    property TotalCount: LongInt read FCount;
    property Position: LongInt read FPos;
    property OnFeedback: TNotifyEvent read FOnFeedback write FOnFeedback;
    property OnComplete: TNotifyEvent read FOnComplete write FOnComplete;
  end;

  TForm_Progress = class(TForm)
    Progress_Panel: TPanel;
    ProgressBar1: TProgressBar;
    Bottom_Panel: TPanel;
    Button_Panel: TPanel;
    Button_Cancel: TButton;
    Main_Panel: TPanel;
    Label_Wait: TLabel;
    Label_Progress: TLabel;
    procedure Button_CancelClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    ProgressThread : TProgressThread;
    FCount         : LongInt;
    procedure StartThread;
    procedure VisualFeedback(Sender: TObject);
    procedure ThreadCompleted(Sender: TObject);
  public
    { Public declarations }
    function ShowProgressModal(Count : LongInt): Integer;
  end;

var
  Form_Progress: TForm_Progress;

implementation

{$R *.DFM}

constructor TProgressThread.Create(Count : LongInt);
begin
  inherited Create(false);
  FOnFeedback := nil;
  FOnComplete := nil;
  FCount := Count;
  FPos := 0;
end;

procedure TProgressThread.GiveFeedback;
begin
  if Assigned(FOnFeedback)
   then FOnFeedback(Self);
end;

procedure TProgressThread.Execute;
var Index : Integer;
begin
  for Index := 0 to FCount do
   begin
     FPos := Index;
     Synchronize(GiveFeedback);
     if Terminated
      then Exit;
   end;
  if Assigned(FOnComplete)
   then FOnComplete(Self);
end;

procedure TForm_Progress.VisualFeedback(Sender: TObject);
begin
  with Sender as TProgressThread do
   begin
     ProgressBar1.Position := Trunc(100 / FCount * FPos);
     Label_Progress.Caption := Format('%d  of %d processed', [TotalCount, Position]);
   end;
end;

procedure TForm_Progress.ThreadCompleted(Sender: TObject);
begin
  ModalResult := mrOK;
end;

procedure TForm_Progress.StartThread;
begin
  ProgressThread := TProgressThread.Create(FCount);
  ProgressThread.FreeOnTerminate := true;
  ProgressThread.OnFeedback := VisualFeedback;
  ProgressThread.OnComplete := ThreadCompleted;
  ProgressThread.Execute;
end;

function TForm_Progress.ShowProgressModal(Count: LongInt): Integer;
begin
  FCount := Count;
  Result := Self.ShowModal;
end;

procedure TForm_Progress.Button_CancelClick(Sender: TObject);
begin
  ProgressThread.Terminate;
end;

procedure TForm_Progress.FormShow(Sender: TObject);
begin
  StartThread;
end;

end.

// create a blank form with a button.
// include TheProgressForm in your uses clause
// add this code to the ObClick handler of the button

procedure TForm1.Button1Click(Sender: TObject);
var MyForm_Progress : TForm_Progress;
begin
  MyForm_Progress := TForm_Progress.Create(Self);
  if MyForm_Progress.ShowProgressModal(2000) = mrOK
   then MessageBox(Self.Handle, 'Operation completed', 'Note', mb_ok)
   else MessageBox(Self.Handle, 'Operation aborted', 'Note', mb_ok);
  MyForm_Progress.Free;
end;

Slash/d003303

and here's the form's code:

object Form_Progress: TForm_Progress
  Left = 195
  Top = 109
  Width = 369
  Height = 164
  Caption = 'Progress'
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object Progress_Panel: TPanel
    Left = 0
    Top = 43
    Width = 361
    Height = 42
    Align = alBottom
    BevelOuter = bvNone
    BorderWidth = 14
    TabOrder = 0
    object ProgressBar1: TProgressBar
      Left = 14
      Top = 14
      Width = 333
      Height = 14
      Align = alClient
      Min = 0
      Max = 100
      TabOrder = 0
    end
  end
  object Bottom_Panel: TPanel
    Left = 0
    Top = 85
    Width = 361
    Height = 52
    Align = alBottom
    BevelOuter = bvNone
    BorderWidth = 12
    TabOrder = 1
    object Button_Panel: TPanel
      Left = 272
      Top = 12
      Width = 77
      Height = 28
      Align = alRight
      BevelOuter = bvNone
      TabOrder = 0
      object Button_Cancel: TButton
        Left = 1
        Top = 1
        Width = 75
        Height = 25
        Caption = 'Cancel'
        Default = True
        ModalResult = 2
        TabOrder = 0
        OnClick = Button_CancelClick
      end
    end
  end
  object Main_Panel: TPanel
    Left = 0
    Top = 0
    Width = 361
    Height = 43
    Align = alClient
    BevelOuter = bvNone
    TabOrder = 2
    object Label_Wait: TLabel
      Left = 15
      Top = 12
      Width = 228
      Height = 13
      Caption = 'Processing, please wait or press cancel to abort.'
    end
    object Label_Progress: TLabel
      Left = 15
      Top = 32
      Width = 3
      Height = 13
    end
  end
end

...some cosmetics:

procedure TForm_Progress.VisualFeedback(Sender: TObject);
begin
  with ProgressThread do
   begin
     ProgressBar1.Position := Trunc(100 / TotalCount * Position);
     Label_Progress.Caption := Format('%d  of %d processed', [TotalCount, Position]);
   end;
end;

procedure TForm_Progress.FormShow(Sender: TObject);
var SaveCursor : TCursor;
begin
  SaveCursor := Screen.Cursor;
  Screen.Cursor := crHourGlass;
  StartThread;
  Screen.Cursor := SaveCursor;
end;

Slash/d003303

Thanks for the code... but I am getting and EDivideZero excpetion when I attempt to compile the sample. The line that vomits is:

ProgressBar1.Position := Trunc(100 / TotalCount * Position);

Adjusted points to 1000

Is this one for d003303 exclusively now?

Would you like me to improve my suggestion? It was a working solution so I'm guessing you like the other answer better...
The "bug" in d003303's suggestion should be fairly easy to fix... but I think there's something else that might cause problems.

What are the "new" conditions to getting the points now?
Just wondering before betting on a dead horse... (i.e. spending time on a solution you don't like...)

I have not been able to test you solution. If it fits my criteria then I will release the points. I have done my best to specify my needs and am desperate for a result.

Of course I did write and test the project... it worked (otherwise, I wouldn't have posted it)

Unless there are specific reasons against it, it will be a lot easier if you post your e-mail address and I'll zip and mail my project...
Posting projects is rather difficult because of the forms "and stuff"...
If you don't want to post your e-mail, you can mail it to me at HolgerStr@hotmail.com - let me know if you did because I hardly ever check that Hotmail-account...

Hope to hear from you soon...

mlittle@netcom.com

Yo,
get rid of the bug with

procedure TForm_Progress.VisualFeedback(Sender: TObject);
begin
  with ProgressThread do
   begin
     try
       ProgressBar1.Position := Trunc(100 / TotalCount * Position);
     except
       ProgressBar1.Position := 0;
     end;
     Label_Progress.Caption := Format('%d  of %d processed', [TotalCount, Position]);
   end;
end;

Slash/d003303

Slash/d003303, Your suggestion works great. Please resubmit the suggestion so that I can award you the points.