xref: /aoo42x/main/qadevOOo/tests/basic/ifc/beans/XMultiPropertySet/beans_XMultiPropertySet.xba (revision eebed415)

<?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>