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/access2base/Python.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 '')
| -rw-r--r-- | wizards/source/access2base/Python.xba | 613 |
1 files changed, 613 insertions, 0 deletions
diff --git a/wizards/source/access2base/Python.xba b/wizards/source/access2base/Python.xba new file mode 100644 index 000000000..94a442159 --- /dev/null +++ b/wizards/source/access2base/Python.xba @@ -0,0 +1,613 @@ +<?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>
\ No newline at end of file |