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