uworkprogress.pas

DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen

 ShowTime;                                 //show the start time = 0 ms

 BitBtnPause.Caption := PauseCaptions[FPaused]; //set new action of the button
 BitBtnAbort.Enabled := True;              //and reset the buttons
 BitBtnPause.Enabled := True;
 BitBtnClose.Enabled := False;

 ModalResult := mrNone;                    //don't close immediately again
 Show;                                     //show the form

 TForm(Owner).Enabled := False;            //disable the parent window
end;




{Sets the text of the currently executed action.
~param Text the currently executed action }
procedure TFormWorkProgress.SetWorkText(const Text: String);
begin
 LabelWork.Caption := Text;         //show the text
 LabelProgress.Caption := '';       //clear text
 LabelProcessing.Caption := '';     //clear text
 LabelWork.Update;
 LabelProgress.Update;
 LabelProcessing.Update;
end;

{Sets the text showing the progress of the action, like "Item 5 of 10".
~param Text text of progress of the action
~result if the action should be aborted }
function TFormWorkProgress.SetProgressText(const Text: String): Boolean;
begin
 LabelProgress.Caption := Text;     //show the text
 LabelProcessing.Caption := '';     //clear text
 LabelProgress.Update;
 LabelProcessing.Update;
{$IFDEF LINUX}
 LabelProcessing.Update;            //I have no clue why this is needed twice
{$ENDIF}
 Result := FShouldAbort or Application.Terminated;
end;

{Sets the text of the currently processed item.
~param Text the currently processed item
~result if the action should be aborted }
function TFormWorkProgress.SetProcessText(const Text: String): Boolean;
begin
 LabelProcessing.Caption := Text;   //show the text
 LabelProcessing.Update;
 Result := FShouldAbort or Application.Terminated;
end;


{Sets the number of units to process.
~param NewMax the number of units to process }
procedure TFormWorkProgress.SetMaximum(NewMax: Integer);
begin
 ProgressBar.Position := 0;
 ProgressBar.Max := NewMax;         //set maximum position of progress
end;


{Resets the display of progress, so that another action can be started and
 be progressed. }
procedure TFormWorkProgress.Reset;
begin
 FShouldAbort := False;             //reset abort and position
 ProgressBar.Position := 0;

{$IFNDEF LINUX}
 FLastTime := timeGetTime;          //save the current time
{$ELSE}
 FLastTime := GetTime;
{$ENDIF}
end;

{Sets if an exception should be raised when the progress is being stepped
 but the action should be aborted.
~param RaiseOnAbort if an exception should be raised but the action should
                    be aborted }
procedure TFormWorkProgress.SetThrowExceptionOnStepIfAbort(RaiseOnAbort:
                                                                      Boolean);
begin
 FRaiseOnAbort := RaiseOnAbort;
end;

{Steps the progress.
~result if the action should be aborted
~exception EAbortProgress if set with ~[link SetThrowExceptionOnStepIfAbort]
                          and the action should be aborted }
function TFormWorkProgress.StepProgress: Boolean;
var      WasLessAMinute   :Boolean;      //if the time was less than a minute
begin
 ProgressBar.StepIt;                     //step the progress

 WasLessAMinute := FSumTime < 60000;     //last time was less than a minute?

{$IFNDEF LINUX}
 inc(FSumTime, timeGetTime - FLastTime); //add time of this step
{$ELSE}
 inc(FSumTime, Round((GetTime - FLastTime) * 86400000));
{$ENDIF}

 if WasLessAMinute and (FSumtime >= 60000) and  //one minute was crossed?
    not CheckBoxBeepWhenFinished.Checked then
  begin
   CheckBoxBeepWhenFinished.Checked := True;      //enable the beep
   FWasAutoBeep := True;                          //beep automatically enabled
  end;

 ShowTime;                                      //show the new elapsed time

 Application.ProcessMessages;            //handle messages (Abort/Pause/beep)?

 //should be paused?
 while FPaused and not FShouldAbort and not Application.Terminated do
  Application.HandleMessage;               //wait until resume or abort


 Result := FShouldAbort or Application.Terminated;
 if FRaiseOnAbort and Result then
  raise EAbortProgress.Create('Action has been aborted!');

{$IFNDEF LINUX}
 FLastTime := timeGetTime;               //save time before the step
{$ELSE}
 FLastTime := GetTime;
{$ENDIF}
end;

