Files
loongoffice/extensions/test/ole/VisualBasic/Module1.vb
Michael Meeks 44cfc7cb65 re-base on ALv2 code. Includes (at least) relevant parts of:
linecap: Reintegrating finished LineCap feature
    Patch contributed by Regina Henschel
    http://svn.apache.org/viewvc?view=revision&revision=1232507

    Patches contributed by Sven Jacobi
    impress212: #i81610# fixed animation export
    http://svn.apache.org/viewvc?view=revision&revision=1167620
    impress212: drawinglayer gbuild environment changes
    http://svn.apache.org/viewvc?view=revision&revision=1167627
    http://svn.apache.org/viewvc?view=revision&revision=1167628
    impress212: DffPropSet -> minor code improvements, removing table
    http://svn.apache.org/viewvc?view=revision&revision=1167634
    impress212: #158494# fixed excel import (text rotation)
    http://svn.apache.org/viewvc?view=revision&revision=1167638

    Patches contributed by Armin Le Grand
    Svg: Reintegrated Svg replacement from /branches/alg/svgreplavement
    http://svn.apache.org/viewvc?view=revision&revision=1220836
    #118728# changed indentifying definitions for Svg file detection
    http://svn.apache.org/viewvc?view=revision&revision=1229961
    #118838# LineGeometry creation for complicated cases optimized to
	create single Polygons
    http://svn.apache.org/viewvc?view=revision&revision=1236232
    #119176# corrected file type detection for SVG for svg files
	without xml header
    http://svn.apache.org/viewvc?view=revision&revision=1309445
    #118728# Extended Svg file detection
    http://svn.apache.org/viewvc?view=revision&revision=1230531
    #118529# solve break converters and convert commands for OLEs and images
    http://svn.apache.org/viewvc?view=revision&revision=1186168
    svg: added WaE changes from branch svgreplacement to trunc
    http://svn.apache.org/viewvc?view=revision&revision=1222974
    svg: corrected missing member initialization
    http://svn.apache.org/viewvc?view=revision&revision=1226134
    fix for #118525#: Using primitives for chart sub-geometry visualisation
    http://svn.apache.org/viewvc?view=revision&revision=1226879
    #118898# Adapted ImpGraphic::ImplGetBitmap to correctly convert
	metafiles to bitmapEx ...
    http://svn.apache.org/viewvc?view=revision&revision=1293316
    fix for #118525#: removed no longer used variable maOriginalMapMode, one
    more exception eliminated
    http://svn.apache.org/viewvc?view=revision&revision=1227097
    #16758# Added buffering to the VDev usages of the VclProcessor2D derivates...
    http://svn.apache.org/viewvc?view=revision&revision=1229521
    #116758# Secured VDev buffer device to Vcl deinit
    http://svn.apache.org/viewvc?view=revision&revision=1230574
    #116758# added remembering allocated VDevs for VDevBuffer to be able to also
    delete these when vcl goes down; it should never happen, but You never know
    http://svn.apache.org/viewvc?view=revision&revision=1230927
    #118730# Changed SvgClipPathNode to use MaskPrimitive2D for primitive
	representation instead of TransparencePrimitive2D
    http://svn.apache.org/viewvc?view=revision&revision=1231198
    #118822# secured 3D geometry creation (slices) by subdividing the 2D
    source polyPolygon early
    http://svn.apache.org/viewvc?view=revision&revision=1234749
    #118829# enhanced Svg gradient quality, obstacles avoided
    http://svn.apache.org/viewvc?view=revision&revision=1235361
    #118834# Unified usage of TextBreakupHelper as single tooling class
    for i18n text primitive breakup
    http://svn.apache.org/viewvc?view=revision&revision=1236110
    #118853# added square pixel size limit to conversion of
    TransparencePrimitive2D to Metafile action
    http://svn.apache.org/viewvc?view=revision&revision=1237656
    #118824# coreccted mirroring and boundrect when the graphicmanager
    is used for bitmap output
    http://svn.apache.org/viewvc?view=revision&revision=1240097
    #115092# Corrected VclProcessor2D::RenderPolygonStrokePrimitive2D for
    various optimization scenarios
    http://svn.apache.org/viewvc?view=revision&revision=1241434
    #118783# Corrected errors in ID strings, corrected Svg line/fill export,
    corrected polygon close state
    http://svn.apache.org/viewvc?view=revision&revision=1232006
    #118796# corrected null-pointer usage in SVG text exporter
    http://svn.apache.org/viewvc?view=revision&revision=1240262
    #118729# Use GraphicStreamUrl and GraphicUrl to allow multi image
    import with linked graphics, too
    http://svn.apache.org/viewvc?view=revision&revision=1229962
    #118898# corrected error in GDIMetaFile::GetBoundRect in handling
    MetaFloatTransparentAction
    http://svn.apache.org/viewvc?view=revision&revision=1293349
    #118855# Corrected handling of possibly created empty clipRegions
    after PolyPolygon clipping
    http://svn.apache.org/viewvc?view=revision&revision=1237725
	#115962# Better (but not yet optimal, see comments in task) handling
	of MetaFloatTransparentAction in PDF export
	http://svn.apache.org/viewvc?view=revision&revision=1241078
    IP clearance: #118466# This patch removes librsvg, libcroco, libgsf, ...
    http://svn.apache.org/viewvc?view=revision&revision=1200879
    118779# Added svg content streaming in/out to ImpGraphic stream operators
    http://svn.apache.org/viewvc?view=revision&revision=1231908
    linecap: correctons for WaE and mac drawing
    http://svn.apache.org/viewvc?view=revision&revision=1232793
    svg: uses current system Dpi for Svg replacement image creation
    http://svn.apache.org/viewvc?view=revision&revision=1233948

    Patches contributed by Mathias Bauer (and others)
    gnumake4 work variously
    http://svn.apache.org/viewvc?view=revision&revision=1394326
    http://svn.apache.org/viewvc?view=revision&revision=1396797
    http://svn.apache.org/viewvc?view=revision&revision=1397315
    http://svn.apache.org/viewvc?view=revision&revision=1394326
    Remove duplicate header includes.
    cws mba34issues01: #i117720#: convert assertion into warning
    http://svn.apache.org/viewvc?view=revision&revision=1172352
    118485 - Styles for OLEs are not saved. Submitted by Armin Le Grand.
    http://svn.apache.org/viewvc?view=revision&revision=1182166
    cws mba34issues01: #i117714#: remove assertion
    http://svn.apache.org/viewvc?view=revision&revision=1172357

    Patch contributed by Jurgen Schmidt
    add some additional checks to ensure proper reading operations
    http://svn.apache.org/viewvc?view=revision&revision=1209022
    mostly prefer our stream / bounds checking work.

    Patches contributed by Herbert Duerr
    #i118816# add clarifying comment regarding Font::*Color*() methods
    http://svn.apache.org/viewvc?view=revision&revision=1233833
    extend macro->string handling for empty strings
    http://svn.apache.org/viewvc?view=revision&revision=1175801
    avoid magic constants for SALCOLOR_NONE
    http://svn.apache.org/viewvc?view=revision&revision=1177543
    initialize slant properly in ImplFontMetricData constructor (author=iorsh)
    http://svn.apache.org/viewvc?view=revision&revision=1177551
    #i118675# make check for extension updates more stable
    http://svn.apache.org/viewvc?view=revision&revision=1214797
    #a118617# remove VBasicEventListener.dll binary
    There are no known users depending on its CLSID
    http://svn.apache.org/viewvc?view=revision&revision=1203697

    Patches contributed by Ariel Constenla-Haile
    Fix build breaker on Linux/gcc
    http://svn.apache.org/viewvc?view=revision&revision=1221104
    Fix crash when trying to instantiate css.graphic.GraphicRasterizer_RSVG
    http://svn.apache.org/viewvc?view=revision&revision=1215559

    Patches contributed by Oliver-Rainer Wittmann
    sw34bf06: #i117962# - method <SwFlyFrm::IsPaint(..)> - consider
    instances of <SwFlyDrawObj>
    http://svn.apache.org/viewvc?view=revision&revision=1172120
    sw34bf06: #i117783# - Writer's implementation of XPagePrintable -
    apply print settings to new printing routines
    http://svn.apache.org/viewvc?view=revision&revision=1172115

    gnumake4 work variously from Hans-Joachim Lankenau
    http://svn.apache.org/viewvc?view=revision&revision=1397315
    http://svn.apache.org/viewvc?view=revision&revision=1396797
    http://svn.apache.org/viewvc?view=revision&revision=1396782
    http://svn.apache.org/viewvc?view=revision&revision=1394707
    plus some amount of re-splitting of legacy headers.

    Patch contributed by Pavel Janik
    WaE: Remove unused variables.
    http://svn.apache.org/viewvc?view=revision&revision=1230697

    Patches contributed by Takashi Ono
    mingwport35: i#117795: MinGW port fix for vcl2gnumake
    http://svn.apache.org/viewvc?view=revision&revision=1172091
    mingwport35: i#117795: MinGW port fix for vcl2gnumake
    http://svn.apache.org/viewvc?view=revision&revision=1172091

    Patch contributed by Christian Lippka
    impress212: #i98044# re enable Text menu for outline and title shapes
    http://svn.apache.org/viewvc?view=revision&revision=1167639

    Patch contributed by Andre Fischer
    118674: Made category B code optional and disabled by default.
    http://svn.apache.org/viewvc?view=revision&revision=1215131
    118881: Ignore empty paragraphs after bullets.
    http://svn.apache.org/viewvc?view=revision&revision=1296205

    Patches contributed by Philipp Lohmann
    ooo340fixes: #i117780# use rtl allocator
    http://svn.apache.org/viewvc?view=revision&revision=1172087
    ooo34gsl02: #i117807# fix an off by one error (index actually
    inside the pfb section header)
    http://svn.apache.org/viewvc?view=revision&revision=1167576

