REM ======================================================================================================================= REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === REM === Full documentation is available on https://help.libreoffice.org/ === REM ======================================================================================================================= Option Compatible Option ClassModule Option Explicit ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''' SF_Timer ''' ======== ''' Class for management of scripts execution performance ''' A Timer measures durations. It can be suspended, resumed, restarted ''' Duration properties are expressed in seconds with a precision of 3 decimal digits ''' ''' Service invocation example: ''' Dim myTimer As Variant ''' myTimer = CreateScriptService("Timer") ''' myTimer = CreateScriptService("Timer", True) ' => To start timer immediately ''' ''' Detailed user documentation: ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_timer.html?DbPAR=BASIC ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' REM ================================================================== EXCEPTIONS REM ============================================================= PRIVATE MEMBERS Private [Me] As Object Private [_Parent] As Object Private ObjectType As String ' Must be "TIMER" Private ServiceName As String Private _TimerStatus As Integer ' inactive, started, suspended or stopped Private _StartTime As Double ' Moment when timer started, restarted Private _EndTime As Double ' Moment when timer stopped Private _SuspendTime As Double ' Moment when timer suspended Private _SuspendDuration As Double ' Duration of suspended status as a difference of times REM ============================================================ MODULE CONSTANTS Private Const STATUSINACTIVE = 0 Private Const STATUSSTARTED = 1 Private Const STATUSSUSPENDED = 2 Private Const STATUSSTOPPED = 3 Private Const DSECOND As Double = 1 / (24 * 60 * 60) ' Duration of 1 second as compared to 1.0 = 1 day REM ===================================================== CONSTRUCTOR/DESTRUCTOR REM ----------------------------------------------------------------------------- Private Sub Class_Initialize() Set [Me] = Nothing Set [_Parent] = Nothing ObjectType = "TIMER" ServiceName = "ScriptForge.Timer" _TimerStatus = STATUSINACTIVE _StartTime = 0 _EndTime = 0 _SuspendTime = 0 _SuspendDuration = 0 End Sub ' ScriptForge.SF_Timer Constructor REM ----------------------------------------------------------------------------- Private Sub Class_Terminate() Call Class_Initialize() End Sub ' ScriptForge.SF_Timer Destructor REM ----------------------------------------------------------------------------- Public Function Dispose() As Variant Call Class_Terminate() Set Dispose = Nothing End Function ' ScriptForge.SF_Timer Explicit destructor REM ================================================================== PROPERTIES REM ----------------------------------------------------------------------------- Public Function Duration() As Double ''' Returns the actual (out of suspensions) time elapsed since start or between start and stop ''' Args: ''' Returns: ''' A Double expressing the duration in seconds ''' Example: ''' myTimer.Duration returns 1.234 (1 sec, 234 ms) Duration = _PropertyGet("Duration") End Function ' ScriptForge.SF_Timer.Duration REM ----------------------------------------------------------------------------- Property Get IsStarted() As Boolean ''' Returns True if timer is started or suspended ''' Example: ''' myTimer.IsStarted IsStarted = _PropertyGet("IsStarted") End Property ' ScriptForge.SF_Timer.IsStarted REM ----------------------------------------------------------------------------- Property Get IsSuspended() As Boolean ''' Returns True if timer is started and suspended ''' Example: ''' myTimer.IsSuspended IsSuspended = _PropertyGet("IsSuspended") End Property ' ScriptForge.SF_Timer.IsSuspended REM ----------------------------------------------------------------------------- Public Function SuspendDuration() As Double ''' Returns the actual time elapsed while suspended since start or between start and stop ''' Args: ''' Returns: ''' A Double expressing the duration in seconds ''' Example: ''' myTimer.SuspendDuration returns 1.234 (1 sec, 234 ms) SuspendDuration = _PropertyGet("SuspendDuration") End Function ' ScriptForge.SF_Timer.SuspendDuration REM ----------------------------------------------------------------------------- Public Function TotalDuration() As Double ''' Returns the actual time elapsed (including suspensions) since start or between start and stop ''' Args: ''' Returns: ''' A Double expressing the duration in seconds ''' Example: ''' myTimer.TotalDuration returns 1.234 (1 sec, 234 ms) TotalDuration = _PropertyGet("TotalDuration") End Function ' ScriptForge.SF_Timer.TotalDuration REM ===================================================================== METHODS REM ----------------------------------------------------------------------------- Public Function Continue() As Boolean ''' Halt suspension of a running timer ''' Args: ''' Returns: ''' True if successful, False if the timer is not suspended ''' Examples: ''' myTimer.Continue() Const cstThisSub = "Timer.Continue" Const cstSubArgs = "" Check: Continue = False SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Try: If _TimerStatus = STATUSSUSPENDED Then _TimerStatus = STATUSSTARTED _SuspendDuration = _SuspendDuration + _Now() - _SuspendTime _SuspendTime = 0 Continue = True End If Finally: SF_Utils._ExitFunction(cstThisSub) Exit Function End Function ' ScriptForge.SF_Timer.Continue REM ----------------------------------------------------------------------------- Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant ''' Return the actual value of the given property ''' Args: ''' PropertyName: the name of the property as a string ''' Returns: ''' The actual value of the property ''' Exceptions ''' ARGUMENTERROR The property does not exist ''' Examples: ''' myTimer.GetProperty("Duration") Const cstThisSub = "Timer.GetProperty" Const cstSubArgs = "PropertyName" If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch GetProperty = Null Check: If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch End If Try: GetProperty = _PropertyGet(PropertyName) Finally: SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' ScriptForge.SF_Timer.Properties REM ----------------------------------------------------------------------------- Public Function Methods() As Variant ''' Return the list or methods of the Timer class as an array Methods = Array( _ "Continue" _ , "Restart" _ , "Start" _ , "Suspend" _ , "Terminate" _ ) End Function ' ScriptForge.SF_Timer.Methods REM ----------------------------------------------------------------------------- Public Function Properties() As Variant ''' Return the list or properties of the Timer class as an array Properties = Array( _ "Duration" _ , "IsStarted" _ , "IsSuspended" _ , "SuspendDuration" _ , "TotalDuration" _ ) End Function ' ScriptForge.SF_Timer.Properties REM ----------------------------------------------------------------------------- Public Function Restart() As Boolean ''' Terminate the timer and restart a new clean timer ''' Args: ''' Returns: ''' True if successful, False if the timer is inactive ''' Examples: ''' myTimer.Restart() Const cstThisSub = "Timer.Restart" Const cstSubArgs = "" Check: Restart = False SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Try: If _TimerStatus <> STATUSINACTIVE Then If _TimerStatus <> STATUSSTOPPED Then Terminate() Start() Restart = True End If Finally: SF_Utils._ExitFunction(cstThisSub) Exit Function End Function ' ScriptForge.SF_Timer.Restart REM ----------------------------------------------------------------------------- Public Function SetProperty(Optional ByVal PropertyName As Variant _ , Optional ByRef Value As Variant _ ) As Boolean ''' Set a new value to the given property ''' Args: ''' PropertyName: the name of the property as a string ''' Value: its new value ''' Exceptions ''' ARGUMENTERROR The property does not exist Const cstThisSub = "Timer.SetProperty" Const cstSubArgs = "PropertyName, Value" If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch SetProperty = False Check: If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch End If Try: Select Case UCase(PropertyName) Case Else End Select Finally: SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' ScriptForge.SF_Timer.SetProperty REM ----------------------------------------------------------------------------- Public Function Start() As Boolean ''' Start a new clean timer ''' Args: ''' Returns: ''' True if successful, False if the timer is already started ''' Examples: ''' myTimer.Start() Const cstThisSub = "Timer.Start" Const cstSubArgs = "" Check: Start = False SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Try: If _TimerStatus = STATUSINACTIVE Or _TimerStatus = STATUSSTOPPED Then _TimerStatus = STATUSSTARTED _StartTime = _Now() _EndTime = 0 _SuspendTime = 0 _SuspendDuration = 0 Start = True End If Finally: SF_Utils._ExitFunction(cstThisSub) Exit Function End Function ' ScriptForge.SF_Timer.Start REM ----------------------------------------------------------------------------- Public Function Suspend() As Boolean ''' Suspend a running timer ''' Args: ''' Returns: ''' True if successful, False if the timer is not started or already suspended ''' Examples: ''' myTimer.Suspend() Const cstThisSub = "Timer.Suspend" Const cstSubArgs = "" Check: Suspend = False SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Try: If _TimerStatus = STATUSSTARTED Then _TimerStatus = STATUSSUSPENDED _SuspendTime = _Now() Suspend = True End If Finally: SF_Utils._ExitFunction(cstThisSub) Exit Function End Function ' ScriptForge.SF_Timer.Suspend REM ----------------------------------------------------------------------------- Public Function Terminate() As Boolean ''' Terminate a running timer ''' Args: ''' Returns: ''' True if successful, False if the timer is neither started nor suspended ''' Examples: ''' myTimer.Terminate() Const cstThisSub = "Timer.Terminate" Const cstSubArgs = "" Check: Terminate = False SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Try: If _TimerStatus = STATUSSTARTED Or _TimerStatus = STATUSSUSPENDED Then If _TimerSTatus = STATUSSUSPENDED Then Continue() _TimerStatus = STATUSSTOPPED _EndTime = _Now() Terminate = True End If Finally: SF_Utils._ExitFunction(cstThisSub) Exit Function End Function ' ScriptForge.SF_Timer.Terminate REM =========================================================== PRIVATE FUNCTIONS REM ----------------------------------------------------------------------------- Private Function _Now() As Double ''' Returns the current date and time ''' Uses the Calc NOW() function to get a higher precision than the usual Basic Now() function ''' Args: ''' Returns: ''' The actual time as a number ''' The integer part represents the date, the decimal part represents the time _Now = SF_Session.ExecuteCalcFunction("NOW") End Function ' ScriptForge.SF_Timer._Now REM ----------------------------------------------------------------------------- Private Function _PropertyGet(Optional ByVal psProperty As String) ''' Return the named property ''' Args: ''' psProperty: the name of the property Dim dDuration As Double ' Computed duration Dim cstThisSub As String Dim cstSubArgs As String cstThisSub = "Timer.get" & psProperty cstSubArgs = "" SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Select Case UCase(psProperty) Case UCase("Duration") Select Case _TimerStatus Case STATUSINACTIVE : dDuration = 0.0 Case STATUSSTARTED dDuration = _Now() - _StartTime - _SuspendDuration Case STATUSSUSPENDED dDuration = _SuspendTime - _StartTime - _SuspendDuration Case STATUSSTOPPED dDuration = _EndTime - _StartTime - _SuspendDuration End Select _PropertyGet = Fix(dDuration * 1000 / DSECOND) / 1000 Case UCase("IsStarted") _PropertyGet = CBool( _TimerStatus = STATUSSTARTED Or _TimerStatus = STATUSSUSPENDED ) Case UCase("IsSuspended") _PropertyGet = CBool( _TimerStatus = STATUSSUSPENDED ) Case UCase("SuspendDuration") Select Case _TimerStatus Case STATUSINACTIVE : dDuration = 0.0 Case STATUSSTARTED, STATUSSTOPPED dDuration = _SuspendDuration Case STATUSSUSPENDED dDuration = _Now() - _SuspendTime + _SuspendDuration End Select _PropertyGet = Fix(dDuration * 1000 / DSECOND) / 1000 Case UCase("TotalDuration") Select Case _TimerStatus Case STATUSINACTIVE : dDuration = 0.0 Case STATUSSTARTED, STATUSSUSPENDED dDuration = _Now() - _StartTime Case STATUSSTOPPED dDuration = _EndTime - _StartTime End Select _PropertyGet = Fix(dDuration * 1000 / DSECOND) / 1000 End Select Finally: SF_Utils._ExitFunction(cstThisSub) Exit Function End Function ' ScriptForge.SF_Timer._PropertyGet REM ----------------------------------------------------------------------------- Private Function _Repr() As String ''' Convert the Timer instance to a readable string, typically for debugging purposes (DebugPrint ...) ''' Args: ''' Return: ''' "[Timer] Duration:xxx.yyy Const cstTimer = "[Timer] Duration: " Const cstMaxLength = 50 ' Maximum length for items _Repr = cstTimer & Replace(SF_Utils._Repr(Duration), ".", """") End Function ' ScriptForge.SF_Timer._Repr REM ============================================ END OF SCRIPTFORGE.SF_TIMER