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 &gt;= 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) &gt; 0)
180    Test.MethodTested("getPropertySetInfo()", bOK)
181
182    Test.StartMethod("getPropertyValues()")
183    bOK = bOK AND (uBound(vValues()) &gt; 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) &lt;&gt; vMemVal)
190    Test.MethodTested("setPropertyValues()", bOK)
191
192    Test.StartMethod("addPropertiesChangeListener()")
193    bOK = (nCB1Val &gt;= 1) AND (nCB2Val &gt;= 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 &gt;= nCB1ValMem) AND (nCB2Val &gt;= 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 &gt;= 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