various cleanups, related compilation fixes, warning cleanups, re-working
of obsolete stl template pieces to use boost instead, changed string
classes, re-adapt KDE about data, about dialog, fixing warnings,
and other fixes & improvements.
Disable svg import / render for about/ branding code-paths for now.
Restore full icon theme set.
Remove OS/2 conditionals and sources.
Remove conflicting gtk/full-screen monitors support.
Retain existing svg rasterizer files - temporarily disabled.
Standardize stringificaiton and fixup dllpostfix issues.
Rename SvgGradientHelper::== to equalTo to avoid overloading issues.
Use the flat GdiPlus API for LineCaps calls.
2012-11-06 11:58:16 +00:00

872 lines
30 KiB
VB.net

'
' This file is part of the LibreOffice project.
'
' This Source Code Form is subject to the terms of the Mozilla Public
' License, v. 2.0. If a copy of the MPL was not distributed with this
' file, You can obtain one at http://mozilla.org/MPL/2.0/.
'
' This file incorporates work covered by the following license notice:
'
' Licensed to the Apache Software Foundation (ASF) under one or more
' contributor license agreements. See the NOTICE file distributed
' with this work for additional information regarding copyright
' ownership. The ASF licenses this file to you under the Apache
' License, Version 2.0 (the "License"); you may not use this file
' except in compliance with the License. You may obtain a copy of
' the License at http://www.apache.org/licenses/LICENSE-2.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