uworkprogress.pas

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

{  JADD - Just Another DelphiDoc: Documentation from Delphi Source Code

Copyright (C) 2003-2008   Gerold Veith

This file is part of JADD - Just Another DelphiDoc.

DelphiDoc is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License version 3 as
published by the Free Software Foundation.

DelphiDoc is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.
}


unit UWorkProgress;

{Contains a small window (mostly not a dialog, but a monolog) showing the
 progress of a work. The interface ~[link IProgressInterface] is implemented to
 let this dialog be used in a variety of ways and as a substitute for other
 classes implementing the interface. }

interface

uses
  Windows, SysUtils, Classes,
{$IFNDEF LINUX}
  Graphics, Controls, Forms, Dialogs, ComCtrls, StdCtrls, Buttons,
{$ELSE}
  QForms,
  QMenus, QTypes, QStdCtrls, QCheckLst, QControls, QExtCtrls, QComCtrls,
  QButtons,
{$ENDIF}
  UProgress;


type
  {A small window (mostly not a dialog, but a monolog) showing the progress of
   a work. The interface ~[link IProgressInterface] is implemented to
   let this dialog be used in a variety of ways and as a substitute for other
   classes implementing the interface.~[br]
   Besindes the showing of a progress bar and three customizable texts, the
   work can be aborted and also paused. The dialog can be automatically closed,
   when the work is finished. Also the elapsed time whole processing is showed.
   A beep can be triggered, when the work is finished, this option is
   automatically enabled, if the time exceeds one minute. }
  TFormWorkProgress = class(TForm, {IUnknown, }IProgressInterface)
    LabelWork: TLabel;
    LabelProgress: TLabel;
    LabelProcessing: TLabel;
    ProgressBar: TProgressBar;
    LabelTimeCaption: TLabel;
    LabelTime: TLabel;
    BitBtnAbort: TBitBtn;
    BitBtnPause: TBitBtn;
    BitBtnClose: TBitBtn;
    CheckBoxCloseWhenFinished: TCheckBox;
    CheckBoxBeepWhenFinished: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure BitBtnAbortClick(Sender: TObject);
    procedure BitBtnPauseClick(Sender: TObject);
    procedure CheckBoxBeepWhenFinishedClick(Sender: TObject);
  private
    //number of references on the interface
    FRefCount: Integer;

    //if an exception should be risen, if progress should be aborted
    //~see SetThrowExceptionOnStepIfAbort
    FRaiseOnAbort: Boolean;
    FShouldAbort: Boolean;          //if progress should be aborted
    FPaused: Boolean;               //if progress should be paused
    FWasAutoBeep: Boolean;          //if beeping was enabled automatically

{$IFNDEF LINUX}
    FLastTime: DWORD;               //last time of a step (ms)
{$ELSE}
    FLastTime: TDateTime;           //last time of a step
{$ENDIF}
    FSumTime: DWORD;                //elapsed time so far (ms)

    //Shows the elapsed time.
    procedure ShowTime;

    { private declarations }
  public
    //Frees the window.
    destructor Destroy; override;

    //Increments the reference count of the interface.
    function DoAddRef: Integer; stdcall;
    //Decrements the reference count of the interface.
    function DoRelease: Integer; stdcall;

    function IProgressInterface._AddRef = DoAddRef;
    function {UProgress.}IProgressInterface._Release = DoRelease;




    //Prepares the object for a completely new action to show the progress of.
    procedure Prepare; virtual;


    //Sets the text of the currently executed action.
    procedure SetWorkText(const Text: String);
    //Sets the text showing the progress of the action, like "Item 5 of 10".
    function SetProgressText(const Text: String): Boolean;
    //Sets the text of the currently processed item.
    function SetProcessText(const Text: String): Boolean;

    //Sets the number of units to process.
    procedure SetMaximum(NewMax: Integer);

    //Resets the display of progress, so that another action can be started and
    //be progressed.
    procedure Reset;

    //Sets if an exception should be raised when the progress is being stepped
    //but the action should be aborted.
    procedure SetThrowExceptionOnStepIfAbort(RaiseOnAbort: Boolean);

    //Steps the progress.
    function StepProgress: Boolean;

    //Returns if the progressing action should be aborted.
    function ShouldAbort: Boolean;

    //Called when the action has been finished. May be called more than once.
    procedure Finished;




    //Shows this window as if it would have been shown modal.
    procedure ShowModalNow;

    { public declarations }
  end;


