Global iTime as Integer 'used by SQAMsgBox function
'Dim TotalTime As Integer 'used by TimedMsgBox sub
Declare Function TimedDlgFunc(id As String, Action As Integer, SuppValue As Long) As Integer
'----------------------------------------------------------------
'TimedDlgFunc
'============
'function to process user actions in the SQAMsgBox dialog box
'(original function by Andy Tinkham, modified by Paul Downes)
'input : id = identifies the dialog control that triggered the call
' to the dialog function
' : Action = integer from 1 to 5 identifying the reason why the
' dialog function was called
' : SuppValue = specific info about why the dialog function was called
'returns :
Function TimedDlgFunc(id As String, Action As Integer, SuppValue As Long) As Integer
Static StartTime
Dim EndTime
Dim vTimeoutValue as Variant
Select Case Action
Case 1
StartTime = Timer
'Check to see if StartTime + TotalTime is greater than 86400
'(the total number of seconds in a day). If it is, change the
'value so that it is negative so that when the Timer function
'wraps back to 0 at midnight, the dialog still goes away at the
'appropriate time.
If StartTime + iTime >= 86400 Then
StartTime = 86400 - StartTime - iTime
End If
TimedDlgFunc = 1
Case 2
Select Case SuppValue
Case 1
DlgEnd -1
Case 2
DlgEnd 0
Case Else
TimedDlgFunc = 0
End Select
Case 3
TimedDlgFunc = 1
Case 4
TimedDlgFunc = 1
Case 5
EndTime = Timer
If (EndTime - StartTime) >= iTime Then
DlgEnd -1
End If
vTimeoutValue = Format(iTime - (EndTime - StartTime), "#.#")
DlgText DlgControlID("txtTimeValue"), CStr(vTimeoutValue)
TimedDlgFunc = 1
End Select
End Function
'----------------------------------------------------------------
'SQAMsgBox
'=========
'timed message box; displays timeout countdown; if user selects "OK" or on timeout,
'returns sqaPass; if user selects "Cancel", returns sqaFail
'input : sMsgText = message to display
' : vMsgCaption = (optional) dialog box caption
' : vTimeOut = (optional) timeout period in seconds (default = 20)
'returns : sqaPass on timeout or when OK button selected; sqaFail if Cancel selected
Function SQAMsgBox(sMsgText as String, Optional vMsgCaption as Variant, Optional vTimeOut as Variant) as Integer
Dim Result as Integer
Dim TotalTime As Integer
Dim sCmdText as String
Dim sTimeoutText as String
Dim vValue as Variant
'command message displayed
sCmdText = "Press OK to continue execution, Cancel to stop script."
'set defaults for optional parameters, if missing
If IsMissing(vMsgCaption) Then
vMsgCaption = "SQAMsgBox"
End If
If IsMissing(vTimeOut) Then
vTimeOut = 20 'seconds
End If