'************************************************************************* ' ' DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. ' ' Copyright 2008 by Sun Microsystems, Inc. ' ' OpenOffice.org - a multi-platform office productivity suite ' ' $RCSfile: beans_XMultiPropertySet.xba,v $ ' ' $Revision: 1.3 $ ' ' This file is part of OpenOffice.org. ' ' OpenOffice.org is free software: you can redistribute it and/or modify ' it under the terms of the GNU Lesser General Public License version 3 ' only, as published by the Free Software Foundation. ' ' OpenOffice.org is distributed in the hope that it will be useful, ' but WITHOUT ANY WARRANTY; without even the implied warranty of ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ' GNU Lesser General Public License version 3 for more details ' (a copy is included in the LICENSE file that accompanied this code). ' ' You should have received a copy of the GNU Lesser General Public License ' version 3 along with OpenOffice.org. If not, see ' ' for a copy of the LGPLv3 License. ' '************************************************************************* '************************************************************************* ' Be sure that all variables are dimensioned: option explicit Dim nCB1Val As Integer, nCB2Val As Integer Sub RunTest() '************************************************************************* ' INTERFACE: ' com.sun.star.beans.XMultiPropertySet '************************************************************************* On Error Goto ErrHndl Dim bOK As Boolean Dim oPropertySetInfo As Object Dim oProperties As Variant Dim aProp(0 to 1) As new com.sun.star.beans.PropertyValue Dim cType As String Dim oListener1 As Object, oListener2 As Object Dim n As Integer, nMem As Integer, nIndex As Integer Dim m As Integer Dim bFound As Boolean Dim nCount As Integer Dim bBoolean As Boolean Dim nInteger As Integer Dim nLong As Long Dim nSingle As Single Dim nDouble As Double Dim vMemVal As Variant Dim nCB1ValMem As Integer Dim nCB2ValMem As Integer bOK = true bFound = false nCB1Val = 0 nCB2Val = 0 m = 0 oPropertySetInfo = oObj.GetPropertySetInfo oProperties = oPropertySetInfo.Properties nCount = uBound(oProperties) Out.Log("The Object has " + nCount + " properties" Out.Log("Create linsteners...") oListener1 = createUNOListener("CB1_","com.sun.star.beans.XPropertiesChangeListener") oListener2 = createUNOListener("CB2_","com.sun.star.beans.XPropertiesChangeListener") Out.Log("oListener1 and oListener2 created" 'create sequences of Propertie-Names and Values 'fist get the amount of valid properties for n = 0 to (nCount) 'look for readonly-properties If (oProperties(n).Attributes AND com.sun.star.beans.PropertyAttribute.READONLY) = 0 Then 'look for MAYBEVOID-Properties If (oProperties(n).Attributes AND com.sun.star.beans.PropertyAttribute.MAYBEVOID) = 0 Then 'is the Property testable m = m + 1 End If End If next n Out.Log("Amount of testable properites (without readonly and MAYBEVOID) is " + m) 'now store the names in sProperites Dim searchProperties(0 to m-1) As String m = 0 for n = 0 to (nCount) 'kick off readonly-properties If (oProperties(n).Attributes AND com.sun.star.beans.PropertyAttribute.READONLY) = 0 Then 'kick off MYBEVOID-Properties If (oProperties(n).Attributes AND com.sun.star.beans.PropertyAttribute.MAYBEVOID) = 0 Then searchProperties(m) = oProperties(n).Name Out.Log("" + m + " " + searchProperties(m) + " " + oObj.getPropertySetInfo.getPropertyByName(searchProperties(m)).Type.Name + " " + n) Dim pVal As Variant pVal = oObj.getPropertyValue(searchProperties(m)) oObj.setPropertyValues(Array(searchProperties(m)), Array(pVal)) m = m + 1 End If End If next n nCount = m - 1 Dim sProperties(0 to nCount) As String Dim vValues(0 to nCount) As Variant For n = 0 to nCount sProperties(n) = searchProperties(n) next n vValues() = oObj.getPropertyValues(sProperties()) 'add ChangeListener oObj.addPropertiesChangeListener(sProperties(),oListener1) oObj.addPropertiesChangeListener(sProperties(),oListener2) Out.Log("oListener1 and oListener2 added to object") nIndex = 0 nMem = nIndex 'find at first a Boolean Value, if not available a String Property While (NOT bFound) AND ((nCount >= nIndex)) 'get the property-type cType = oObj.getPropertySetInfo.getPropertyByName(sProperties(nIndex)).Type.Name If cType = "boolean" Then ' it is a Boolean Proerty bFound = true nMem = nIndex else If cType = "string" Then ' it is a String Property nMem = nIndex end if end if nIndex = nIndex + 1 Wend nIndex = nIndex - 1 Out.Log("Property to change is: """ + sProperties(nIndex) + """ Type: """ + oObj.getPropertySetInfo.getPropertyByName(sProperties(nIndex)).Type.Name + """") nIndex = nMem 'memory the old Value vMemVal = vValues(nIndex) 'change a value of a property, hopefully a boolean or string property select case VarType(vValues(nIndex) case 11 'boolean bBoolean = NOT vValues(nIndex) vValues(nIndex) = bBoolean case 2 'integer nInteger = vValues(nIndex) + 1 vValues(nIndex) = nInteger case 3 'long nLong = vValues(nIndex) + 1 vValues(nIndex) = nLong case 4 'single nSingle = vValues(nIndex) + 1 vValues(nIndex) = nSingle case 5 'double nDouble = vValues(nIndex) + 1 vValues(nIndex) = nDouble case 8 'string vValues(nIndex) = vValues(nIndex) + cIfcShortName end select Test.StartMethod("getPropertySetInfo()") bOK = bOK AND (uBound(oProperties) > 0) Test.MethodTested("getPropertySetInfo()", bOK) Test.StartMethod("getPropertyValues()") bOK = bOK AND (uBound(vValues()) > 0) Test.MethodTested("getPropertyValues()", bOK) Test.StartMethod("setPropertyValues()") oObj.setPropertyValues(sProperties(), vValues()) vValues() = oObj.getPropertyValues(sProperties()) bOK = bOK AND (vValues(nIndex) <> vMemVal) Test.MethodTested("setPropertyValues()", bOK) Test.StartMethod("addPropertiesChangeListener()") bOK = (nCB1Val >= 1) AND (nCB2Val >= 1) nCB1ValMem = nCB1Val nCB2ValMem = nCb2Val Test.MethodTested("addPropertiesChangeListener()", bOK) 'fire !!! Out.Log("Try to fire property change event...") oObj.firePropertiesChangeEvent(sProperties(),oListener1) oObj.firePropertiesChangeEvent(sProperties(),oListener2) Test.StartMethod("firePropertiesChangeEvent()") bOK = (nCB1Val >= nCB1ValMem) AND (nCB2Val >= nCB2ValMem) Test.MethodTested("firePropertiesChangeEvent()", bOK) nCB1ValMem = nCB1Val nCB2ValMem = nCb2Val 'remove one Listener and fire Test.StartMethod("removePropertiesChangeListener()") oObj.removePropertiesChangeListener(oListener1) Out.Log("oListener1 removed") select case VarType(vValues(nIndex) case 11 'boolean bBoolean = NOT vValues(nIndex) vValues(nIndex) = bBoolean case 2 'integer nInteger = vValues(nIndex) + 1 vValues(nIndex) = nInteger case 3 'long nLong = vValues(nIndex) + 1 vValues(nIndex) = nLong case 4 'single nSingle = vValues(nIndex) + 1 vValues(nIndex) = nSingle case 5 'double nDouble = vValues(nIndex) + 1 vValues(nIndex) = nDouble case 8 'string vValues(nIndex) = vValues(nIndex) + cIfcShortName end select Out.Log("The property '" + sProperties(nIndex) + "' was changed") oObj.setPropertyValues(sProperties(), vValues()) bOK = (nCB1Val = nCB1ValMem) AND (nCB2Val >= nCB2ValMem) Test.MethodTested("removePropertiesChangeListener()", bOK) 'remove the last Listener oObj.removePropertiesChangeListener(oListener2) Out.Log("oListener2 removed") Exit Sub ErrHndl: Test.Exception() bOK = false resume next End Sub 'callback routine called firePropertiesChangeEvent Sub CB1_propertiesChange Out.Log("CallBack for Listener 1 was called.") nCB1Val = nCB1Val + 1 end Sub Sub CB2_propertiesChange Out.Log("CallBack for Listener 2 was called.") nCB2Val = nCB2Val + 1 end Sub