diff options
Diffstat (limited to 'extensions/test/ole/VisualBasic/Module1.vb')
| -rw-r--r-- | extensions/test/ole/VisualBasic/Module1.vb | 853 |
1 files changed, 853 insertions, 0 deletions
diff --git a/extensions/test/ole/VisualBasic/Module1.vb b/extensions/test/ole/VisualBasic/Module1.vb new file mode 100644 index 000000000000..364af636585f --- /dev/null +++ b/extensions/test/ole/VisualBasic/Module1.vb @@ -0,0 +1,853 @@ +Option Strict Off
+Option Explicit On
+Module Module1
+
+Private objServiceManager As Object
+Private objCoreReflection As Object
+Private objOleTest As Object
+Private objEventListener As Object
+'General counter
+Dim i As Integer
+Dim j As Integer
+Dim sError As String
+Dim outHyper, inHyper, retHyper As Object
+
+Public Sub Main()
+ objServiceManager = CreateObject("com.sun.star.ServiceManager")
+ objCoreReflection = objServiceManager.createInstance("com.sun.star.reflection.CoreReflection")
+ ' extensions/test/ole/cpnt
+ objOleTest = objServiceManager.createInstance("oletest.OleTest")
+ ' extensions/test/ole/EventListenerSample/VBEventListener
+ objEventListener = CreateObject("VBasicEventListener.VBEventListener")
+ Debug.Print(TypeName(objOleTest))
+
+
+ testBasics()
+ testHyper()
+ testAny()
+ testObjects()
+ testGetStruct()
+ ''dispose not working i103353
+ 'testImplementedInterfaces()
+ testGetValueObject()
+ testArrays()
+ testProps()
+
+ End Sub
+ Function testProps() As Object
+
+ Dim aToolbarItemProp1 As Object
+ aToolbarItemProp1 = objOleTest.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
+ Dim aToolbarItemProp2 As Object
+ aToolbarItemProp2 = objOleTest.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
+ Dim aToolbarItemProp3 As Object
+ aToolbarItemProp3 = objOleTest.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
+ Dim properties(2) As Object
+
+ aToolbarItemProp1.Name = "CommandURL"
+ aToolbarItemProp1.Value = "macro:///standard.module1.TestIt"
+ aToolbarItemProp2.Name = "Label"
+ aToolbarItemProp2.Value = "Test"
+ aToolbarItemProp3.Name = "Type"
+ aToolbarItemProp3.Value = 0
+
+ properties(0) = aToolbarItemProp1
+ properties(1) = aToolbarItemProp2
+ properties(2) = aToolbarItemProp3
+
+
+ Dim dummy(-1) As Object
+
+ Dim Desktop As Object
+ Desktop = objServiceManager.createInstance("com.sun.star.frame.Desktop")
+ Dim Doc As Object
+ Doc = Desktop.loadComponentFromURL("private:factory/swriter", "_blank", 2, dummy)
+ Dim LayoutManager As Object
+ LayoutManager = Doc.currentController.Frame.LayoutManager
+
+ LayoutManager.createElement("private:resource/toolbar/user_toolbar1")
+ LayoutManager.showElement("private:resource/toolbar/user_toolbar1")
+ Dim ToolBar As Object
+ ToolBar = LayoutManager.getElement("private:resource/toolbar/user_toolbar1")
+ Dim settings As Object
+ settings = ToolBar.getSettings(True)
+
+ 'the changes are here:
+ Dim aany As Object
+ aany = objServiceManager.Bridge_GetValueObject()
+ Call aany.Set("[]com.sun.star.beans.PropertyValue", properties)
+ Call settings.insertByIndex(0, aany)
+ Call ToolBar.setSettings(settings)
+
+
+ End Function
+
+
+ Function testBasics() As Object
+ ' In Parameter, simple types
+ '============================================
+ Dim tmpVar As Object
+ Dim ret As Object
+ Dim outByte, inByte, retByte As Byte
+ Dim outBool, inBool, retBool As Boolean
+ Dim outShort, inShort, retShort As Short
+ Dim outUShort, inUShort, retUShort As Short
+ Dim outLong, inLong, retLong As Integer
+ Dim outULong, inULong, retULong As Integer
+ Dim outHyper, inHyper, retHyper As Object
+ Dim outUHyper, inUHyper, retUHyper As Object
+ Dim outFloat, inFloat, retFloat As Single
+ Dim outDouble, inDouble, retDouble As Double
+ Dim outString, inString, retString As String
+ Dim retChar, inChar, outChar, retChar2 As Short
+ Dim outCharAsString, inCharAsString, retCharAsString As String
+ Dim outAny, inAny, retAny As Object
+ Dim outType, inType, retType As Object
+ Dim outXInterface, inXInterface, retXInterface As Object
+ Dim outXInterface2, inXInterface2, retXInterface2 As Object
+
+
+ Dim outVarByte As Object
+ Dim outVarBool As Object
+ Dim outVarShort As Object
+ Dim outVarUShort As Object
+ Dim outVarLong As Object
+ Dim outVarULong As Object
+ Dim outVarFloat As Object
+ Dim outVarDouble As Object
+ Dim outVarString As Object
+ Dim outVarChar As Object
+ Dim outVarAny As Object
+ Dim outVarType As Object
+
+ inByte = 10
+ inBool = True
+ inShort = -10
+ inUShort = -100
+ inLong = -1000
+ inHyper = CDec("-9223372036854775808") 'lowest int64
+ inUHyper = CDec("18446744073709551615") ' highest unsigned int64
+ inULong = 10000
+ inFloat = 3.14
+ inDouble = 3.14
+ inString = "Hello World!"
+ inChar = 65
+ inCharAsString = "A"
+ inAny = "Hello World"
+ inType = objServiceManager.Bridge_CreateType("[]long")
+ inXInterface = objCoreReflection
+ inXInterface2 = objEventListener
+
+ retByte = objOleTest.in_methodByte(inByte)
+ retBool = objOleTest.in_methodBool(inBool)
+ retShort = objOleTest.in_methodShort(inShort)
+ retUShort = objOleTest.in_methodUShort(inUShort)
+ retLong = objOleTest.in_methodLong(inLong)
+ retULong = objOleTest.in_methodULong(inULong)
+ retHyper = objOleTest.in_methodHyper(inHyper)
+ retUHyper = objOleTest.in_methodUHyper(inUHyper)
+ retFloat = objOleTest.in_methodFloat(inFloat)
+ retDouble = objOleTest.in_methodDouble(inDouble)
+ retString = objOleTest.in_methodString(inString)
+ retChar = objOleTest.in_methodChar(inChar)
+ retChar2 = objOleTest.in_methodChar(inCharAsString)
+ retAny = objOleTest.in_methodAny(inAny)
+ retType = objOleTest.in_methodType(inType)
+ retXInterface = objOleTest.in_methodXInterface(inXInterface) ' UNO object
+ retXInterface2 = objOleTest.in_methodXInterface(inXInterface2)
+
+ If retByte <> inByte Or retBool <> inBool Or retShort <> inShort Or retUShort <> inUShort _
+ Or retLong <> inLong Or retULong <> inULong Or retHyper <> inHyper _
+ Or retUHyper <> inUHyper Or retFloat <> inFloat Or retDouble <> inDouble _
+ Or retString <> inString Or retChar <> inChar Or retChar2 <> Asc(inCharAsString) _
+ Or retAny <> inAny Or Not (retType.Name = inType.Name) _
+ Or inXInterface IsNot retXInterface Or inXInterface2 IsNot retXInterface2 Then
+ sError = "in - parameter and return value test failed"
+ MsgBox(sError)
+
+ End If
+
+ 'Out Parameter simple types
+ '================================================
+
+
+ objOleTest.testout_methodByte(outByte)
+ objOleTest.testout_methodFloat(outFloat)
+ objOleTest.testout_methodDouble(outDouble)
+ objOleTest.testout_methodBool(outBool)
+ objOleTest.testout_methodShort(outShort)
+ objOleTest.testout_methodUShort(outUShort)
+ objOleTest.testout_methodLong(outLong)
+ objOleTest.testout_methodULong(outULong)
+ objOleTest.testout_methodHyper(outHyper)
+ objOleTest.testout_methodUHyper(outUHyper)
+ objOleTest.testout_methodString(outString)
+ objOleTest.testout_methodChar(outChar)
+ 'outCharAsString is a string. Therfore the returned sal_Unicode value of 65 will be converted
+ 'to a string "65"
+ objOleTest.testout_methodChar(outCharAsString)
+ objOleTest.testout_methodAny(outAny)
+ objOleTest.testout_methodType(outType)
+ 'objOleTest.in_methodXInterface (inXInterface) ' UNO object
+ Call objOleTest.in_methodXInterface(inXInterface) ' UNO object
+ objOleTest.testout_methodXInterface(outXInterface)
+ Call objOleTest.in_methodXInterface(inXInterface2) ' COM object
+ objOleTest.testout_methodXInterface(outXInterface2)
+
+ If outByte <> inByte Or outFloat <> inFloat Or outDouble <> inDouble _
+ Or outBool <> inBool Or outShort <> inShort Or outUShort <> inUShort _
+ Or outLong <> inLong Or outULong <> inULong Or outHyper <> inHyper _
+ Or outUHyper <> inUHyper Or outString <> inString Or outChar <> inChar _
+ Or Not (outCharAsString = "65") Or outAny <> inAny _
+ Or Not (outType.Name = inType.Name) Or inXInterface IsNot outXInterface _
+ Or inXInterface2 IsNot outXInterface2 Then
+
+ sError = "out - parameter test failed!"
+ MsgBox(sError)
+ End If
+
+ 'Out Parameter simple types (VARIANT var)
+ '====================================================
+ objOleTest.testout_methodByte(outVarByte)
+ objOleTest.testout_methodBool(outVarBool)
+ objOleTest.testout_methodChar(outVarChar)
+ objOleTest.testout_methodShort(outVarShort)
+ objOleTest.testout_methodUShort(outVarUShort)
+ objOleTest.testout_methodLong(outVarLong)
+ objOleTest.testout_methodULong(outVarULong)
+ objOleTest.testout_methodString(outVarString)
+ objOleTest.testout_methodFloat(outVarFloat)
+ objOleTest.testout_methodDouble(outVarDouble)
+ objOleTest.testout_methodAny(outVarAny)
+ objOleTest.testout_methodType(outVarType)
+
+ If outVarByte <> inByte Or outVarBool <> inBool Or outVarChar <> inChar _
+ Or outVarShort <> inShort Or outVarUShort <> inUShort _
+ Or outVarLong <> inLong Or outVarULong <> inULong Or outVarString <> inString _
+ Or outVarFloat <> inFloat Or outVarDouble <> inDouble Or outVarAny <> inAny _
+ Or Not (outVarType.Name = inType.Name) Then
+ sError = "out - parameter (VARIANT) test failed!"
+ MsgBox(sError)
+ End If
+
+ 'In/Out simple types
+ '============================================
+ objOleTest.in_methodByte(0)
+ objOleTest.in_methodBool(False)
+ objOleTest.in_methodShort(0)
+ objOleTest.in_methodUShort(0)
+ objOleTest.in_methodLong(0)
+ objOleTest.in_methodULong(0)
+ objOleTest.in_methodHyper(0)
+ objOleTest.in_methodUHyper(0)
+ objOleTest.in_methodFloat(0)
+ objOleTest.in_methodDouble(0)
+ objOleTest.in_methodString(0)
+ objOleTest.in_methodChar(0)
+ objOleTest.in_methodAny(0)
+ objOleTest.in_methodType(objServiceManager.Bridge_CreateType("boolean"))
+ outXInterface = Nothing
+ Call objOleTest.in_methodXInterface(outXInterface)
+
+ outByte = 10
+ retByte = outByte
+ objOleTest.testinout_methodByte(retByte)
+ objOleTest.testinout_methodByte(retByte)
+ outBool = True
+ retBool = outBool
+ objOleTest.testinout_methodBool(retBool)
+ objOleTest.testinout_methodBool(retBool)
+ outShort = 10
+ retShort = outShort
+ objOleTest.testinout_methodShort(retShort)
+ objOleTest.testinout_methodShort(retShort)
+ outUShort = 20
+ retUShort = outUShort
+ objOleTest.testinout_methodUShort(retUShort)
+ objOleTest.testinout_methodUShort(retUShort)
+ outLong = 30
+ retLong = outLong
+ objOleTest.testinout_methodLong(retLong)
+ objOleTest.testinout_methodLong(retLong)
+ outULong = 40
+ retULong = outULong
+ objOleTest.testinout_methodULong(retLong)
+ objOleTest.testinout_methodULong(retLong)
+ outHyper = CDec("9223372036854775807") 'highest positiv value of int64
+ retHyper = outHyper
+ objOleTest.testinout_methodHyper(retHyper)
+ objOleTest.testinout_methodHyper(retHyper)
+ outUHyper = CDec("18446744073709551615") 'highest value of unsigned int64
+ retUHyper = outUHyper
+ objOleTest.testinout_methodUHyper(retUHyper)
+ objOleTest.testinout_methodUHyper(retUHyper)
+ outFloat = 3.14
+ retFloat = outFloat
+ objOleTest.testinout_methodFloat(retFloat)
+ objOleTest.testinout_methodFloat(retFloat)
+ outDouble = 4.14
+ retDouble = outDouble
+ objOleTest.testinout_methodDouble(retDouble)
+ objOleTest.testinout_methodDouble(retDouble)
+ outString = "Hello World!"
+ retString = outString
+ objOleTest.testinout_methodString(retString)
+ objOleTest.testinout_methodString(retString)
+ outChar = 66
+ retChar = outChar
+ objOleTest.testinout_methodChar(retChar)
+ objOleTest.testinout_methodChar(retChar)
+ outCharAsString = "H"
+ retCharAsString = outCharAsString
+ objOleTest.testinout_methodChar(retCharAsString)
+ objOleTest.testinout_methodChar(retCharAsString)
+ outAny = "Hello World 2!"
+ retAny = outAny
+ objOleTest.testinout_methodAny(retAny)
+ objOleTest.testinout_methodAny(retAny)
+ outType = objServiceManager.Bridge_CreateType("long")
+ retType = outType
+ objOleTest.testinout_methodType(retType)
+ objOleTest.testinout_methodType(retType)
+
+ outXInterface = objCoreReflection
+ retXInterface = outXInterface
+ objOleTest.testinout_methodXInterface2(retXInterface)
+
+ If outByte <> retByte Or outBool <> retBool Or outShort <> retShort _
+ Or outUShort <> retUShort Or outLong <> retLong Or outULong <> retULong _
+ Or outHyper <> retHyper Or outUHyper <> outUHyper _
+ Or outFloat <> retFloat Or outDouble <> retDouble _
+ Or outString <> retString Or outChar <> retChar _
+ Or outCharAsString <> retCharAsString _
+ Or outAny <> retAny Or Not (outType.Name = retType.Name) _
+ Or outXInterface IsNot retXInterface Then
+ sError = "in/out - parameter test failed!"
+ MsgBox(sError)
+ End If
+
+ 'Attributes
+ objOleTest.AByte = inByte
+ retByte = 0
+ retByte = objOleTest.AByte
+ objOleTest.AFloat = inFloat
+ retFloat = 0
+ retFloat = objOleTest.AFloat
+ objOleTest.AType = inType
+ retType = Nothing
+
+ retType = objOleTest.AType
+
+ If inByte <> retByte Or inFloat <> retFloat Or Not (inType.Name = retType.Name) Then
+ sError = "Attributes - test failed!"
+ MsgBox(sError)
+ End If
+
+ End Function
+ Function testHyper() As Object
+
+ '======================================================================
+ ' Other Hyper tests
+ Dim emptyVar As Object
+ Dim retAny As Object
+
+ retAny = emptyVar
+ inHyper = CDec("9223372036854775807") 'highest positiv value of int64
+ retAny = objOleTest.in_methodAny(inHyper)
+ sError = "hyper test failed"
+ If inHyper <> retAny Then
+ MsgBox(sError)
+ End If
+ inHyper = CDec("-9223372036854775808") 'lowest negativ value of int64
+ retAny = objOleTest.in_methodAny(inHyper)
+
+ If inHyper <> retAny Then
+ MsgBox(sError)
+ End If
+ inHyper = CDec("18446744073709551615") 'highest positiv value of unsigne int64
+ retAny = objOleTest.in_methodAny(inHyper)
+
+ If inHyper <> retAny Then
+ MsgBox(sError)
+ End If
+ inHyper = CDec(-1)
+ retAny = objOleTest.in_methodAny(inHyper)
+ If inHyper <> retAny Then
+ MsgBox(sError)
+ End If
+ inHyper = CDec(0)
+ retAny = objOleTest.in_methodAny(inHyper)
+ If inHyper <> retAny Then
+ MsgBox(sError)
+ End If
+
+ '==============================================================================
+
+
+ End Function
+ Function testAny() As Object
+ Dim outVAr As Object
+
+ 'Any test. We pass in an any as value object. If it is not correct converted
+ 'then the target component throws a RuntimeException
+ Dim lengthInAny As Integer
+
+ lengthInAny = 10
+ Dim seqLongInAny(10) As Integer
+ For i = 0 To lengthInAny - 1
+ seqLongInAny(i) = i + 10
+ Next
+ Dim anySeqLong As Object
+ anySeqLong = objOleTest.Bridge_GetValueObject()
+ anySeqLong.Set("[]long", seqLongInAny)
+ Dim anySeqRet As Object
+ Err.Clear()
+ On Error Resume Next
+ anySeqRet = objOleTest.other_methodAny(anySeqLong, "[]long")
+
+ If Err.Number <> 0 Then
+ MsgBox("error")
+ End If
+ End Function
+
+ Function testObjects() As Object
+ ' COM obj
+ Dim outVAr As Object
+ Dim retObj As Object
+ 'OleTest receives a COM object that implements XEventListener
+ 'OleTest then calls a disposing on the object. The object then will be
+ 'asked if it has been called
+ objEventListener.setQuiet(True)
+ objEventListener.resetDisposing()
+ retObj = objOleTest.in_methodInvocation(objEventListener)
+ Dim ret As Object
+ ret = objEventListener.disposingCalled
+ If ret = False Then
+ MsgBox("Error")
+ End If
+
+ 'The returned object should be objEventListener, test it by calling disposing
+ ' takes an IDispatch as Param ( EventObject).To provide a TypeMismatch
+ 'we put in another IDispatch
+ retObj.resetDisposing()
+ retObj.disposing(objEventListener)
+ If retObj.disposingCalled = False Then
+ MsgBox("Error")
+ End If
+
+ ' out param gives out the OleTestComponent
+ 'objOleTest.testout_methodXInterface retObj
+ 'outVAr = Null
+ 'retObj.testout_methodAny outVAr
+ 'Debug.Print "test out Interface " & CStr(outVAr)
+ 'If outVAr <> "I am a string in an any" Then
+ ' MsgBox "error"
+ 'End If
+
+
+ 'in out
+ ' in: UNO object, the same is expected as out param
+ ' the function expects OleTest as parameter and sets a value
+
+ Dim myAny As Object
+
+
+
+ Dim objOleTest2 As Object
+ objOleTest2 = objServiceManager.createInstance("oletest.OleTest")
+ 'Set a value
+ objOleTest2.AttrAny2 = "VBString "
+
+ 'testinout_methodXInterfaces substitutes the argument with the object set in in_methodXInterface
+ objOleTest.AttrAny2 = "VBString this string was written in the UNO component to the inout pararmeter"
+ objOleTest.in_methodXInterface(objOleTest)
+ objOleTest.testinout_methodXInterface2(objOleTest2)
+ Dim tmpVar As Object
+ tmpVar = System.DBNull.Value
+ tmpVar = objOleTest2.AttrAny2
+ Debug.Print("in: Uno out: the same object // " & CStr(tmpVar))
+ If tmpVar <> "VBString this string was written in the UNO component to the inout pararmeter" Then
+ MsgBox("error")
+ End If
+
+
+ 'create a struct
+ Dim structClass As Object
+ structClass = objCoreReflection.forName("oletest.SimpleStruct")
+ Dim structInstance As Object
+ structClass.CreateObject(structInstance)
+ structInstance.message = "Now we are in VB"
+ Debug.Print("struct out " & structInstance.message)
+ If structInstance.message <> "Now we are in VB" Then
+ MsgBox("error")
+ End If
+
+ 'put the struct into OleTest. The same struct will be returned with an added String
+ Dim structRet As Object
+ structRet = objOleTest.in_methodStruct(structInstance)
+ Debug.Print("struct in - return " & structRet.message)
+ If structRet.message <> "Now we are in VBThis string was set in OleTest" Then
+ MsgBox("error")
+ End If
+
+
+ End Function
+ Function testGetStruct() As Object
+ 'Bridge_GetStruct
+ '========================================================
+ Dim objDocument As Object
+ objDocument = createHiddenDocument()
+ 'dispose not working i103353
+ 'objDocument.dispose()
+ objDocument.close(True)
+ End Function
+
+ Function testImplementedInterfaces() As Object
+ 'Bridge_ImplementedInterfaces
+ '=================================================
+ ' call an UNO function that takes an XEventListener interface
+ 'We provide a COM implementation (IDispatch) as EventListener
+ 'Open a new empty writer document
+
+ Dim objDocument As Object
+ objDocument = createHiddenDocument()
+ objEventListener.resetDisposing()
+ objDocument.addEventListener(objEventListener)
+ objDocument.dispose()
+ If objEventListener.disposingCalled = False Then
+ MsgBox("Error")
+ End If
+ End Function
+
+ Function testGetValueObject() As Object
+ 'Bridge_GetValueObject
+ '==================================================
+ Dim objVal As Object
+ objVal = objOleTest.Bridge_GetValueObject()
+ Dim arrByte(9) As Byte
+ Dim countvar As Integer
+ For countvar = 0 To 9
+ arrByte(countvar) = countvar
+ Next countvar
+
+ objVal.Set("[]byte", arrByte)
+ Dim ret As Object
+ ret = 0
+ ret = objOleTest.methodByte(objVal)
+ 'Test if ret is the same array
+
+ Dim key As Object
+ key = 0
+ For Each key In ret
+ If ret(key) <> arrByte(key) Then
+ MsgBox("Error")
+ End If
+ Debug.Print(ret(key))
+ Next key
+
+ Dim outByte As Byte
+ outByte = 77
+ Dim retByte As Byte
+ retByte = outByte
+ objVal.InitInOutParam("byte", retByte)
+ objOleTest.testinout_methodByte(objVal)
+ objVal.InitInOutParam("byte", retByte)
+ objOleTest.testinout_methodByte(objVal)
+
+ ret = 0
+ ret = objVal.Get()
+ Debug.Print(ret)
+ If ret <> outByte Then
+ MsgBox("error")
+ End If
+
+ objVal.InitOutParam()
+ Dim inChar As Short
+ inChar = 65
+ objOleTest.in_methodChar(inChar)
+ objOleTest.testout_methodChar(objVal) 'Returns 'A' (65)
+ ret = 0
+ ret = objVal.Get()
+ Debug.Print(ret)
+ If ret <> inChar Then
+ MsgBox("error")
+ End If
+
+ End Function
+
+ Function testArrays() As Object
+ 'Arrays
+ '========================================
+ Dim arrLong(2) As Integer
+ Dim arrObj(2) As Object
+ Dim countvar As Integer
+ For countvar = 0 To 2
+ arrLong(countvar) = countvar + 10
+ Debug.Print(countvar)
+ arrObj(countvar) = CreateObject("VBasicEventListener.VBEventListener")
+ arrObj(countvar).setQuiet(True)
+ Next
+
+ 'Arrays always contain VARIANTS
+ Dim seq() As Object
+ seq = objOleTest.methodLong(arrLong)
+
+ For countvar = 0 To 2
+ Debug.Print(CStr(seq(countvar)))
+ If arrLong(countvar) <> seq(countvar) Then
+ MsgBox("error")
+ End If
+ Next
+ seq = objOleTest.methodXInterface(arrObj)
+ Dim tmp As Object
+ For countvar = 0 To 2
+ seq(countvar).resetDisposing()
+ seq(countvar).disposing(CObj(tmp))
+ If seq(countvar).disposingCalled = False Then
+ MsgBox("Error")
+ End If
+ Next
+
+ 'Array containing interfaces (element type is VT_DISPATCH)
+ Dim arEventListener(2) As Object
+ For countvar = 0 To 2
+ arEventListener(countvar) = CreateObject("VBasicEventListener.VBEventListener")
+ arEventListener(countvar).setQuiet(True)
+ Next
+
+ 'The function calls disposing on the listeners
+ seq = objOleTest.methodXEventListeners(arEventListener)
+ Dim count As Object
+ For countvar = 0 To 2
+ If arEventListener(countvar).disposingCalled = False Then
+ MsgBox("Error")
+ End If
+ Next
+ 'Array containing interfaces (element type is VT_VARIANT which contains VT_DISPATCH
+ Dim arEventListener2(2) As Object
+ For countvar = 0 To 2
+ arEventListener2(countvar) = CreateObject("VBasicEventListener.VBEventListener")
+ arEventListener2(countvar).setQuiet(True)
+ Next
+ seq = objOleTest.methodXEventListeners(arEventListener2)
+ For countvar = 0 To 2
+ If arEventListener2(countvar).disposingCalled = False Then
+ MsgBox("Error")
+ End If
+ Next
+
+ 'Variant containing Array containing interfaces (element type is VT_VARIANT which contains VT_DISPATCH
+ Dim arEventListener3(2) As Object
+ Dim var As Object
+ For countvar = 0 To 2
+ arEventListener3(countvar) = CreateObject("VBasicEventListener.VBEventListener")
+ arEventListener3(countvar).setQuiet(True)
+ Next
+ Dim varContAr As Object
+ varContAr = VB6.CopyArray(arEventListener3)
+ seq = objOleTest.methodXEventListeners(varContAr)
+ For countvar = 0 To 2
+ If arEventListener3(countvar).disposingCalled = False Then
+ MsgBox("Error")
+ End If
+ Next
+
+ 'Get a sequence created in UNO, out param is Variant ( VT_BYREF|VT_VARIANT)
+ Dim seqX As Object
+
+ objOleTest.testout_methodSequence(seqX)
+ Dim key As Object
+ For Each key In seqX
+ Debug.Print(CStr(seqX(key)))
+ If seqX(key) <> key Then
+ MsgBox("error")
+ End If
+ Next key
+ 'Get a sequence created in UNO, out param is array Variant ( VT_BYREF|VT_VARIANT|VT_ARRAY)
+ Dim seqX2() As Object
+ objOleTest.testout_methodSequence(seqX2)
+
+ For Each key In seqX2
+ Debug.Print(CStr(seqX2(key)))
+ Next key
+
+ 'pass it to UNO and get it back
+ Dim seq7() As Object
+ seq7 = objOleTest.methodLong(seqX)
+ Dim key2 As Object
+ For Each key2 In seq7
+ Debug.Print(CStr(seq7(key2)))
+ If seqX2(key) <> key Then
+ MsgBox("error")
+ End If
+ Next key2
+
+ 'array with starting index != 0
+ Dim seqIndex(2) As Integer
+ Dim seq8() As Object
+ Dim longVal1, longVal2 As Integer
+ longVal1 = 1
+ longVal2 = 2
+ seqIndex(1) = longVal1
+ seqIndex(2) = longVal2
+ 'The bridge returns a Safearray of Variants. It does not yet convert to an _
+ 'array of a particular type!
+ 'Comparing of elements from seq8 (Object) with long values worked without _
+ 'explicit cast as is necessary in VS 2008. Also arrays in VS 2008 start at _
+ 'index 0
+ seq8 = objOleTest.methodLong(seqIndex)
+ If longVal1 <> CInt(seq8(1)) And longVal2 <> CInt(seq8(2)) Then
+ MsgBox("error")
+ End If
+
+ 'in out Array
+ ' arrLong is Long Array
+ Dim inoutVar(2) As Object
+
+ For countvar = 0 To 2
+ inoutVar(countvar) = countvar + 10
+ Next
+
+ objOleTest.testinout_methodSequence(inoutVar)
+
+ countvar = 0
+ For countvar = 0 To 2
+ Debug.Print(CStr(inoutVar(countvar)))
+ If inoutVar(countvar) <> countvar + 11 Then
+ MsgBox("error")
+ End If
+ Next
+
+ 'Multidimensional array
+ '============================================================
+ ' Sequence< Sequence<long> > methodSequence( Sequence< Sequence long> >)
+ ' Real multidimensional array Array
+ ' 9 is Dim 1 (least significant) with C API
+ Dim mulAr(9, 1) As Integer
+ For i = 0 To 1
+ For j = 0 To 9
+ mulAr(j, i) = i * 10 + j
+ Next j
+ Next i
+
+ Dim resMul As Object
+ resMul = objOleTest.methodSequence(mulAr)
+
+ Dim countDim1 As Integer
+ Dim countDim2 As Integer
+ Dim arr As Object
+ For countDim2 = 0 To 1
+ arr = resMul(countDim2)
+ For countDim1 = 0 To 9
+ Debug.Print(arr(countDim1))
+ If arr(countDim1) <> mulAr(countDim1, countDim2) Then
+ MsgBox("Error Multidimensional Array")
+ End If
+ Next countDim1
+ Next countDim2
+ IsArray(resMul)
+
+ 'Array of VARIANTs containing arrays
+ Dim mulAr2(1) As Object
+ Dim arr2(9) As Integer
+ For i = 0 To 1
+ ' Dim arr(9) As Long
+ For j = 0 To 9
+ arr2(j) = i * 10 + j
+ Next j
+ mulAr2(i) = VB6.CopyArray(arr2)
+ Next i
+
+ resMul = 0
+ resMul = objOleTest.methodSequence(mulAr2)
+ arr = 0
+ Dim tmpVar As Object
+ For countDim2 = 0 To 1
+ arr = resMul(countDim2)
+ tmpVar = mulAr2(countDim2)
+ For countDim1 = 0 To 9
+ Debug.Print(arr(countDim1))
+ If arr(countDim1) <> tmpVar(countDim1) Then
+ MsgBox("Error Multidimensional Array")
+ End If
+ Next countDim1
+ Next countDim2
+
+ 'Array containing interfaces (element type is VT_DISPATCH)
+ Dim arArEventListener(1, 2) As Object
+ For i = 0 To 1
+ For j = 0 To 2
+ arArEventListener(i, j) = CreateObject("VBasicEventListener.VBEventListener")
+ arArEventListener(i, j).setQuiet(True)
+ Next
+ Next
+ 'The function calls disposing on the listeners
+ seq = objOleTest.methodXEventListenersMul(arArEventListener)
+ For i = 0 To 1
+ For j = 0 To 2
+ If arArEventListener(i, j).disposingCalled = False Then
+ MsgBox("Error")
+ End If
+ Next
+ Next
+
+ 'Array containing interfaces (element type is VT_VARIANT containing VT_DISPATCH)
+ Dim arArEventListener2(1, 2) As Object
+ For i = 0 To 1
+ For j = 0 To 2
+ arArEventListener2(i, j) = CreateObject("VBasicEventListener.VBEventListener")
+ arArEventListener2(i, j).setQuiet(True)
+ Next
+ Next
+ 'The function calls disposing on the listeners
+ seq = objOleTest.methodXEventListenersMul(arArEventListener2)
+ For i = 0 To 1
+ For j = 0 To 2
+ If arArEventListener2(i, j).disposingCalled = False Then
+ MsgBox("Error")
+ End If
+ Next
+ Next
+
+ ' SAFEARRAY of VARIANTS containing SAFEARRAYs
+ 'The ultimate element type is VT_DISPATCH ( XEventListener)
+ Dim arEventListener4(1) As Object
+ Dim seq1(2) As Object
+ Dim seq2(2) As Object
+ For i = 0 To 2
+ seq1(i) = CreateObject("VBasicEventListener.VBEventListener")
+ seq2(i) = CreateObject("VBasicEventListener.VBEventListener")
+ seq1(i).setQuiet(True)
+ seq2(i).setQuiet(True)
+ Next
+ arEventListener4(0) = VB6.CopyArray(seq1)
+ arEventListener4(1) = VB6.CopyArray(seq2)
+ 'The function calls disposing on the listeners
+ seq = objOleTest.methodXEventListenersMul(arEventListener4)
+ For i = 0 To 2
+ If seq1(i).disposingCalled = False Or seq2(i).disposingCalled = False Then
+ MsgBox("Error")
+ End If
+ Next
+
+ End Function
+
+ Function createHiddenDocument() As Object
+ 'Try to create a hidden document
+ Dim objPropValue As Object
+ objPropValue = objOleTest.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
+ 'Set the members. If this fails then there is an Error
+ objPropValue.Name = "Hidden"
+ objPropValue.Handle = -1
+ objPropValue.Value = True
+
+ 'create a hidden document
+ 'Create the Desktop
+ Dim objDesktop As Object
+ objDesktop = objServiceManager.createInstance("com.sun.star.frame.Desktop")
+ 'Open a new empty writer document
+ Dim args(0) As Object
+ args(0) = objPropValue
+ createHiddenDocument = objDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, args)
+ End Function
+End Module
|