AOO410/main/qadevOOo/tests/basic/ifc/beans/XMultiPropertySet/beans_XMultiPropertySet.xba - openoffice - Git at Google

 <?xml version="1.0" encoding="UTF-8"?>
 <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="beans_XMultiPropertySet" script:language="StarBasic">


 '*************************************************************************
 '
 '  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
 '
 '  Unless required by applicable law or agreed to in writing,
 '  software distributed under the License is distributed on an
 '  "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
 '  KIND, either express or implied.  See the License for the
 '  specific language governing permissions and limitations
 '  under the 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 &gt;= 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) &gt; 0)
     Test.MethodTested("getPropertySetInfo()", bOK)

     Test.StartMethod("getPropertyValues()")
     bOK = bOK AND (uBound(vValues()) &gt; 0)
     Test.MethodTested("getPropertyValues()", bOK)

     Test.StartMethod("setPropertyValues()")
     oObj.setPropertyValues(sProperties(), vValues())
     vValues() = oObj.getPropertyValues(sProperties())
     bOK = bOK AND (vValues(nIndex) &lt;&gt; vMemVal)
     Test.MethodTested("setPropertyValues()", bOK)

     Test.StartMethod("addPropertiesChangeListener()")
     bOK = (nCB1Val &gt;= 1) AND (nCB2Val &gt;= 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 &gt;= nCB1ValMem) AND (nCB2Val &gt;= 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 &gt;= 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
 </script:module>
	<?xml version="1.0" encoding="UTF-8"?>
	<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
	<script:module xmlns:script="http://openoffice.org/2000/script" script:name="beans_XMultiPropertySet" script:language="StarBasic">


	'*************************************************************************
	'
	' 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
	'
	' Unless required by applicable law or agreed to in writing,
	' software distributed under the License is distributed on an
	' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
	' KIND, either express or implied. See the License for the
	' specific language governing permissions and limitations
	' under the 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
	</script:module>