Quelle  SF_Timer.xba   Sprache: unbekannt

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Timer" script:language="StarBasic" script:moduleType="normal">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
</script:module>