merged tag ooo/OOO330_m14
[LibreOffice.git] / extensions / test / ole / VisualBasic / Module1.vb
blob364af636585f6c9c7d23ce17c4a692694d7cfb1a
1 Option Strict Off
2 Option Explicit On
3 Module Module1
5 Private objServiceManager As Object
6 Private objCoreReflection As Object
7 Private objOleTest As Object
8 Private objEventListener As Object
9 'General counter
10 Dim i As Integer
11 Dim j As Integer
12 Dim sError As String
13 Dim outHyper, inHyper, retHyper As Object
15 Public Sub Main()
16 objServiceManager = CreateObject("com.sun.star.ServiceManager")
17 objCoreReflection = objServiceManager.createInstance("com.sun.star.reflection.CoreReflection")
18 ' extensions/test/ole/cpnt
19 objOleTest = objServiceManager.createInstance("oletest.OleTest")
20 ' extensions/test/ole/EventListenerSample/VBEventListener
21 objEventListener = CreateObject("VBasicEventListener.VBEventListener")
22 Debug.Print(TypeName(objOleTest))
25 testBasics()
26 testHyper()
27 testAny()
28 testObjects()
29 testGetStruct()
30 ''dispose not working i103353
31 'testImplementedInterfaces()
32 testGetValueObject()
33 testArrays()
34 testProps()
36 End Sub
37 Function testProps() As Object
39 Dim aToolbarItemProp1 As Object
40 aToolbarItemProp1 = objOleTest.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
41 Dim aToolbarItemProp2 As Object
42 aToolbarItemProp2 = objOleTest.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
43 Dim aToolbarItemProp3 As Object
44 aToolbarItemProp3 = objOleTest.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
45 Dim properties(2) As Object
47 aToolbarItemProp1.Name = "CommandURL"
48 aToolbarItemProp1.Value = "macro:///standard.module1.TestIt"
49 aToolbarItemProp2.Name = "Label"
50 aToolbarItemProp2.Value = "Test"
51 aToolbarItemProp3.Name = "Type"
52 aToolbarItemProp3.Value = 0
54 properties(0) = aToolbarItemProp1
55 properties(1) = aToolbarItemProp2
56 properties(2) = aToolbarItemProp3
59 Dim dummy(-1) As Object
61 Dim Desktop As Object
62 Desktop = objServiceManager.createInstance("com.sun.star.frame.Desktop")
63 Dim Doc As Object
64 Doc = Desktop.loadComponentFromURL("private:factory/swriter", "_blank", 2, dummy)
65 Dim LayoutManager As Object
66 LayoutManager = Doc.currentController.Frame.LayoutManager
68 LayoutManager.createElement("private:resource/toolbar/user_toolbar1")
69 LayoutManager.showElement("private:resource/toolbar/user_toolbar1")
70 Dim ToolBar As Object
71 ToolBar = LayoutManager.getElement("private:resource/toolbar/user_toolbar1")
72 Dim settings As Object
73 settings = ToolBar.getSettings(True)
75 'the changes are here:
76 Dim aany As Object
77 aany = objServiceManager.Bridge_GetValueObject()
78 Call aany.Set("[]com.sun.star.beans.PropertyValue", properties)
79 Call settings.insertByIndex(0, aany)
80 Call ToolBar.setSettings(settings)
83 End Function
86 Function testBasics() As Object
87 ' In Parameter, simple types
88 '============================================
89 Dim tmpVar As Object
90 Dim ret As Object
91 Dim outByte, inByte, retByte As Byte
92 Dim outBool, inBool, retBool As Boolean
93 Dim outShort, inShort, retShort As Short
94 Dim outUShort, inUShort, retUShort As Short
95 Dim outLong, inLong, retLong As Integer
96 Dim outULong, inULong, retULong As Integer
97 Dim outHyper, inHyper, retHyper As Object
98 Dim outUHyper, inUHyper, retUHyper As Object
99 Dim outFloat, inFloat, retFloat As Single
100 Dim outDouble, inDouble, retDouble As Double
101 Dim outString, inString, retString As String
102 Dim retChar, inChar, outChar, retChar2 As Short
103 Dim outCharAsString, inCharAsString, retCharAsString As String
104 Dim outAny, inAny, retAny As Object
105 Dim outType, inType, retType As Object
106 Dim outXInterface, inXInterface, retXInterface As Object
107 Dim outXInterface2, inXInterface2, retXInterface2 As Object
110 Dim outVarByte As Object
111 Dim outVarBool As Object
112 Dim outVarShort As Object
113 Dim outVarUShort As Object
114 Dim outVarLong As Object
115 Dim outVarULong As Object
116 Dim outVarFloat As Object
117 Dim outVarDouble As Object
118 Dim outVarString As Object
119 Dim outVarChar As Object
120 Dim outVarAny As Object
121 Dim outVarType As Object
123 inByte = 10
124 inBool = True
125 inShort = -10
126 inUShort = -100
127 inLong = -1000
128 inHyper = CDec("-9223372036854775808") 'lowest int64
129 inUHyper = CDec("18446744073709551615") ' highest unsigned int64
130 inULong = 10000
131 inFloat = 3.14
132 inDouble = 3.14
133 inString = "Hello World!"
134 inChar = 65
135 inCharAsString = "A"
136 inAny = "Hello World"
137 inType = objServiceManager.Bridge_CreateType("[]long")
138 inXInterface = objCoreReflection
139 inXInterface2 = objEventListener
141 retByte = objOleTest.in_methodByte(inByte)
142 retBool = objOleTest.in_methodBool(inBool)
143 retShort = objOleTest.in_methodShort(inShort)
144 retUShort = objOleTest.in_methodUShort(inUShort)
145 retLong = objOleTest.in_methodLong(inLong)
146 retULong = objOleTest.in_methodULong(inULong)
147 retHyper = objOleTest.in_methodHyper(inHyper)
148 retUHyper = objOleTest.in_methodUHyper(inUHyper)
149 retFloat = objOleTest.in_methodFloat(inFloat)
150 retDouble = objOleTest.in_methodDouble(inDouble)
151 retString = objOleTest.in_methodString(inString)
152 retChar = objOleTest.in_methodChar(inChar)
153 retChar2 = objOleTest.in_methodChar(inCharAsString)
154 retAny = objOleTest.in_methodAny(inAny)
155 retType = objOleTest.in_methodType(inType)
156 retXInterface = objOleTest.in_methodXInterface(inXInterface) ' UNO object
157 retXInterface2 = objOleTest.in_methodXInterface(inXInterface2)
159 If retByte <> inByte Or retBool <> inBool Or retShort <> inShort Or retUShort <> inUShort _
160 Or retLong <> inLong Or retULong <> inULong Or retHyper <> inHyper _
161 Or retUHyper <> inUHyper Or retFloat <> inFloat Or retDouble <> inDouble _
162 Or retString <> inString Or retChar <> inChar Or retChar2 <> Asc(inCharAsString) _
163 Or retAny <> inAny Or Not (retType.Name = inType.Name) _
164 Or inXInterface IsNot retXInterface Or inXInterface2 IsNot retXInterface2 Then
165 sError = "in - parameter and return value test failed"
166 MsgBox(sError)
168 End If
170 'Out Parameter simple types
171 '================================================
174 objOleTest.testout_methodByte(outByte)
175 objOleTest.testout_methodFloat(outFloat)
176 objOleTest.testout_methodDouble(outDouble)
177 objOleTest.testout_methodBool(outBool)
178 objOleTest.testout_methodShort(outShort)
179 objOleTest.testout_methodUShort(outUShort)
180 objOleTest.testout_methodLong(outLong)
181 objOleTest.testout_methodULong(outULong)
182 objOleTest.testout_methodHyper(outHyper)
183 objOleTest.testout_methodUHyper(outUHyper)
184 objOleTest.testout_methodString(outString)
185 objOleTest.testout_methodChar(outChar)
186 'outCharAsString is a string. Therfore the returned sal_Unicode value of 65 will be converted
187 'to a string "65"
188 objOleTest.testout_methodChar(outCharAsString)
189 objOleTest.testout_methodAny(outAny)
190 objOleTest.testout_methodType(outType)
191 'objOleTest.in_methodXInterface (inXInterface) ' UNO object
192 Call objOleTest.in_methodXInterface(inXInterface) ' UNO object
193 objOleTest.testout_methodXInterface(outXInterface)
194 Call objOleTest.in_methodXInterface(inXInterface2) ' COM object
195 objOleTest.testout_methodXInterface(outXInterface2)
197 If outByte <> inByte Or outFloat <> inFloat Or outDouble <> inDouble _
198 Or outBool <> inBool Or outShort <> inShort Or outUShort <> inUShort _
199 Or outLong <> inLong Or outULong <> inULong Or outHyper <> inHyper _
200 Or outUHyper <> inUHyper Or outString <> inString Or outChar <> inChar _
201 Or Not (outCharAsString = "65") Or outAny <> inAny _
202 Or Not (outType.Name = inType.Name) Or inXInterface IsNot outXInterface _
203 Or inXInterface2 IsNot outXInterface2 Then
205 sError = "out - parameter test failed!"
206 MsgBox(sError)
207 End If
209 'Out Parameter simple types (VARIANT var)
210 '====================================================
211 objOleTest.testout_methodByte(outVarByte)
212 objOleTest.testout_methodBool(outVarBool)
213 objOleTest.testout_methodChar(outVarChar)
214 objOleTest.testout_methodShort(outVarShort)
215 objOleTest.testout_methodUShort(outVarUShort)
216 objOleTest.testout_methodLong(outVarLong)
217 objOleTest.testout_methodULong(outVarULong)
218 objOleTest.testout_methodString(outVarString)
219 objOleTest.testout_methodFloat(outVarFloat)
220 objOleTest.testout_methodDouble(outVarDouble)
221 objOleTest.testout_methodAny(outVarAny)
222 objOleTest.testout_methodType(outVarType)
224 If outVarByte <> inByte Or outVarBool <> inBool Or outVarChar <> inChar _
225 Or outVarShort <> inShort Or outVarUShort <> inUShort _
226 Or outVarLong <> inLong Or outVarULong <> inULong Or outVarString <> inString _
227 Or outVarFloat <> inFloat Or outVarDouble <> inDouble Or outVarAny <> inAny _
228 Or Not (outVarType.Name = inType.Name) Then
229 sError = "out - parameter (VARIANT) test failed!"
230 MsgBox(sError)
231 End If
233 'In/Out simple types
234 '============================================
235 objOleTest.in_methodByte(0)
236 objOleTest.in_methodBool(False)
237 objOleTest.in_methodShort(0)
238 objOleTest.in_methodUShort(0)
239 objOleTest.in_methodLong(0)
240 objOleTest.in_methodULong(0)
241 objOleTest.in_methodHyper(0)
242 objOleTest.in_methodUHyper(0)
243 objOleTest.in_methodFloat(0)
244 objOleTest.in_methodDouble(0)
245 objOleTest.in_methodString(0)
246 objOleTest.in_methodChar(0)
247 objOleTest.in_methodAny(0)
248 objOleTest.in_methodType(objServiceManager.Bridge_CreateType("boolean"))
249 outXInterface = Nothing
250 Call objOleTest.in_methodXInterface(outXInterface)
252 outByte = 10
253 retByte = outByte
254 objOleTest.testinout_methodByte(retByte)
255 objOleTest.testinout_methodByte(retByte)
256 outBool = True
257 retBool = outBool
258 objOleTest.testinout_methodBool(retBool)
259 objOleTest.testinout_methodBool(retBool)
260 outShort = 10
261 retShort = outShort
262 objOleTest.testinout_methodShort(retShort)
263 objOleTest.testinout_methodShort(retShort)
264 outUShort = 20
265 retUShort = outUShort
266 objOleTest.testinout_methodUShort(retUShort)
267 objOleTest.testinout_methodUShort(retUShort)
268 outLong = 30
269 retLong = outLong
270 objOleTest.testinout_methodLong(retLong)
271 objOleTest.testinout_methodLong(retLong)
272 outULong = 40
273 retULong = outULong
274 objOleTest.testinout_methodULong(retLong)
275 objOleTest.testinout_methodULong(retLong)
276 outHyper = CDec("9223372036854775807") 'highest positiv value of int64
277 retHyper = outHyper
278 objOleTest.testinout_methodHyper(retHyper)
279 objOleTest.testinout_methodHyper(retHyper)
280 outUHyper = CDec("18446744073709551615") 'highest value of unsigned int64
281 retUHyper = outUHyper
282 objOleTest.testinout_methodUHyper(retUHyper)
283 objOleTest.testinout_methodUHyper(retUHyper)
284 outFloat = 3.14
285 retFloat = outFloat
286 objOleTest.testinout_methodFloat(retFloat)
287 objOleTest.testinout_methodFloat(retFloat)
288 outDouble = 4.14
289 retDouble = outDouble
290 objOleTest.testinout_methodDouble(retDouble)
291 objOleTest.testinout_methodDouble(retDouble)
292 outString = "Hello World!"
293 retString = outString
294 objOleTest.testinout_methodString(retString)
295 objOleTest.testinout_methodString(retString)
296 outChar = 66
297 retChar = outChar
298 objOleTest.testinout_methodChar(retChar)
299 objOleTest.testinout_methodChar(retChar)
300 outCharAsString = "H"
301 retCharAsString = outCharAsString
302 objOleTest.testinout_methodChar(retCharAsString)
303 objOleTest.testinout_methodChar(retCharAsString)
304 outAny = "Hello World 2!"
305 retAny = outAny
306 objOleTest.testinout_methodAny(retAny)
307 objOleTest.testinout_methodAny(retAny)
308 outType = objServiceManager.Bridge_CreateType("long")
309 retType = outType
310 objOleTest.testinout_methodType(retType)
311 objOleTest.testinout_methodType(retType)
313 outXInterface = objCoreReflection
314 retXInterface = outXInterface
315 objOleTest.testinout_methodXInterface2(retXInterface)
317 If outByte <> retByte Or outBool <> retBool Or outShort <> retShort _
318 Or outUShort <> retUShort Or outLong <> retLong Or outULong <> retULong _
319 Or outHyper <> retHyper Or outUHyper <> outUHyper _
320 Or outFloat <> retFloat Or outDouble <> retDouble _
321 Or outString <> retString Or outChar <> retChar _
322 Or outCharAsString <> retCharAsString _
323 Or outAny <> retAny Or Not (outType.Name = retType.Name) _
324 Or outXInterface IsNot retXInterface Then
325 sError = "in/out - parameter test failed!"
326 MsgBox(sError)
327 End If
329 'Attributes
330 objOleTest.AByte = inByte
331 retByte = 0
332 retByte = objOleTest.AByte
333 objOleTest.AFloat = inFloat
334 retFloat = 0
335 retFloat = objOleTest.AFloat
336 objOleTest.AType = inType
337 retType = Nothing
339 retType = objOleTest.AType
341 If inByte <> retByte Or inFloat <> retFloat Or Not (inType.Name = retType.Name) Then
342 sError = "Attributes - test failed!"
343 MsgBox(sError)
344 End If
346 End Function
347 Function testHyper() As Object
349 '======================================================================
350 ' Other Hyper tests
351 Dim emptyVar As Object
352 Dim retAny As Object
354 retAny = emptyVar
355 inHyper = CDec("9223372036854775807") 'highest positiv value of int64
356 retAny = objOleTest.in_methodAny(inHyper)
357 sError = "hyper test failed"
358 If inHyper <> retAny Then
359 MsgBox(sError)
360 End If
361 inHyper = CDec("-9223372036854775808") 'lowest negativ value of int64
362 retAny = objOleTest.in_methodAny(inHyper)
364 If inHyper <> retAny Then
365 MsgBox(sError)
366 End If
367 inHyper = CDec("18446744073709551615") 'highest positiv value of unsigne int64
368 retAny = objOleTest.in_methodAny(inHyper)
370 If inHyper <> retAny Then
371 MsgBox(sError)
372 End If
373 inHyper = CDec(-1)
374 retAny = objOleTest.in_methodAny(inHyper)
375 If inHyper <> retAny Then
376 MsgBox(sError)
377 End If
378 inHyper = CDec(0)
379 retAny = objOleTest.in_methodAny(inHyper)
380 If inHyper <> retAny Then
381 MsgBox(sError)
382 End If
384 '==============================================================================
387 End Function
388 Function testAny() As Object
389 Dim outVAr As Object
391 'Any test. We pass in an any as value object. If it is not correct converted
392 'then the target component throws a RuntimeException
393 Dim lengthInAny As Integer
395 lengthInAny = 10
396 Dim seqLongInAny(10) As Integer
397 For i = 0 To lengthInAny - 1
398 seqLongInAny(i) = i + 10
399 Next
400 Dim anySeqLong As Object
401 anySeqLong = objOleTest.Bridge_GetValueObject()
402 anySeqLong.Set("[]long", seqLongInAny)
403 Dim anySeqRet As Object
404 Err.Clear()
405 On Error Resume Next
406 anySeqRet = objOleTest.other_methodAny(anySeqLong, "[]long")
408 If Err.Number <> 0 Then
409 MsgBox("error")
410 End If
411 End Function
413 Function testObjects() As Object
414 ' COM obj
415 Dim outVAr As Object
416 Dim retObj As Object
417 'OleTest receives a COM object that implements XEventListener
418 'OleTest then calls a disposing on the object. The object then will be
419 'asked if it has been called
420 objEventListener.setQuiet(True)
421 objEventListener.resetDisposing()
422 retObj = objOleTest.in_methodInvocation(objEventListener)
423 Dim ret As Object
424 ret = objEventListener.disposingCalled
425 If ret = False Then
426 MsgBox("Error")
427 End If
429 'The returned object should be objEventListener, test it by calling disposing
430 ' takes an IDispatch as Param ( EventObject).To provide a TypeMismatch
431 'we put in another IDispatch
432 retObj.resetDisposing()
433 retObj.disposing(objEventListener)
434 If retObj.disposingCalled = False Then
435 MsgBox("Error")
436 End If
438 ' out param gives out the OleTestComponent
439 'objOleTest.testout_methodXInterface retObj
440 'outVAr = Null
441 'retObj.testout_methodAny outVAr
442 'Debug.Print "test out Interface " & CStr(outVAr)
443 'If outVAr <> "I am a string in an any" Then
444 ' MsgBox "error"
445 'End If
448 'in out
449 ' in: UNO object, the same is expected as out param
450 ' the function expects OleTest as parameter and sets a value
452 Dim myAny As Object
456 Dim objOleTest2 As Object
457 objOleTest2 = objServiceManager.createInstance("oletest.OleTest")
458 'Set a value
459 objOleTest2.AttrAny2 = "VBString "
461 'testinout_methodXInterfaces substitutes the argument with the object set in in_methodXInterface
462 objOleTest.AttrAny2 = "VBString this string was written in the UNO component to the inout pararmeter"
463 objOleTest.in_methodXInterface(objOleTest)
464 objOleTest.testinout_methodXInterface2(objOleTest2)
465 Dim tmpVar As Object
466 tmpVar = System.DBNull.Value
467 tmpVar = objOleTest2.AttrAny2
468 Debug.Print("in: Uno out: the same object // " & CStr(tmpVar))
469 If tmpVar <> "VBString this string was written in the UNO component to the inout pararmeter" Then
470 MsgBox("error")
471 End If
474 'create a struct
475 Dim structClass As Object
476 structClass = objCoreReflection.forName("oletest.SimpleStruct")
477 Dim structInstance As Object
478 structClass.CreateObject(structInstance)
479 structInstance.message = "Now we are in VB"
480 Debug.Print("struct out " & structInstance.message)
481 If structInstance.message <> "Now we are in VB" Then
482 MsgBox("error")
483 End If
485 'put the struct into OleTest. The same struct will be returned with an added String
486 Dim structRet As Object
487 structRet = objOleTest.in_methodStruct(structInstance)
488 Debug.Print("struct in - return " & structRet.message)
489 If structRet.message <> "Now we are in VBThis string was set in OleTest" Then
490 MsgBox("error")
491 End If
494 End Function
495 Function testGetStruct() As Object
496 'Bridge_GetStruct
497 '========================================================
498 Dim objDocument As Object
499 objDocument = createHiddenDocument()
500 'dispose not working i103353
501 'objDocument.dispose()
502 objDocument.close(True)
503 End Function
505 Function testImplementedInterfaces() As Object
506 'Bridge_ImplementedInterfaces
507 '=================================================
508 ' call an UNO function that takes an XEventListener interface
509 'We provide a COM implementation (IDispatch) as EventListener
510 'Open a new empty writer document
512 Dim objDocument As Object
513 objDocument = createHiddenDocument()
514 objEventListener.resetDisposing()
515 objDocument.addEventListener(objEventListener)
516 objDocument.dispose()
517 If objEventListener.disposingCalled = False Then
518 MsgBox("Error")
519 End If
520 End Function
522 Function testGetValueObject() As Object
523 'Bridge_GetValueObject
524 '==================================================
525 Dim objVal As Object
526 objVal = objOleTest.Bridge_GetValueObject()
527 Dim arrByte(9) As Byte
528 Dim countvar As Integer
529 For countvar = 0 To 9
530 arrByte(countvar) = countvar
531 Next countvar
533 objVal.Set("[]byte", arrByte)
534 Dim ret As Object
535 ret = 0
536 ret = objOleTest.methodByte(objVal)
537 'Test if ret is the same array
539 Dim key As Object
540 key = 0
541 For Each key In ret
542 If ret(key) <> arrByte(key) Then
543 MsgBox("Error")
544 End If
545 Debug.Print(ret(key))
546 Next key
548 Dim outByte As Byte
549 outByte = 77
550 Dim retByte As Byte
551 retByte = outByte
552 objVal.InitInOutParam("byte", retByte)
553 objOleTest.testinout_methodByte(objVal)
554 objVal.InitInOutParam("byte", retByte)
555 objOleTest.testinout_methodByte(objVal)
557 ret = 0
558 ret = objVal.Get()
559 Debug.Print(ret)
560 If ret <> outByte Then
561 MsgBox("error")
562 End If
564 objVal.InitOutParam()
565 Dim inChar As Short
566 inChar = 65
567 objOleTest.in_methodChar(inChar)
568 objOleTest.testout_methodChar(objVal) 'Returns 'A' (65)
569 ret = 0
570 ret = objVal.Get()
571 Debug.Print(ret)
572 If ret <> inChar Then
573 MsgBox("error")
574 End If
576 End Function
578 Function testArrays() As Object
579 'Arrays
580 '========================================
581 Dim arrLong(2) As Integer
582 Dim arrObj(2) As Object
583 Dim countvar As Integer
584 For countvar = 0 To 2
585 arrLong(countvar) = countvar + 10
586 Debug.Print(countvar)
587 arrObj(countvar) = CreateObject("VBasicEventListener.VBEventListener")
588 arrObj(countvar).setQuiet(True)
589 Next
591 'Arrays always contain VARIANTS
592 Dim seq() As Object
593 seq = objOleTest.methodLong(arrLong)
595 For countvar = 0 To 2
596 Debug.Print(CStr(seq(countvar)))
597 If arrLong(countvar) <> seq(countvar) Then
598 MsgBox("error")
599 End If
600 Next
601 seq = objOleTest.methodXInterface(arrObj)
602 Dim tmp As Object
603 For countvar = 0 To 2
604 seq(countvar).resetDisposing()
605 seq(countvar).disposing(CObj(tmp))
606 If seq(countvar).disposingCalled = False Then
607 MsgBox("Error")
608 End If
609 Next
611 'Array containing interfaces (element type is VT_DISPATCH)
612 Dim arEventListener(2) As Object
613 For countvar = 0 To 2
614 arEventListener(countvar) = CreateObject("VBasicEventListener.VBEventListener")
615 arEventListener(countvar).setQuiet(True)
616 Next
618 'The function calls disposing on the listeners
619 seq = objOleTest.methodXEventListeners(arEventListener)
620 Dim count As Object
621 For countvar = 0 To 2
622 If arEventListener(countvar).disposingCalled = False Then
623 MsgBox("Error")
624 End If
625 Next
626 'Array containing interfaces (element type is VT_VARIANT which contains VT_DISPATCH
627 Dim arEventListener2(2) As Object
628 For countvar = 0 To 2
629 arEventListener2(countvar) = CreateObject("VBasicEventListener.VBEventListener")
630 arEventListener2(countvar).setQuiet(True)
631 Next
632 seq = objOleTest.methodXEventListeners(arEventListener2)
633 For countvar = 0 To 2
634 If arEventListener2(countvar).disposingCalled = False Then
635 MsgBox("Error")
636 End If
637 Next
639 'Variant containing Array containing interfaces (element type is VT_VARIANT which contains VT_DISPATCH
640 Dim arEventListener3(2) As Object
641 Dim var As Object
642 For countvar = 0 To 2
643 arEventListener3(countvar) = CreateObject("VBasicEventListener.VBEventListener")
644 arEventListener3(countvar).setQuiet(True)
645 Next
646 Dim varContAr As Object
647 varContAr = VB6.CopyArray(arEventListener3)
648 seq = objOleTest.methodXEventListeners(varContAr)
649 For countvar = 0 To 2
650 If arEventListener3(countvar).disposingCalled = False Then
651 MsgBox("Error")
652 End If
653 Next
655 'Get a sequence created in UNO, out param is Variant ( VT_BYREF|VT_VARIANT)
656 Dim seqX As Object
658 objOleTest.testout_methodSequence(seqX)
659 Dim key As Object
660 For Each key In seqX
661 Debug.Print(CStr(seqX(key)))
662 If seqX(key) <> key Then
663 MsgBox("error")
664 End If
665 Next key
666 'Get a sequence created in UNO, out param is array Variant ( VT_BYREF|VT_VARIANT|VT_ARRAY)
667 Dim seqX2() As Object
668 objOleTest.testout_methodSequence(seqX2)
670 For Each key In seqX2
671 Debug.Print(CStr(seqX2(key)))
672 Next key
674 'pass it to UNO and get it back
675 Dim seq7() As Object
676 seq7 = objOleTest.methodLong(seqX)
677 Dim key2 As Object
678 For Each key2 In seq7
679 Debug.Print(CStr(seq7(key2)))
680 If seqX2(key) <> key Then
681 MsgBox("error")
682 End If
683 Next key2
685 'array with starting index != 0
686 Dim seqIndex(2) As Integer
687 Dim seq8() As Object
688 Dim longVal1, longVal2 As Integer
689 longVal1 = 1
690 longVal2 = 2
691 seqIndex(1) = longVal1
692 seqIndex(2) = longVal2
693 'The bridge returns a Safearray of Variants. It does not yet convert to an _
694 'array of a particular type!
695 'Comparing of elements from seq8 (Object) with long values worked without _
696 'explicit cast as is necessary in VS 2008. Also arrays in VS 2008 start at _
697 'index 0
698 seq8 = objOleTest.methodLong(seqIndex)
699 If longVal1 <> CInt(seq8(1)) And longVal2 <> CInt(seq8(2)) Then
700 MsgBox("error")
701 End If
703 'in out Array
704 ' arrLong is Long Array
705 Dim inoutVar(2) As Object
707 For countvar = 0 To 2
708 inoutVar(countvar) = countvar + 10
709 Next
711 objOleTest.testinout_methodSequence(inoutVar)
713 countvar = 0
714 For countvar = 0 To 2
715 Debug.Print(CStr(inoutVar(countvar)))
716 If inoutVar(countvar) <> countvar + 11 Then
717 MsgBox("error")
718 End If
719 Next
721 'Multidimensional array
722 '============================================================
723 ' Sequence< Sequence<long> > methodSequence( Sequence< Sequence long> >)
724 ' Real multidimensional array Array
725 ' 9 is Dim 1 (least significant) with C API
726 Dim mulAr(9, 1) As Integer
727 For i = 0 To 1
728 For j = 0 To 9
729 mulAr(j, i) = i * 10 + j
730 Next j
731 Next i
733 Dim resMul As Object
734 resMul = objOleTest.methodSequence(mulAr)
736 Dim countDim1 As Integer
737 Dim countDim2 As Integer
738 Dim arr As Object
739 For countDim2 = 0 To 1
740 arr = resMul(countDim2)
741 For countDim1 = 0 To 9
742 Debug.Print(arr(countDim1))
743 If arr(countDim1) <> mulAr(countDim1, countDim2) Then
744 MsgBox("Error Multidimensional Array")
745 End If
746 Next countDim1
747 Next countDim2
748 IsArray(resMul)
750 'Array of VARIANTs containing arrays
751 Dim mulAr2(1) As Object
752 Dim arr2(9) As Integer
753 For i = 0 To 1
754 ' Dim arr(9) As Long
755 For j = 0 To 9
756 arr2(j) = i * 10 + j
757 Next j
758 mulAr2(i) = VB6.CopyArray(arr2)
759 Next i
761 resMul = 0
762 resMul = objOleTest.methodSequence(mulAr2)
763 arr = 0
764 Dim tmpVar As Object
765 For countDim2 = 0 To 1
766 arr = resMul(countDim2)
767 tmpVar = mulAr2(countDim2)
768 For countDim1 = 0 To 9
769 Debug.Print(arr(countDim1))
770 If arr(countDim1) <> tmpVar(countDim1) Then
771 MsgBox("Error Multidimensional Array")
772 End If
773 Next countDim1
774 Next countDim2
776 'Array containing interfaces (element type is VT_DISPATCH)
777 Dim arArEventListener(1, 2) As Object
778 For i = 0 To 1
779 For j = 0 To 2
780 arArEventListener(i, j) = CreateObject("VBasicEventListener.VBEventListener")
781 arArEventListener(i, j).setQuiet(True)
782 Next
783 Next
784 'The function calls disposing on the listeners
785 seq = objOleTest.methodXEventListenersMul(arArEventListener)
786 For i = 0 To 1
787 For j = 0 To 2
788 If arArEventListener(i, j).disposingCalled = False Then
789 MsgBox("Error")
790 End If
791 Next
792 Next
794 'Array containing interfaces (element type is VT_VARIANT containing VT_DISPATCH)
795 Dim arArEventListener2(1, 2) As Object
796 For i = 0 To 1
797 For j = 0 To 2
798 arArEventListener2(i, j) = CreateObject("VBasicEventListener.VBEventListener")
799 arArEventListener2(i, j).setQuiet(True)
800 Next
801 Next
802 'The function calls disposing on the listeners
803 seq = objOleTest.methodXEventListenersMul(arArEventListener2)
804 For i = 0 To 1
805 For j = 0 To 2
806 If arArEventListener2(i, j).disposingCalled = False Then
807 MsgBox("Error")
808 End If
809 Next
810 Next
812 ' SAFEARRAY of VARIANTS containing SAFEARRAYs
813 'The ultimate element type is VT_DISPATCH ( XEventListener)
814 Dim arEventListener4(1) As Object
815 Dim seq1(2) As Object
816 Dim seq2(2) As Object
817 For i = 0 To 2
818 seq1(i) = CreateObject("VBasicEventListener.VBEventListener")
819 seq2(i) = CreateObject("VBasicEventListener.VBEventListener")
820 seq1(i).setQuiet(True)
821 seq2(i).setQuiet(True)
822 Next
823 arEventListener4(0) = VB6.CopyArray(seq1)
824 arEventListener4(1) = VB6.CopyArray(seq2)
825 'The function calls disposing on the listeners
826 seq = objOleTest.methodXEventListenersMul(arEventListener4)
827 For i = 0 To 2
828 If seq1(i).disposingCalled = False Or seq2(i).disposingCalled = False Then
829 MsgBox("Error")
830 End If
831 Next
833 End Function
835 Function createHiddenDocument() As Object
836 'Try to create a hidden document
837 Dim objPropValue As Object
838 objPropValue = objOleTest.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
839 'Set the members. If this fails then there is an Error
840 objPropValue.Name = "Hidden"
841 objPropValue.Handle = -1
842 objPropValue.Value = True
844 'create a hidden document
845 'Create the Desktop
846 Dim objDesktop As Object
847 objDesktop = objServiceManager.createInstance("com.sun.star.frame.Desktop")
848 'Open a new empty writer document
849 Dim args(0) As Object
850 args(0) = objPropValue
851 createHiddenDocument = objDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, args)
852 End Function
853 End Module