<?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="Python" script:language="StarBasic">
REM =======================================================================================================================
REM === The Access2Base library is a part of the LibreOffice project. ===
REM === Full documentation is available on http://www.access2base.com ===
REM =======================================================================================================================
Option Compatible
Option Explicit
REM -----------------------------------------------------------------------------------------------------------------------
Public Sub DebugPrint(ParamArray pvArgs() As Variant)
'Print arguments unconditionally in console
'Arguments are separated by a TAB (simulated by spaces)
'Some pvArgs might be missing: a TAB is still generated
Dim vVarTypes() As Variant, i As Integer
Const cstTab = 5
On Local Error Goto Exit_Sub ' Never interrupt processing
Utils._SetCalledSub("DebugPrint")
vVarTypes = Utils._AddNumeric(Array(vbEmpty, vbNull, vbDate, vbString, vbBoolean, vbObject, vbVariant, vbByte, vbArray + vbByte))
If UBound(pvArgs) >= 0 Then
For i = 0 To UBound(pvArgs)
If Not Utils._CheckArgument(pvArgs(i), i + 1, vVarTypes(), , False) Then pvArgs(i) = "[TYPE?]"
Next i
End If
Dim sOutput As String, sArg As String
sOutput = ""
For i = 0 To UBound(pvArgs)
sArg = Replace(Utils._CStr(pvArgs(i), _A2B_.DebugPrintShort), "\;", ";")
' Add argument to output
If i = 0 Then
sOutput = sArg
Else
sOutput = sOutput & Space(cstTab - (Len(sOutput) Mod cstTab)) & sArg
End If
Next i
TraceLog(TRACEANY, sOutput, False)
Exit_Sub:
Utils._ResetCalledSub("DebugPrint")
Exit Sub
End Sub ' DebugPrint V0.9.5
REM -----------------------------------------------------------------------------------------------------------------------
REM --- PYTHON WRAPPERS ---
REM -----------------------------------------------------------------------------------------------------------------------
REM -----------------------------------------------------------------------------------------------------------------------
Public Function PythonEventsWrapper(Optional poEvent As Variant) As Variant
' Python wrapper when Application.Events() method is invoked
' The ParamArray mechanism empties UNO objects when they are member of the arguments list
' As a workaround, the Application.Events function is executed directly
If _ErrorHandler() Then On Local Error GoTo Exit_Function ' Do never interrupt
PythonEventsWrapper = Null
Dim vReturn As Variant, vArray As Variant
Const cstObject = 1
vReturn = Application.Events(poEvent)
vArray = Array(cstObject, _A2B_.AddPython(vReturn), vReturn._Type)
PythonEventsWrapper = vArray
Exit_Function:
Exit Function
End Function ' PythonEventsWrapper V6.4
REM -----------------------------------------------------------------------------------------------------------------------
Public Function PythonWrapper(ByVal pvCallType As Variant _
, ByVal pvObject As Variant _
, ByVal pvScript As Variant _
, ParamArray pvArgs() As Variant _
) As Variant
' Called from Python to apply
' - on object with entry pvObject in PythonCache
' Conventionally: -1 = Application
' -2 = DoCmd
' - a script pvScript which type is described by pvCallType
' - with arguments pvArgs(0)... (max. 8 for object methods)
' The value returned by the method/property is encapsulated in an array
' [0] => 0 = scalar or array returned by the method
' => 1 = basic object returned by the method
' => 2 = a null value
' [1] => the object reference or the returned value (complemented with arguments passed by reference, if any) or Null
' [2] => the object type or Null
' [3] => the object name, if any
' or, when pvCallType == vbUNO, as the UNO object returned by the property
Dim vReturn As Variant, vArray As Variant
Dim vObject As Variant, sScript As String, sModule As String
Dim i As Integer, iNbArgs As Integer, vArg As Variant, vArgs() As Variant
Const cstApplication = -1, cstDoCmd = -2
Const cstScalar = 0, cstObject = 1, cstNull = 2, cstUNO = 3
'Conventional special values
Const cstNoArgs = "+++NOARGS+++", cstSymEmpty = "+++EMPTY+++", cstSymNull = "+++NULL+++", cstSymMissing = "+++MISSING+++"
'https://support.office.com/en-us/article/CallByName-fonction-49ce9475-c315-4f13-8d35-e98cfe98729a
'Determines the pvCallType
Const vbGet = 2, vbLet = 4, vbMethod = 1, vbSet = 8, vbUNO = 16
If _ErrorHandler() Then On Local Error GoTo Error_Function
PythonWrapper = Null
'Reinterpret arguments one by one into vArgs, examine iso-dates and conventional NoArgs/Empty/Null values
iNbArgs = -1
vArgs = Array()
If UBound(pvArgs) >= 0 Then
For i = 0 To UBound(pvArgs)
vArg = pvArgs(i)
If i = 0 And VarType(vArg) = vbString Then
If vArg = cstNoArgs Then Exit For
End If
If VarType(vArg) = vbString Then
If vArg = cstSymEmpty Then
vArg = Empty
ElseIf vArg = cstSymNull Then
vArg = Null
ElseIf vArg = cstSymMissing Then
Exit For ' Next arguments must be missing also
Else
vArg = _CDate(vArg)
End If
End If
iNbArgs = iNbArgs + 1
ReDim Preserve vArgs(iNbArgs)
vArgs(iNbArgs) = vArg
Next i
End If
'Check pvObject
Select Case pvObject ' Always numeric
Case cstApplication
sModule = "Application"
Select Case pvScript
Case "AllDialogs" : If iNbArgs < 0 Then vReturn = Application.AllDialogs() Else vReturn = Application.AllDialogs(vArgs(0))
Case "AllForms" : If iNbArgs < 0 Then vReturn = Application.AllForms() Else vReturn = Application.AllForms(vArgs(0))
Case "AllModules" : If iNbArgs < 0 Then vReturn = Application.AllModules() Else vReturn = Application.AllModules(vArgs(0))
Case "CloseConnection"
vReturn = Application.CloseConnection()
Case "CommandBars" : If iNbArgs < 0 Then vReturn = Application.CommandBars() Else vReturn = Application.CommandBars(vArgs(0))
Case "CurrentDb" : vReturn = Application.CurrentDb()
Case "CurrentUser" : vReturn = Application.CurrentUser()
Case "DAvg" : vReturn = Application.DAvg(vArgs(0), vArgs(1), vArgs(2))
Case "DCount" : vReturn = Application.DCount(vArgs(0), vArgs(1), vArgs(2))
Case "DLookup" : vReturn = Application.DLookup(vArgs(0), vArgs(1), vArgs(2), vArgs(3))
Case "DMax" : vReturn = Application.DMax(vArgs(0), vArgs(1), vArgs(2))
Case "DMin" : vReturn = Application.DMin(vArgs(0), vArgs(1), vArgs(2))
Case "DStDev" : vReturn = Application.DStDev(vArgs(0), vArgs(1), vArgs(2))
Case "DStDevP" : vReturn = Application.DStDevP(vArgs(0), vArgs(1), vArgs(2))
Case "DSum" : vReturn = Application.DSum(vArgs(0), vArgs(1), vArgs(2))
Case "DVar" : vReturn = Application.DVar(vArgs(0), vArgs(1), vArgs(2))
Case "DVarP" : vReturn = Application.DVarP(vArgs(0), vArgs(1), vArgs(2))
Case "Forms" : If iNbArgs < 0 Then vReturn = Application.Forms() Else vReturn = Application.Forms(vArgs(0))
Case "getObject" : vReturn = Application.getObject(vArgs(0))
Case "getValue" : vReturn = Application.getValue(vArgs(0))
Case "HtmlEncode" : vReturn = Application.HtmlEncode(vArgs(0), vArgs(1))
Case "OpenDatabase" : vReturn = Application.OpenDatabase(vArgs(0), vArgs(1), vArgs(2), vArgs(3))
Case "ProductCode" : vReturn = Application.ProductCode()
Case "setValue" : vReturn = Application.setValue(vArgs(0), vArgs(1))
Case "SysCmd" : vReturn = Application.SysCmd(vArgs(0), vArgs(1), vARgs(2))
Case "TempVars" : If iNbArgs < 0 Then vReturn = Application.TempVars() Else vReturn = Application.TempVars(vArgs(0))
Case "Version" : vReturn = Application.Version()
Case Else
GoTo Error_Proc
End Select
Case cstDoCmd
sModule = "DoCmd"
Select Case pvScript
Case "ApplyFilter" : vReturn = DoCmd.ApplyFilter(vArgs(0), vArgs(1), vArgs(2))
Case "Close" : vReturn = DoCmd.mClose(vArgs(0), vArgs(1), vArgs(2))
Case "CopyObject" : vReturn = DoCmd.CopyObject(vArgs(0), vArgs(1), vArgs(2), vArgs(3))
Case "FindNext" : vReturn = DoCmd.FindNext()
Case "FindRecord" : vReturn = DoCmd.FindRecord(vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6))
Case "GetHiddenAttribute"
vReturn = DoCmd.GetHiddenAttribute(vArgs(0), vArgs(1))
Case "GoToControl" : vReturn = DoCmd.GoToControl(vArgs(0))
Case "GoToRecord" : vReturn = DoCmd.GoToRecord(vArgs(0), vArgs(1), vArgs(2), vArgs(3))
Case "Maximize" : vReturn = DoCmd.Maximize()
Case "Minimize" : vReturn = DoCmd.Minimize()
Case "MoveSize" : vReturn = DoCmd.MoveSize(vArgs(0), vArgs(1), vArgs(2), vArgs(3))
Case "OpenForm" : vReturn = DoCmd.OpenForm(vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6))
Case "OpenQuery" : vReturn = DoCmd.OpenQuery(vArgs(0), vArgs(1), vArgs(2))
Case "OpenReport" : vReturn = DoCmd.OpenReport(vArgs(0), vArgs(1))
Case "OpenSQL" : vReturn = DoCmd.OpenSQL(vArgs(0), vArgs(1))
Case "OpenTable" : vReturn = DoCmd.OpenTable(vArgs(0), vArgs(1), vArgs(2))
Case "OutputTo" : vReturn = DoCmd.OutputTo(vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6), vArgs(7))
Case "Quit" : _A2B_.CalledSub = "Quit" : GoTo Error_Action
Case "RunApp" : vReturn = DoCmd.RunApp(vArgs(0))
Case "RunCommand" : vReturn = DoCmd.RunCommand(vArgs(0))
Case "RunSQL" : vReturn = DoCmd.RunSQL(vArgs(0), vArgs(1))
Case "SelectObject" : vReturn = DoCmd.SelectObject(vArgs(0), vArgs(1), vArgs(2))
Case "SendObject" : vReturn = DoCmd.SendObject(vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6), vArgs(7), vArgs(8), vArgs(9))
Case "SetHiddenAttribute"
vReturn = DoCmd.SetHiddenAttribute(vArgs(0), vArgs(1), vArgs(2))
Case "SetOrderBy" : vReturn = DoCmd.SetOrderBy(vArgs(0), vArgs(1))
Case "ShowAllRecords"
vReturn = DoCmd.ShowAllRecords()
Case Else
GoTo Error_Proc
End Select
Case Else
' Locate targeted object
If pvObject > UBound(_A2B_.PythonCache) Or pvObject < 0 Then GoTo Error_Object
Set vObject = _A2B_.PythonCache(pvObject)
If IsNull(vObject) Then
If pvScript = "Dispose" Then GoTo Exit_Function Else GoTo Error_Object
End If
' Preprocessing
sScript = pvScript
sModule = vObject._Type
Select Case sScript
Case "Add"
If vObject._Type = "COLLECTION" And vObject._CollType = COLLTABLEDEFS Then vArgs = Array(_A2B_.PythonCache(vArgs(0)))
Case "Close"
sSCript = "mClose"
Case "Type"
sScript = "pType"
Case Else
End Select
' Execute method
Select Case UBound(vArgs) ' Dirty but ... CallByName does not support an array of arguments or return values
Case -1
If pvCallType = vbUNO Then
With vObject
Select Case sScript ' List all properties that should be called directly (UNO)
Case "BoundField" : vReturn = .BoundField
Case "Column" : vReturn = .Column
Case "Connection" : vReturn = .Connection
case "ContainerWindow" : vReturn = .ContainerWindow
Case "ControlModel" : vReturn = .ControlModel
Case "ControlView" : vReturn = .ControlView
Case "DatabaseForm" : vReturn = .DatabaseForm
Case "Document" : vReturn = .Document
Case "FormsCollection" : vReturn = .FormsCollection
Case "LabelControl" : vReturn = .LabelControl
Case "MetaData" : vReturn = .MetaData
Case "ParentComponent" : vReturn = .ParentComponent
Case "Query" : vReturn = .Query
Case "RowSet" : vReturn = .RowSet
Case "Table" : vReturn = .Table
Case "UnoDialog" : vReturn = .UnoDialog
Case Else
End Select
End With
ElseIf sScript = "ItemData" Then ' List all properties that should be called directly (arrays not supported by CallByName)
vReturn = vObject.ItemData
ElseIf sScript = "LinkChildFields" Then
vReturn = vObject.LinkChildFields
ElseIf sScript = "LinkMasterFields" Then
vReturn = vObject.LinkMasterFields
ElseIf sScript = "OpenArgs" Then
vReturn = vObject.OpenArgs
ElseIf sScript = "Selected" Then
vReturn = vObject.Selected
ElseIf sScript = "Value" Then
vReturn = vObject.Value
Else
vReturn = CallByName(vObject, sScript, pvCallType)
End If
Case 0
Select Case sScript
Case "AppendChunk" ' Arg is a vector, not supported by CallByName
vReturn = vObject.GetChunk(vArgs(0), vArgs(1))
Case "GetRows" ' Returns an array, not supported by CallByName
vReturn = vObject.GetRows(vArgs(0), True) ' Force iso dates
Case Else
vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0))
End Select
Case 1
Select Case sScript
Case "GetChunk" ' Returns a vector, not supported by CallByName
vReturn = vObject.GetChunk(vArgs(0), vArgs(1))
Case Else
vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1))
End Select
Case 2 : vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1), vArgs(2))
Case 3 : vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1), vArgs(2), vArgs(3))
Case 4 : vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4))
Case 5 : vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5))
Case 6 : vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6))
Case 7 : vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6), vArgs(7))
End Select
' Postprocessing
Select Case pvScript
Case "Close", "Dispose", "Terminate"
Set _A2B_.PythonCache(pvObject) = Nothing
Case "Move", "MoveFirst", "MoveLast", "MoveNext", "MovePrevious" ' Pass the new BOF, EOF values (binary format)
If vObject._Type = "RECORDSET" Then
vReturn = (Iif(vObject.BOF, 1, 0) * 2 + Iif(vObject.EOF, 1, 0)) * Iif(vReturn, 1, -1)
End If
Case "Find" ' Store in array the arguments passed by reference
If vObject._Type = "MODULE" And vReturn = True Then
vReturn = Array(vReturn, vArgs(1), vArgs(2), vArgs(3), vArgs(4))
End If
Case "ProcOfLine" ' Store in array the arguments passed by reference
vReturn = Array(vReturn, vArgs(1))
Case Else
End Select
End Select
' Structure the returned array
If pvCallType = vbUNO Then
vArray = vReturn
Else
If IsNull(vReturn) Then
vArray = Array(cstNull, Null, Null)
ElseIf IsObject(vReturn) Then
Select Case vReturn._Type
Case "COLLECTION", "COMMANDBARCONTROL", "EVENT"
vArray = Array(cstObject, _A2B_.AddPython(vReturn), vReturn._Type)
Case Else
vArray = Array(cstObject, _A2B_.AddPython(vReturn), vReturn._Type, vReturn.Name)
End Select
Else
If VarType(vReturn) = vbDate Then
vArray = Array(cstScalar, _CStr(vReturn), Null)
ElseIf VarType(vReturn) = vbBigint Then ' Could happen for big integer database fields
vArray = Array(cstScalar, CLng(vReturn), Null)
Else
vArray = Array(cstScalar, vReturn, Null)
End If
End If
End If
PythonWrapper = vArray
Exit_Function:
Exit Function
Error_Function:
TraceError(TRACEABORT, Err, "PythonWrapper", Erl)
GoTo Exit_Function
Error_Object:
TraceError(TRACEFATAL, ERROBJECTNOTFOUND, "Python Wrapper (" & pvScript & ")", 0, , Array(_GetLabel("OBJECT"), "#" & pvObject))
GoTo Exit_Function
Error_Action:
TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0)
GoTo Exit_Function
Error_Proc:
TraceError(TRACEFATAL, ERRPROCEDURENOTFOUND, "Python Wrapper", 0, , Array(pvScript, sModule))
GoTo Exit_Function
End Function ' PythonWrapper V6.4
REM -----------------------------------------------------------------------------------------------------------------------
REM --- PYTHON HELPER FUNCTIONS ---
REM -----------------------------------------------------------------------------------------------------------------------
REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyConvertFromUrl(ByVal pvFile As Variant) As String
' Convenient function to have common conversions of filenames from/to url notations both in Python and Basic
On Local Error GoTo Exit_Function
PyConvertFromUrl = ""
If Not Utils._CheckArgument(pvFile, 1, vbString) Then Goto Exit_Function
PyConvertFromUrl = ConvertFromUrl(pvFile)
Exit_Function:
Exit Function
End Function ' PyConvertFromUrl V6.4
REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyConvertToUrl(ByVal pvFile As Variant) As String
' Convenient function to have common conversions of filenames from/to url notations both in Python and Basic
On Local Error GoTo Exit_Function
PyConvertToUrl = ""
If Not Utils._CheckArgument(pvFile, 1, vbString) Then Goto Exit_Function
PyConvertToUrl = ConvertToUrl(pvFile)
Exit_Function:
Exit Function
End Function ' PyConvertToUrl V6.4
REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyCreateUnoService(ByVal pvService As Variant) As Variant
' Convenient function to create a UNO service in Python
On Local Error GoTo Exit_Function
Set PyCreateUnoService = Nothing
If Not Utils._CheckArgument(pvService, 1, vbString) Then Goto Exit_Function
Set PyCreateUnoService = CreateUnoService(pvService)
Exit_Function:
Exit Function
End Function ' PyCreateUnoService V6.4
REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyDateAdd(ByVal pvAdd As Variant _
, ByVal pvCount As Variant _
, ByVal pvDate As Variant _
) As Variant
' Convenient shortcut to useful and easy-to-use Basic date functions
Dim vDate As Variant, vNewDate As Variant
On Local Error GoTo Exit_Function
PyDateAdd = Null
If Not Utils._CheckArgument(pvAdd, 1, vbString) Then Goto Exit_Function
If Not Utils._CheckArgument(pvCount, 2, Utils._AddNumeric()) Then Goto Exit_Function
If Not Utils._CheckArgument(pvDate, 3, vbString) Then Goto Exit_Function
vDate = _CDate(pvDate)
vNewDate = DateAdd(pvAdd, pvCount, vDate)
If VarType(vNewDate) = vbDate Then PyDateAdd = _CStr(vNewDate) Else PyDateAdd = vNewDate
Exit_Function:
Exit Function
End Function ' PyDateAdd V6.4
REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyDateDiff(ByVal pvAdd As Variant _
, ByVal pvDate1 As Variant _
, ByVal pvDate2 As Variant _
, ByVal pvWeekStart As Variant _
, ByVal pvYearStart As Variant _
) As Variant
' Convenient shortcut to useful and easy-to-use Basic date functions
Dim vDate1 As Variant, vDate2 As Variant
On Local Error GoTo Exit_Function
PyDateDiff = Null
If Not Utils._CheckArgument(pvAdd, 1, vbString) Then Goto Exit_Function
If Not Utils._CheckArgument(pvDate1, 2, vbString) Then Goto Exit_Function
If Not Utils._CheckArgument(pvDate2, 3, vbString) Then Goto Exit_Function
If Not Utils._CheckArgument(pvWeekStart, 4, Utils._AddNumeric()) Then Goto Exit_Function
If Not Utils._CheckArgument(pvWeekStart, 5, Utils._AddNumeric()) Then Goto Exit_Function
vDate1 = _CDate(pvDate1)
vDate2 = _CDate(pvDate2)
PyDateDiff = DateDiff(pvAdd, vDate1, vDate2, pvWeekStart, pvYearStart)
Exit_Function:
Exit Function
End Function ' PyDateDiff V6.4
REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyDatePart(ByVal pvAdd As Variant _
, ByVal pvDate As Variant _
, ByVal pvWeekStart As Variant _
, ByVal pvYearStart As Variant _
) As Variant
' Convenient shortcut to useful and easy-to-use Basic date functions
Dim vDate As Variant
On Local Error GoTo Exit_Function
PyDatePart = Null
If Not Utils._CheckArgument(pvAdd, 1, vbString) Then Goto Exit_Function
If Not Utils._CheckArgument(pvDate, 2, vbString) Then Goto Exit_Function
If Not Utils._CheckArgument(pvWeekStart, 3, Utils._AddNumeric()) Then Goto Exit_Function
If Not Utils._CheckArgument(pvWeekStart, 4, Utils._AddNumeric()) Then Goto Exit_Function
vDate = _CDate(pvDate)
PyDatePart = DatePart(pvAdd, vDate, pvWeekStart, pvYearStart)
Exit_Function:
Exit Function
End Function ' PyDatePart V6.4
REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyDateValue(ByVal pvDate As Variant) As Variant
' Convenient shortcut to useful and easy-to-use Basic date functions
Dim vDate As Variant
On Local Error GoTo Exit_Function
PyDateValue = Null
If Not Utils._CheckArgument(pvDate, 1, vbString) Then Goto Exit_Function
vDate = DateValue(pvDate)
If VarType(vDate) = vbDate Then PyDateValue = _CStr(vDate) Else PyDateValue = vDate
Exit_Function:
Exit Function
End Function ' PyDateValue V6.4
REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyFormat(ByVal pvValue As Variant, pvFormat As Variant) As String
' Convenient function to format numbers or dates
On Local Error GoTo Exit_Function
PyFormat = ""
If Not Utils._CheckArgument(pvValue, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
pvValue = _CDate(pvValue)
If IsEmpty(pvFormat) Then
PyFormat = Str(pvValue)
Else
If Not Utils._CheckArgument(pvFormat, 2, vbString) Then Goto Exit_Function
PyFormat = Format(pvValue, pvFormat)
End If
Exit_Function:
Exit Function
End Function ' PyFormat V6.4
REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyGetGUIType() As Variant
PyGetGUIType = GetGUIType()
End Function ' PyGetGUIType V6.4
REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyGetSystemTicks() As Variant
PyGetSystemTicks = GetSystemTicks()
End Function ' PyGetSystemTicks V6.4
REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyGlobalScope(ByVal pvLib As Variant) As Variant
Select Case pvLib
Case "Basic"
PyGlobalScope = GlobalScope.BasicLibraries()
Case "Dialog"
PyGlobalScope = GlobalScope.DialogLibraries()
Case Else
End Select
End Function ' PyGlobalScope V6.4
REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyInputBox(ByVal pvText As Variant _
, ByVal pvTitle As Variant _
, ByVal pvDefault As Variant _
, ByVal pvXPos As Variant _
, ByVal pvYPos As Variant _
) As Variant
' Convenient function to open input box from Python
On Local Error GoTo Exit_Function
PyInputBox = Null
If Not Utils._CheckArgument(pvText, 1, vbString) Then Goto Exit_Function
If IsEmpty(pvTitle) Then pvTitle = ""
If Not Utils._CheckArgument(pvTitle, 2, vbString) Then Goto Exit_Function
If IsEmpty(pvDefault) Then pvDefault = ""
If Not Utils._CheckArgument(pvDefault, 3, vbString) Then Goto Exit_Function
If IsEmpty(pvXPos) Or IsEmpty(pvYPos) Then
PyInputBox = InputBox(pvText, pvTitle, pvDefault)
Else
If Not Utils._CheckArgument(pvXPos, 4, Utils._AddNumeric()) Then Goto Exit_Function
If Not Utils._CheckArgument(pvYPos, 5, Utils._AddNumeric()) Then Goto Exit_Function
PyInputBox = InputBox(pvText, pvTitle, pvDefault, pvXPos, pvYPos)
End If
Exit_Function:
Exit Function
End Function ' PyInputBox V6.4.0
REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyMsgBox(ByVal pvText As Variant _
, ByVal pvType As Variant _
, ByVal pvDialogTitle As Variant _
) As Variant
' Convenient function to open message box from Python
On Local Error GoTo Exit_Function
PyMsgBox = Null
If Not Utils._CheckArgument(pvText, 1, vbString) Then Goto Exit_Function
If IsEmpty(pvType) Then pvType = 0
If Not Utils._CheckArgument(pvType, 2, Utils._AddNumeric()) Then Goto Exit_Function
If IsEmpty(pvDialogTitle) Then
PyMsgBox = MsgBox(pvText, pvType)
Else
If Not Utils._CheckArgument(pvDialogTitle, 3, vbString) Then Goto Exit_Function
PyMsgBox = MsgBox(pvText, pvType, pvDialogTitle)
End If
Exit_Function:
Exit Function
End Function ' PyMsgBox V6.4.0
REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyTimer() As Long
' Convenient function to call Timer from Python
PyTimer = Timer
End Function ' PyTimer V6.4
REM -----------------------------------------------------------------------------------------------------------------------
REM --- PRIVATE FUNCTIONS ---
REM -----------------------------------------------------------------------------------------------------------------------
REM -----------------------------------------------------------------------------------------------------------------------
Private Function _CDate(ByVal pvValue As Variant) As Variant
' Return a Date type if iso date, otherwise return input
Dim vValue As Variant
vValue = pvValue
If VarType(pvValue) = vbString Then
If pvValue <> "" And IsDate(pvValue) Then vValue = CDate(pvValue) ' IsDate("") gives True !?
End If
_CDate = vValue
End Function
</script:module>