613 lines
27 KiB
Java
613 lines
27 KiB
Java
<?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> |