diff options
| author | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-07 09:06:44 +0000 |
|---|---|---|
| committer | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-07 09:06:44 +0000 |
| commit | ed5640d8b587fbcfed7dd7967f3de04b37a76f26 (patch) | |
| tree | 7a5f7c6c9d02226d7471cb3cc8fbbf631b415303 /wizards/source/scriptforge/SF_Timer.xba | |
| parent | Initial commit. (diff) | |
| download | libreoffice-ed5640d8b587fbcfed7dd7967f3de04b37a76f26.tar.xz libreoffice-ed5640d8b587fbcfed7dd7967f3de04b37a76f26.zip | |
Adding upstream version 4:7.4.7.upstream/4%7.4.7upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'wizards/source/scriptforge/SF_Timer.xba')
| -rw-r--r-- | wizards/source/scriptforge/SF_Timer.xba | 466 |
1 files changed, 466 insertions, 0 deletions
diff --git a/wizards/source/scriptforge/SF_Timer.xba b/wizards/source/scriptforge/SF_Timer.xba new file mode 100644 index 000000000..2b3286e04 --- /dev/null +++ b/wizards/source/scriptforge/SF_Timer.xba @@ -0,0 +1,466 @@ +<?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>
\ No newline at end of file |