1<?xml version="1.0" encoding="UTF-8"?> 2<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> 3<script:module xmlns:script="http://openoffice.org/2000/script" script:name="beans_XMultiPropertySet" script:language="StarBasic"> 4 5 6'************************************************************************* 7' 8' DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. 9' 10' Copyright 2000, 2010 Oracle and/or its affiliates. 11' 12' OpenOffice.org - a multi-platform office productivity suite 13' 14' This file is part of OpenOffice.org. 15' 16' OpenOffice.org is free software: you can redistribute it and/or modify 17' it under the terms of the GNU Lesser General Public License version 3 18' only, as published by the Free Software Foundation. 19' 20' OpenOffice.org is distributed in the hope that it will be useful, 21' but WITHOUT ANY WARRANTY; without even the implied warranty of 22' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 23' GNU Lesser General Public License version 3 for more details 24' (a copy is included in the LICENSE file that accompanied this code). 25' 26' You should have received a copy of the GNU Lesser General Public License 27' version 3 along with OpenOffice.org. If not, see 28' <http://www.openoffice.org/license.html> 29' for a copy of the LGPLv3 License. 30' 31'************************************************************************* 32***** 33'************************************************************************* 34 35 36 37' Be sure that all variables are dimensioned: 38option explicit 39 40 41Dim nCB1Val As Integer, nCB2Val As Integer 42 43 44Sub RunTest() 45 46'************************************************************************* 47' INTERFACE: 48' com.sun.star.beans.XMultiPropertySet 49'************************************************************************* 50On Error Goto ErrHndl 51 Dim bOK As Boolean 52 Dim oPropertySetInfo As Object 53 Dim oProperties As Variant 54 Dim aProp(0 to 1) As new com.sun.star.beans.PropertyValue 55 Dim cType As String 56 Dim oListener1 As Object, oListener2 As Object 57 Dim n As Integer, nMem As Integer, nIndex As Integer 58 Dim m As Integer 59 Dim bFound As Boolean 60 Dim nCount As Integer 61 Dim bBoolean As Boolean 62 Dim nInteger As Integer 63 Dim nLong As Long 64 Dim nSingle As Single 65 Dim nDouble As Double 66 Dim vMemVal As Variant 67 Dim nCB1ValMem As Integer 68 Dim nCB2ValMem As Integer 69 70 bOK = true 71 bFound = false 72 nCB1Val = 0 73 nCB2Val = 0 74 m = 0 75 oPropertySetInfo = oObj.GetPropertySetInfo 76 oProperties = oPropertySetInfo.Properties 77 nCount = uBound(oProperties) 78 Out.Log("The Object has " + nCount + " properties" 79 80 Out.Log("Create linsteners...") 81 oListener1 = createUNOListener("CB1_","com.sun.star.beans.XPropertiesChangeListener") 82 oListener2 = createUNOListener("CB2_","com.sun.star.beans.XPropertiesChangeListener") 83 Out.Log("oListener1 and oListener2 created" 84 85 'create sequences of Propertie-Names and Values 86 'fist get the amount of valid properties 87 for n = 0 to (nCount) 88 'look for readonly-properties 89 If (oProperties(n).Attributes AND com.sun.star.beans.PropertyAttribute.READONLY) = 0 Then 90 'look for MAYBEVOID-Properties 91 If (oProperties(n).Attributes AND com.sun.star.beans.PropertyAttribute.MAYBEVOID) = 0 Then 92 'is the Property testable 93 m = m + 1 94 End If 95 End If 96 next n 97 98 Out.Log("Amount of testable properites (without readonly and MAYBEVOID) is " + m) 99 100 'now store the names in sProperites 101 Dim searchProperties(0 to m-1) As String 102 m = 0 103 for n = 0 to (nCount) 104 'kick off readonly-properties 105 If (oProperties(n).Attributes AND com.sun.star.beans.PropertyAttribute.READONLY) = 0 Then 106 'kick off MYBEVOID-Properties 107 If (oProperties(n).Attributes AND com.sun.star.beans.PropertyAttribute.MAYBEVOID) = 0 Then 108 searchProperties(m) = oProperties(n).Name 109 Out.Log("" + m + " " + searchProperties(m) + " " + oObj.getPropertySetInfo.getPropertyByName(searchProperties(m)).Type.Name + " " + n) 110 Dim pVal As Variant 111 112 pVal = oObj.getPropertyValue(searchProperties(m)) 113 oObj.setPropertyValues(Array(searchProperties(m)), Array(pVal)) 114 m = m + 1 115 End If 116 End If 117 next n 118 nCount = m - 1 119 120 Dim sProperties(0 to nCount) As String 121 Dim vValues(0 to nCount) As Variant 122 For n = 0 to nCount 123 sProperties(n) = searchProperties(n) 124 next n 125 126 vValues() = oObj.getPropertyValues(sProperties()) 127 128 'add ChangeListener 129 oObj.addPropertiesChangeListener(sProperties(),oListener1) 130 oObj.addPropertiesChangeListener(sProperties(),oListener2) 131 Out.Log("oListener1 and oListener2 added to object") 132 133 nIndex = 0 134 nMem = nIndex 135 'find at first a Boolean Value, if not available a String Property 136 While (NOT bFound) AND ((nCount >= nIndex)) 137 'get the property-type 138 cType = oObj.getPropertySetInfo.getPropertyByName(sProperties(nIndex)).Type.Name 139 If cType = "boolean" Then ' it is a Boolean Proerty 140 bFound = true 141 nMem = nIndex 142 else 143 If cType = "string" Then ' it is a String Property 144 nMem = nIndex 145 end if 146 end if 147 nIndex = nIndex + 1 148 Wend 149 150 nIndex = nIndex - 1 151 Out.Log("Property to change is: """ + sProperties(nIndex) + """ Type: """ + oObj.getPropertySetInfo.getPropertyByName(sProperties(nIndex)).Type.Name + """") 152 nIndex = nMem 153 154 'memory the old Value 155 vMemVal = vValues(nIndex) 156 157 'change a value of a property, hopefully a boolean or string property 158 select case VarType(vValues(nIndex) 159 case 11 'boolean 160 bBoolean = NOT vValues(nIndex) 161 vValues(nIndex) = bBoolean 162 case 2 'integer 163 nInteger = vValues(nIndex) + 1 164 vValues(nIndex) = nInteger 165 case 3 'long 166 nLong = vValues(nIndex) + 1 167 vValues(nIndex) = nLong 168 case 4 'single 169 nSingle = vValues(nIndex) + 1 170 vValues(nIndex) = nSingle 171 case 5 'double 172 nDouble = vValues(nIndex) + 1 173 vValues(nIndex) = nDouble 174 case 8 'string 175 vValues(nIndex) = vValues(nIndex) + cIfcShortName 176 end select 177 178 Test.StartMethod("getPropertySetInfo()") 179 bOK = bOK AND (uBound(oProperties) > 0) 180 Test.MethodTested("getPropertySetInfo()", bOK) 181 182 Test.StartMethod("getPropertyValues()") 183 bOK = bOK AND (uBound(vValues()) > 0) 184 Test.MethodTested("getPropertyValues()", bOK) 185 186 Test.StartMethod("setPropertyValues()") 187 oObj.setPropertyValues(sProperties(), vValues()) 188 vValues() = oObj.getPropertyValues(sProperties()) 189 bOK = bOK AND (vValues(nIndex) <> vMemVal) 190 Test.MethodTested("setPropertyValues()", bOK) 191 192 Test.StartMethod("addPropertiesChangeListener()") 193 bOK = (nCB1Val >= 1) AND (nCB2Val >= 1) 194 nCB1ValMem = nCB1Val 195 nCB2ValMem = nCb2Val 196 Test.MethodTested("addPropertiesChangeListener()", bOK) 197 198 'fire !!! 199 Out.Log("Try to fire property change event...") 200 oObj.firePropertiesChangeEvent(sProperties(),oListener1) 201 oObj.firePropertiesChangeEvent(sProperties(),oListener2) 202 203 Test.StartMethod("firePropertiesChangeEvent()") 204 bOK = (nCB1Val >= nCB1ValMem) AND (nCB2Val >= nCB2ValMem) 205 Test.MethodTested("firePropertiesChangeEvent()", bOK) 206 nCB1ValMem = nCB1Val 207 nCB2ValMem = nCb2Val 208 209 210 'remove one Listener and fire 211 Test.StartMethod("removePropertiesChangeListener()") 212 oObj.removePropertiesChangeListener(oListener1) 213 Out.Log("oListener1 removed") 214 select case VarType(vValues(nIndex) 215 case 11 'boolean 216 bBoolean = NOT vValues(nIndex) 217 vValues(nIndex) = bBoolean 218 case 2 'integer 219 nInteger = vValues(nIndex) + 1 220 vValues(nIndex) = nInteger 221 case 3 'long 222 nLong = vValues(nIndex) + 1 223 vValues(nIndex) = nLong 224 case 4 'single 225 nSingle = vValues(nIndex) + 1 226 vValues(nIndex) = nSingle 227 case 5 'double 228 nDouble = vValues(nIndex) + 1 229 vValues(nIndex) = nDouble 230 case 8 'string 231 vValues(nIndex) = vValues(nIndex) + cIfcShortName 232 end select 233 234 Out.Log("The property '" + sProperties(nIndex) + "' was changed") 235 236 oObj.setPropertyValues(sProperties(), vValues()) 237 238 bOK = (nCB1Val = nCB1ValMem) AND (nCB2Val >= nCB2ValMem) 239 Test.MethodTested("removePropertiesChangeListener()", bOK) 240 241 'remove the last Listener 242 oObj.removePropertiesChangeListener(oListener2) 243 Out.Log("oListener2 removed") 244 245 246Exit Sub 247ErrHndl: 248 Test.Exception() 249 bOK = false 250 resume next 251End Sub 252'callback routine called firePropertiesChangeEvent 253Sub CB1_propertiesChange 254 Out.Log("CallBack for Listener 1 was called.") 255 nCB1Val = nCB1Val + 1 256end Sub 257 258Sub CB2_propertiesChange 259 Out.Log("CallBack for Listener 2 was called.") 260 nCB2Val = nCB2Val + 1 261end Sub 262</script:module> 263