diff options
Diffstat (limited to 'extensions/test/ole/VisualBasic/Module1.vb')
| -rw-r--r-- | extensions/test/ole/VisualBasic/Module1.vb | 853 |
1 files changed, 0 insertions, 853 deletions
diff --git a/extensions/test/ole/VisualBasic/Module1.vb b/extensions/test/ole/VisualBasic/Module1.vb deleted file mode 100644 index 364af6365..000000000 --- a/extensions/test/ole/VisualBasic/Module1.vb +++ /dev/null @@ -1,853 +0,0 @@ -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
|