{Returns if the progressing action should be aborted.
~result if the action should be aborted }
function TFormWorkProgress.ShouldAbort: Boolean;
begin
 Result := FShouldAbort or Application.Terminated;
end;

{Called when the action has been finished. May be called more than once. }
procedure TFormWorkProgress.Finished;
begin
 if Visible then                           //not already finished?
  begin
{$IFNDEF LINUX}
   inc(FSumTime, timeGetTime - FLastTime);   //add time of last step
{$ELSE}
   inc(FSumTime, Round((GetTime - FLastTime) * 86400000));
{$ENDIF}

   ShowTime;                                 //show the final time

   BitBtnAbort.Enabled := False;             //only allow closing of the window
   BitBtnPause.Enabled := False;
   BitBtnClose.Enabled := True;
   if not FShouldAbort and CheckBoxBeepWhenFinished.Checked then //should beep?
    Beep;                                      //beep
   if FWasAutoBeep then                      //beep was automatically enabled?
    CheckBoxBeepWhenFinished.Checked := False; //disable it again

   //should not be closed automatically?
   if not CheckBoxCloseWhenFinished.Checked then
    begin
     BitBtnClose.SetFocus;                     //ready for closing and
     ShowModalNow;                             //show the form until closed
    end;

   TForm(Owner).Enabled := True;             //enable parent form (stop modal)
   Hide;                                     //close the window
  end;
end;











{Shows this window as if it would have been shown modal, i.e. returns only when
 the window has been closed. }
procedure TFormWorkProgress.ShowModalNow;
begin
 //while window should not be closed and is visible and program is running
 while (ModalResult = mrNone) and not Application.Terminated and Visible do
  Application.HandleMessage;                //just wait
 TForm(Owner).Enabled := True;            //enable parent form (stop modal)
end;








{Shows the elapsed time. }
procedure TFormWorkProgress.ShowTime;
begin
 LabelTime.Caption := Format('%d:%.2d%s%.3d',
                             [FSumTime div 60000,
                              FSumTime div 1000 mod 60,
                              DecimalSeparator,
                              FSumTime mod 1000]);
end;

























{Called after the window is created.
~param Sender the sender of the event, the window }
procedure TFormWorkProgress.FormCreate(Sender: TObject);
var       Settings         :TProgressFormSettings; //to read ini settings
begin
 //get object to load the settings from
 Settings := TProgressFormSettings(TProgressFormSettings.
                                                       GetSettings(ClassName));
 if not assigned(Settings) then        //no object initialized?
  begin                                  //create a new object
   Settings := TProgressFormSettings.Create(ClassName);
   Settings.ReadValues(Self);            //initialize with the default values
   Settings.Initialize;                  //and read from the ini file
  end;
 Settings.SetValuesToForm(Self);       //initialize form with read values
 CheckBoxCloseWhenFinished.Checked := Settings.CloseOnFinish;
// CheckBoxBeepWhenFinished.Checked := Settings.BeepOnFinish;
end;

{Will be called before a window is closed to check if it can be closed.
~param Sender   the sender of the event, the window
~param CanClose returns, whetet the window can be closed }
procedure TFormWorkProgress.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
 //abort the progress if not already finished or aborted
 FShouldAbort := FShouldAbort or Application.Terminated or
                 not BitBtnClose.Enabled;
 FPaused := False;                    //don't pause, just end
 CanClose := BitBtnClose.Enabled;     //close only, if it can be closed
end;

{Will be called when the button to abort has been clicked.
~param Sender   the sender of the event, ~[link BitBtnAbort] }
procedure TFormWorkProgress.BitBtnAbortClick(Sender: TObject);
begin
 if BitBtnAbort.Enabled then
  begin
   FShouldAbort := True;                //abort the progress
   FPaused := False;                    //and don't pause
  end;
end;

{Will be called when the button to pause has been clicked.
~param Sender the sender of the event, ~[link BitBtnPause] }
procedure TFormWorkProgress.BitBtnPauseClick(Sender: TObject);
begin
 FPaused := BitBtnPause.Enabled and not FPaused; //toggle pause state
 BitBtnPause.Caption := PauseCaptions[FPaused];  //set new action of the button
end;

{Will be called when the check box to beep when finished has been changed.
~param Sender the sender of the event, ~[link CheckBoxBeepWhenFinished] }
procedure TFormWorkProgress.CheckBoxBeepWhenFinishedClick(Sender: TObject);
begin
 FWasAutoBeep := False;
end;

end.