File: //lib64/libreoffice/share/basic/Access2Base/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>