implementation

{$R *.dfm}

uses IniFiles,
{$IFNDEF LINUX}
     MMSystem,    //beep
{$ENDIF}
     USettingsKeeper;



type

  {Loads and saves the settings of the form to show the progress while parsing
   Delphi projects or generating documentation about them. }
  TProgressFormSettings = class(TFormSettings)
  private
    //whether the progress window should automatically be closed when the
    //action has been finished
    FCloseOnFinish: Boolean;
    //whether an acoustic signal should be sounded when the action is finished
//    FBeepOnFinish: Boolean;
  protected
  public
    //Loads the settings from the ini file.
    procedure LoadFromIni(Ini: TCustomIniFile); override;
    //Saves the settings to the ini file.
    procedure SaveToIni(Ini: TCustomIniFile); override;

    //Gets the settings from the form.
    procedure ReadValues(Form: TFormWorkProgress);

    property CloseOnFinish: Boolean read FCloseOnFinish;
//    property BeepOnFinish: Boolean read FBeepOnFinish;
  end;






{Loads the settings from the ini file.
~param Ini the ini file to load the settings from }
procedure TProgressFormSettings.LoadFromIni(Ini: TCustomIniFile);
begin
 inherited LoadFromIni(Ini);             //read general form settings

 //read state of the check boxes
 FCloseOnFinish := Ini.ReadBool(Name, 'CloseOnFinish', FCloseOnFinish);
// FBeepOnFinish := Ini.ReadBool(Name, 'BeepOnFinish', FBeepOnFinish);
end;

{Saves the settings to the ini file.
~param Ini the ini file to save the settings to }
procedure TProgressFormSettings.SaveToIni(Ini: TCustomIniFile);
begin
 inherited SaveToIni(Ini);           //write general form settings

 //write state of the check boxes
 Ini.WriteBool(Name, 'CloseOnFinish', FCloseOnFinish);
// Ini.WriteBool(Name, 'BeepOnFinish', FBeepOnFinish);
end;


{Gets the settings from the form.
~param Form the form to read the values from }
procedure TProgressFormSettings.ReadValues(Form: TFormWorkProgress);
begin
 GetValuesFromForm(Form);               //get general values of the form

 //get state of the check boxes
 FCloseOnFinish := Form.CheckBoxCloseWhenFinished.Checked;
// FBeepOnFinish := Form.CheckBoxBeepWhenFinished.Checked;
end;











          //captions of the button ~[link TFormWorkProgress.BitBtnPause]
const     PauseCaptions: array[Boolean] of String = ('&Pause', '&Resume');




{Frees the window. }
destructor TFormWorkProgress.Destroy;
var        Settings         :TProgressFormSettings; //to save settings of form
begin
 if assigned(Owner) then
  TForm(Owner).Enabled := True;     //enable parent window (stop modal)

 //get object to save the settings in
 Settings := TProgressFormSettings(TProgressFormSettings.
                                                       GetSettings(ClassName));
 if assigned(Settings) then
  Settings.ReadValues(Self);                      //save current settings

 inherited Destroy;                 //free the window
end;



{Increments the reference count of the interface.
~result the new number of reference on the interface }
function TFormWorkProgress.DoAddRef: Integer;
begin
 Result := InterlockedIncrement(FRefCount);  //increment the counter
end;

{Decrements the reference count of the interface.
~result the new number of reference on the interface }
function TFormWorkProgress.DoRelease: Integer;
begin
 Result := InterlockedDecrement(FRefCount);  //decrement the counter
 if Result = 0 then                          //reached 0?
  Destroy;                                     //free the not-referenced object
end;







{Prepares the window for a completely new action to show the progress of. }
procedure TFormWorkProgress.Prepare;
begin
 assert(assigned(Owner));

 FRaiseOnAbort := False;                   //reset the state
 FShouldAbort := False;
 FPaused := False;

{$IFNDEF LINUX}                            //reset times
 FLastTime := timeGetTime;
{$ELSE}
 FLastTime := GetTime;
{$ENDIF}
 FSumTime := 0;