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' Be sure that all variables are dimensioned:
37option explicit
38
39
40Dim nCB1Val As Integer, nCB2Val As Integer
41
42
43Sub RunTest()
44
45'*************************************************************************
46' INTERFACE:
47' com.sun.star.beans.XMultiPropertySet
48'*************************************************************************
49On Error Goto ErrHndl
50    Dim bOK As Boolean
51    Dim oPropertySetInfo As Object
52    Dim oProperties As Variant
53    Dim aProp(0 to 1) As new com.sun.star.beans.PropertyValue
54    Dim cType As String
55    Dim oListener1 As Object, oListener2 As Object
56    Dim n As Integer, nMem As Integer, nIndex As Integer
57    Dim m As Integer
58    Dim bFound As Boolean
59    Dim nCount As Integer
60    Dim bBoolean As Boolean
61    Dim nInteger As Integer
62    Dim nLong As Long
63    Dim nSingle As Single
64    Dim nDouble As Double
65    Dim vMemVal As Variant
66    Dim nCB1ValMem As Integer
67    Dim nCB2ValMem As Integer
68
69    bOK = true
70    bFound = false
71    nCB1Val = 0
72    nCB2Val = 0
73    m = 0
74    oPropertySetInfo = oObj.GetPropertySetInfo
75    oProperties = oPropertySetInfo.Properties
76    nCount = uBound(oProperties)
77    Out.Log("The Object has " + nCount + " properties"
78
79    Out.Log("Create linsteners...")
80    oListener1 = createUNOListener("CB1_","com.sun.star.beans.XPropertiesChangeListener")
81    oListener2 = createUNOListener("CB2_","com.sun.star.beans.XPropertiesChangeListener")
82    Out.Log("oListener1 and oListener2 created"
83
84    'create sequences of Propertie-Names and Values
85    'fist get the amount of valid properties
86    for n = 0 to (nCount)
87        'look for readonly-properties
88        If (oProperties(n).Attributes AND com.sun.star.beans.PropertyAttribute.READONLY) = 0 Then
89            'look for MAYBEVOID-Properties
90            If (oProperties(n).Attributes AND com.sun.star.beans.PropertyAttribute.MAYBEVOID) = 0 Then
91                'is the Property testable
92                m = m + 1
93            End If
94        End If
95    next n
96
97    Out.Log("Amount of testable properites (without readonly and MAYBEVOID) is " + m)
98
99    'now store the names in sProperites
100    Dim searchProperties(0 to m-1) As String
101    m = 0
102    for n = 0 to (nCount)
103    'kick off readonly-properties
104        If (oProperties(n).Attributes AND com.sun.star.beans.PropertyAttribute.READONLY) = 0 Then
105        'kick off MYBEVOID-Properties
106            If (oProperties(n).Attributes AND com.sun.star.beans.PropertyAttribute.MAYBEVOID) = 0 Then
107                searchProperties(m) = oProperties(n).Name
108                Out.Log("" + m + " " + searchProperties(m) + " " + oObj.getPropertySetInfo.getPropertyByName(searchProperties(m)).Type.Name + " " + n)
109                Dim pVal As Variant
110
111                pVal = oObj.getPropertyValue(searchProperties(m))
112                oObj.setPropertyValues(Array(searchProperties(m)), Array(pVal))
113                m = m + 1
114            End If
115        End If
116    next n
117    nCount = m - 1
118
119    Dim sProperties(0 to nCount) As String
120    Dim vValues(0 to nCount) As Variant
121    For n = 0 to nCount
122        sProperties(n) = searchProperties(n)
123    next n
124
125    vValues() = oObj.getPropertyValues(sProperties())
126
127    'add ChangeListener
128    oObj.addPropertiesChangeListener(sProperties(),oListener1)
129    oObj.addPropertiesChangeListener(sProperties(),oListener2)
130    Out.Log("oListener1 and oListener2 added to object")
131
132    nIndex = 0
133    nMem = nIndex
134    'find at first a Boolean Value, if not available a String Property
135    While (NOT bFound) AND ((nCount &gt;= nIndex))
136        'get the property-type
137        cType = oObj.getPropertySetInfo.getPropertyByName(sProperties(nIndex)).Type.Name
138        If cType = "boolean" Then ' it is a Boolean Proerty
139            bFound = true
140            nMem = nIndex
141        else
142            If cType = "string" Then ' it is a String Property
143                nMem = nIndex
144            end if
145        end if
146        nIndex = nIndex + 1
147    Wend
148
149    nIndex = nIndex - 1
150    Out.Log("Property to change is: """ + sProperties(nIndex) + """ Type: """ + oObj.getPropertySetInfo.getPropertyByName(sProperties(nIndex)).Type.Name + """")
151    nIndex = nMem
152
153    'memory the old Value
154    vMemVal = vValues(nIndex)
155
156    'change a value of a property, hopefully a boolean or string property
157    select case VarType(vValues(nIndex)
158        case 11 'boolean
159            bBoolean = NOT vValues(nIndex)
160            vValues(nIndex) = bBoolean
161        case 2 'integer
162            nInteger = vValues(nIndex) + 1
163            vValues(nIndex) = nInteger
164        case 3 'long
165            nLong = vValues(nIndex) + 1
166            vValues(nIndex) = nLong
167        case 4 'single
168            nSingle = vValues(nIndex) + 1
169            vValues(nIndex) = nSingle
170        case 5 'double
171            nDouble = vValues(nIndex) + 1
172            vValues(nIndex) = nDouble
173        case 8 'string
174            vValues(nIndex) = vValues(nIndex) + cIfcShortName
175    end select
176
177    Test.StartMethod("getPropertySetInfo()")
178    bOK = bOK AND (uBound(oProperties) &gt; 0)
179    Test.MethodTested("getPropertySetInfo()", bOK)
180
181    Test.StartMethod("getPropertyValues()")
182    bOK = bOK AND (uBound(vValues()) &gt; 0)
183    Test.MethodTested("getPropertyValues()", bOK)
184
185    Test.StartMethod("setPropertyValues()")
186    oObj.setPropertyValues(sProperties(), vValues())
187    vValues() = oObj.getPropertyValues(sProperties())
188    bOK = bOK AND (vValues(nIndex) &lt;&gt; vMemVal)
189    Test.MethodTested("setPropertyValues()", bOK)
190
191    Test.StartMethod("addPropertiesChangeListener()")
192    bOK = (nCB1Val &gt;= 1) AND (nCB2Val &gt;= 1)
193    nCB1ValMem = nCB1Val
194    nCB2ValMem = nCb2Val
195    Test.MethodTested("addPropertiesChangeListener()", bOK)
196
197    'fire !!!
198    Out.Log("Try to fire property change event...")
199    oObj.firePropertiesChangeEvent(sProperties(),oListener1)
200    oObj.firePropertiesChangeEvent(sProperties(),oListener2)
201
202    Test.StartMethod("firePropertiesChangeEvent()")
203    bOK = (nCB1Val &gt;= nCB1ValMem) AND (nCB2Val &gt;= nCB2ValMem)
204    Test.MethodTested("firePropertiesChangeEvent()", bOK)
205    nCB1ValMem = nCB1Val
206    nCB2ValMem = nCb2Val
207
208
209    'remove one Listener and fire
210    Test.StartMethod("removePropertiesChangeListener()")
211    oObj.removePropertiesChangeListener(oListener1)
212    Out.Log("oListener1 removed")
213    select case VarType(vValues(nIndex)
214        case 11 'boolean
215            bBoolean = NOT vValues(nIndex)
216            vValues(nIndex) = bBoolean
217        case 2 'integer
218            nInteger = vValues(nIndex) + 1
219            vValues(nIndex) = nInteger
220        case 3 'long
221            nLong = vValues(nIndex) + 1
222            vValues(nIndex) = nLong
223        case 4 'single
224            nSingle = vValues(nIndex) + 1
225            vValues(nIndex) = nSingle
226        case 5 'double
227            nDouble = vValues(nIndex) + 1
228            vValues(nIndex) = nDouble
229        case 8 'string
230            vValues(nIndex) = vValues(nIndex) + cIfcShortName
231    end select
232
233    Out.Log("The property '" + sProperties(nIndex) + "' was changed")
234
235    oObj.setPropertyValues(sProperties(), vValues())
236
237    bOK = (nCB1Val = nCB1ValMem) AND (nCB2Val &gt;= nCB2ValMem)
238    Test.MethodTested("removePropertiesChangeListener()", bOK)
239
240    'remove the last Listener
241    oObj.removePropertiesChangeListener(oListener2)
242    Out.Log("oListener2 removed")
243
244
245Exit Sub
246ErrHndl:
247    Test.Exception()
248    bOK = false
249    resume next
250End Sub
251'callback routine called firePropertiesChangeEvent
252Sub CB1_propertiesChange
253    Out.Log("CallBack for Listener 1 was called.")
254    nCB1Val = nCB1Val + 1
255end Sub
256
257Sub CB2_propertiesChange
258    Out.Log("CallBack for Listener 2 was called.")
259    nCB2Val = nCB2Val + 1
260end Sub
261</script:module>
262