EVOLUTION-MANAGER
Edit File: UtilProperty.xba
<?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="UtilProperty" script:language="StarBasic">REM ======================================================================================================================= REM === The Access2Base library is a part of the LibreOffice project. === REM === Full documentation is available on http://www.access2base.com === REM ======================================================================================================================= '********************************************************************** ' UtilProperty module ' ' Module of utilities to manipulate arrays of PropertyValue's. '********************************************************************** '********************************************************************** ' Copyright (c) 2003-2004 Danny Brewer ' d29583@groovegarden.com '********************************************************************** '********************************************************************** ' If you make changes, please append to the change log below. ' ' Change Log ' Danny Brewer Revised 2004-02-25-01 ' Jean-Pierre Ledure Adapted to Access2Base coding conventions '********************************************************************** Option Explicit REM ======================================================================================================================= Public Function _MakePropertyValue(ByVal Optional psName As String, Optional pvValue As Variant) As com.sun.star.beans.PropertyValue ' Create and return a new com.sun.star.beans.PropertyValue. Dim oPropertyValue As Object Set oPropertyValue = createUnoStruct( "com.sun.star.beans.PropertyValue" ) If Not IsMissing(psName) Then oPropertyValue.Name = psName If Not IsMissing(pvValue) Then oPropertyValue.Value = pvValue _MakePropertyValue() = oPropertyValue End Function ' _MakePropertyValue V1.3.0 REM ======================================================================================================================= Public Function _NumPropertyValues(pvPropertyValuesArray As Variant) As Integer ' Return the number of PropertyValue's in an array. ' Parameters: ' pvPropertyValuesArray - an array of PropertyValue's, that is an array of com.sun.star.beans.PropertyValue. ' Returns zero if the array contains no elements. Dim iNumProperties As Integer If Not IsArray(pvPropertyValuesArray) Then iNumProperties = 0 Else iNumProperties = UBound(pvPropertyValuesArray) + 1 _NumPropertyValues() = iNumProperties End Function ' _NumPropertyValues V1.3.0 REM ======================================================================================================================= Public Function _FindPropertyIndex(pvPropertyValuesArray, ByVal psPropName As String ) As Integer ' Find a particular named property from an array of PropertyValue's. ' Finds the index in the array of PropertyValue's and returns it, or returns -1 if it was not found. Dim iNumProperties As Integer, i As Integer, vProp As Variant iNumProperties = _NumPropertyValues(pvPropertyValuesArray) For i = 0 To iNumProperties - 1 vProp = pvPropertyValuesArray(i) If UCase(vProp.Name) = UCase(psPropName) Then _FindPropertyIndex() = i Exit Function EndIf Next i _FindPropertyIndex() = -1 End Function ' _FindPropertyIndex V1.3.0 REM ======================================================================================================================= Public Function _FindProperty(pvPropertyValuesArray, ByVal psPropName As String) As com.sun.star.beans.PropertyValue ' Find a particular named property from an array of PropertyValue's. ' Finds the PropertyValue and returns it, or returns Null if not found. Dim iPropIndex As Integer, vProp As Variant iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName) If iPropIndex >= 0 Then vProp = pvPropertyValuesArray(iPropIndex) ' access array subscript _FindProperty() = vProp EndIf End Function ' _FindProperty V1.3.0 REM ======================================================================================================================= Function _GetPropertyValue(pvPropertyValuesArray, ByVal psPropName As String, Optional pvDefaultValue) As Variant ' Get the value of a particular named property from an array of PropertyValue's. ' vDefaultValue - This value is returned if the property is not found in the array. Dim iPropIndex As Integer, vProp As Variant, vValue As Variant iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName) If iPropIndex >= 0 Then vProp = pvPropertyValuesArray(iPropIndex) ' access array subscript vValue = vProp.Value ' get the value from the PropertyValue _GetPropertyValue() = vValue Else If IsMissing(pvDefaultValue) Then pvDefaultValue = Null _GetPropertyValue() = pvDefaultValue EndIf End Function ' _GetPropertyValue V1.3.0 REM ======================================================================================================================= Sub _SetPropertyValue(pvPropertyValuesArray, ByVal psPropName As String, ByVal pvValue) ' Set the value of a particular named property from an array of PropertyValue's. Dim iPropIndex As Integer, vProp As Variant, iNumProperties As Integer iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName) ' Did we find it? If iPropIndex >= 0 Then ' Found, the PropertyValue is already in the array. Just modify its value. vProp = pvPropertyValuesArray(iPropIndex) ' access array subscript vProp.Value = pvValue ' set the property value. pvPropertyValuesArray(iPropIndex) = vProp ' put it back into array Else ' Not found, the array contains no PropertyValue with this name. Append new element to array. iNumProperties = _NumPropertyValues(pvPropertyValuesArray) If iNumProperties = 0 Then pvPropertyValuesArray = Array(_MakePropertyValue(psPropName, pvValue)) Else ' Make array larger. Redim Preserve pvPropertyValuesArray(iNumProperties) ' Assign new PropertyValue pvPropertyValuesArray(iNumProperties) = _MakePropertyValue(psPropName, pvValue) EndIf EndIf End Sub ' _SetPropertyValue V1.3.0 REM ======================================================================================================================= Sub _DeleteProperty(pvPropertyValuesArray, ByVal psPropName As String) ' Delete a particular named property from an array of PropertyValue's. Dim iPropIndex As Integer iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName) _DeleteIndexedProperty(pvPropertyValuesArray, iPropIndex) End Sub ' _DeletePropertyValue V1.3.0 REM ======================================================================================================================= Public Sub _DeleteIndexedProperty(pvPropertyValuesArray, ByVal piPropIndex As Integer) ' Delete a particular indexed property from an array of PropertyValue's. Dim iNumProperties As Integer, i As Integer iNumProperties = _NumPropertyValues(pvPropertyValuesArray) ' Did we find it? If piPropIndex < 0 Then ' Do nothing ElseIf iNumProperties = 1 Then ' Just return a new empty array pvPropertyValuesArray = Array() Else ' If it is NOT the last item in the array, then shift other elements down into it's position. If piPropIndex < iNumProperties - 1 Then ' Bump items down lower in the array. For i = piPropIndex To iNumProperties - 2 pvPropertyValuesArray(i) = pvPropertyValuesArray(i + 1) Next i EndIf ' Redimension the array to have one fewer element. Redim Preserve pvPropertyValuesArray(iNumProperties - 2) EndIf End Sub ' _DeleteIndexedProperty V1.3.0 REM ======================================================================================================================= Public Function _PropValuesToStr(pvPropertyValuesArray) As String ' Convenience function to return a string which explains what PropertyValue's are in the array of PropertyValue's. Dim iNumProperties As Integer, sResult As String, i As Integer, vProp As Variant Dim sName As String, vValue As Variant iNumProperties = _NumPropertyValues(pvPropertyValuesArray) sResult = Cstr(iNumProperties) & " Properties:" For i = 0 To iNumProperties - 1 vProp = pvPropertyValuesArray(i) sName = vProp.Name vValue = vProp.Value sResult = sResult & Chr(13) & " " & sName & " = " & _CStr(vValue) Next i _PropValuesToStr() = sResult End Function ' _PropValuesToStr V1.3.0 </script:module>