summaryrefslogtreecommitdiff
path: root/extensions/test/ole/VisualBasic/Module1.vb
diff options
context:
space:
mode:
authorMichael Meeks <michael.meeks@suse.com>2012-10-09 12:22:23 +0100
committerMichael Meeks <michael.meeks@suse.com>2012-11-06 11:58:16 +0000
commit44cfc7cb6533d827fd2d6e586d92c61d7d7f7a70 (patch)
treecfca2fb5cd4676d7d55648fe11105753c2178d5d /extensions/test/ole/VisualBasic/Module1.vb
parenteff92f2501cf070cd912508b2ccc3c0108d0327c (diff)
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.
Diffstat (limited to 'extensions/test/ole/VisualBasic/Module1.vb')
-rw-r--r--extensions/test/ole/VisualBasic/Module1.vb166
1 files changed, 92 insertions, 74 deletions
diff --git a/extensions/test/ole/VisualBasic/Module1.vb b/extensions/test/ole/VisualBasic/Module1.vb
index 364af636585f..4295ee64eb28 100644
--- a/extensions/test/ole/VisualBasic/Module1.vb
+++ b/extensions/test/ole/VisualBasic/Module1.vb
@@ -1,7 +1,25 @@
+'
+' 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
@@ -35,7 +53,7 @@ Public Sub Main()
End Sub
Function testProps() As Object
-
+
Dim aToolbarItemProp1 As Object
aToolbarItemProp1 = objOleTest.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
Dim aToolbarItemProp2 As Object
@@ -43,19 +61,19 @@ Public Sub Main()
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
@@ -64,25 +82,25 @@ Public Sub Main()
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
'============================================
@@ -105,8 +123,8 @@ Public Sub Main()
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
@@ -119,7 +137,7 @@ Public Sub Main()
Dim outVarChar As Object
Dim outVarAny As Object
Dim outVarType As Object
-
+
inByte = 10
inBool = True
inShort = -10
@@ -137,7 +155,7 @@ Public Sub Main()
inType = objServiceManager.Bridge_CreateType("[]long")
inXInterface = objCoreReflection
inXInterface2 = objEventListener
-
+
retByte = objOleTest.in_methodByte(inByte)
retBool = objOleTest.in_methodBool(inBool)
retShort = objOleTest.in_methodShort(inShort)
@@ -345,12 +363,12 @@ Public Sub Main()
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)
@@ -380,18 +398,18 @@ Public Sub Main()
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
@@ -404,12 +422,12 @@ Public Sub Main()
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
@@ -425,7 +443,7 @@ Public Sub Main()
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
@@ -434,7 +452,7 @@ Public Sub Main()
If retObj.disposingCalled = False Then
MsgBox("Error")
End If
-
+
' out param gives out the OleTestComponent
'objOleTest.testout_methodXInterface retObj
'outVAr = Null
@@ -443,21 +461,21 @@ Public Sub Main()
'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)
@@ -469,8 +487,8 @@ Public Sub Main()
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")
@@ -481,7 +499,7 @@ Public Sub Main()
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)
@@ -489,8 +507,8 @@ Public Sub Main()
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
@@ -501,14 +519,14 @@ Public Sub Main()
'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()
@@ -518,7 +536,7 @@ Public Sub Main()
MsgBox("Error")
End If
End Function
-
+
Function testGetValueObject() As Object
'Bridge_GetValueObject
'==================================================
@@ -529,13 +547,13 @@ Public Sub Main()
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
@@ -544,7 +562,7 @@ Public Sub Main()
End If
Debug.Print(ret(key))
Next key
-
+
Dim outByte As Byte
outByte = 77
Dim retByte As Byte
@@ -553,14 +571,14 @@ Public Sub Main()
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
@@ -572,9 +590,9 @@ Public Sub Main()
If ret <> inChar Then
MsgBox("error")
End If
-
+
End Function
-
+
Function testArrays() As Object
'Arrays
'========================================
@@ -587,11 +605,11 @@ Public Sub Main()
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
@@ -607,14 +625,14 @@ Public Sub Main()
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
@@ -635,7 +653,7 @@ Public Sub Main()
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
@@ -651,10 +669,10 @@ Public Sub Main()
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
@@ -666,11 +684,11 @@ Public Sub Main()
'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)
@@ -681,7 +699,7 @@ Public Sub Main()
MsgBox("error")
End If
Next key2
-
+
'array with starting index != 0
Dim seqIndex(2) As Integer
Dim seq8() As Object
@@ -699,17 +717,17 @@ Public Sub Main()
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)))
@@ -717,7 +735,7 @@ Public Sub Main()
MsgBox("error")
End If
Next
-
+
'Multidimensional array
'============================================================
' Sequence< Sequence<long> > methodSequence( Sequence< Sequence long> >)
@@ -729,10 +747,10 @@ Public Sub Main()
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
@@ -746,7 +764,7 @@ Public Sub Main()
Next countDim1
Next countDim2
IsArray(resMul)
-
+
'Array of VARIANTs containing arrays
Dim mulAr2(1) As Object
Dim arr2(9) As Integer
@@ -757,7 +775,7 @@ Public Sub Main()
Next j
mulAr2(i) = VB6.CopyArray(arr2)
Next i
-
+
resMul = 0
resMul = objOleTest.methodSequence(mulAr2)
arr = 0
@@ -772,7 +790,7 @@ Public Sub Main()
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
@@ -790,7 +808,7 @@ Public Sub Main()
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
@@ -808,7 +826,7 @@ Public Sub Main()
End If
Next
Next
-
+
' SAFEARRAY of VARIANTS containing SAFEARRAYs
'The ultimate element type is VT_DISPATCH ( XEventListener)
Dim arEventListener4(1) As Object
@@ -829,9 +847,9 @@ Public Sub Main()
MsgBox("Error")
End If
Next
-
+
End Function
-
+
Function createHiddenDocument() As Object
'Try to create a hidden document
Dim objPropValue As Object
@@ -840,7 +858,7 @@ Public Sub Main()
objPropValue.Name = "Hidden"
objPropValue.Handle = -1
objPropValue.Value = True
-
+
'create a hidden document
'Create the Desktop
Dim objDesktop As Object