wizards/source/access2base/UtilProperty.xba

   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="UtilProperty" script:language="StarBasic">REM =======================================================================================================================
   4 REM ===                                 The Access2Base library is a part of the LibreOffice project.                                                                   ===
   5 REM ===                                 Full documentation is available on http://www.access2base.com                                                                   ===
   6 REM =======================================================================================================================
   7
   8 &apos;**********************************************************************
   9 &apos;  UtilProperty module
  10 &apos;
  11 &apos;  Module of utilities to manipulate arrays of PropertyValue&apos;s.
  12 &apos;**********************************************************************
  13
  14 &apos;**********************************************************************
  15 &apos;  Copyright (c) 2003-2004 Danny Brewer
  16 &apos;  d29583@groovegarden.com
  17 &apos;**********************************************************************
  18
  19 &apos;**********************************************************************
  20 &apos;  If you make changes, please append to the change log below.
  21 &apos;
  22 &apos;  Change Log
  23 &apos;          Danny Brewer                    Revised 2004-02-25-01
  24 &apos;          Jean-Pierre Ledure              Adapted to Access2Base coding conventions
  25 &apos;**********************************************************************
  26
  27 Option Explicit
  28
  29 REM =======================================================================================================================
  30 Public Function _MakePropertyValue(ByVal Optional psName As String, Optional pvValue As Variant) As com.sun.star.beans.PropertyValue
  31 &apos;   Create and return a new com.sun.star.beans.PropertyValue.
  32
  33 Dim oPropertyValue As Object
  34         Set oPropertyValue = createUnoStruct( &quot;com.sun.star.beans.PropertyValue&quot; )
  35         If Not IsMissing(psName) Then oPropertyValue.Name = psName
  36         If Not IsMissing(pvValue) Then oPropertyValue.Value = pvValue
  37         _MakePropertyValue() = oPropertyValue
  38
  39 End Function    &apos;  _MakePropertyValue V1.3.0
  40
  41 REM =======================================================================================================================
  42 Public Function _NumPropertyValues(pvPropertyValuesArray As Variant) As Integer
  43 &apos; Return the number of PropertyValue&apos;s in an array.
  44 &apos; Parameters:
  45 &apos;  pvPropertyValuesArray - an array of PropertyValue&apos;s, that is an array of com.sun.star.beans.PropertyValue.
  46 &apos; Returns zero if the array contains no elements.
  47
  48 Dim iNumProperties As Integer
  49         If Not IsArray(pvPropertyValuesArray) Then iNumProperties = 0 Else iNumProperties = UBound(pvPropertyValuesArray) + 1
  50         _NumPropertyValues() = iNumProperties
  51
  52 End Function    &apos;  _NumPropertyValues V1.3.0
  53
  54 REM =======================================================================================================================
  55 Public Function _FindPropertyIndex(pvPropertyValuesArray, ByVal psPropName As String ) As Integer
  56 &apos; Find a particular named property from an array of PropertyValue&apos;s.
  57 &apos; Finds the index in the array of PropertyValue&apos;s and returns it, or returns -1 if it was not found.
  58
  59 Dim iNumProperties As Integer, i As Integer, vProp As Variant
  60         iNumProperties = _NumPropertyValues(pvPropertyValuesArray)
  61         For i = 0 To iNumProperties - 1
  62                 vProp = pvPropertyValuesArray(i)
  63                 If UCase(vProp.Name) = UCase(psPropName) Then
  64                         _FindPropertyIndex() = i
  65                         Exit Function
  66                 EndIf
  67         Next i
  68         _FindPropertyIndex() = -1
  69
  70 End Function    &apos;  _FindPropertyIndex V1.3.0
  71
  72 REM =======================================================================================================================
  73 Public Function _FindProperty(pvPropertyValuesArray, ByVal psPropName As String) As com.sun.star.beans.PropertyValue
  74 &apos; Find a particular named property from an array of PropertyValue&apos;s.
  75 &apos; Finds the PropertyValue and returns it, or returns Null if not found.
  76
  77 Dim iPropIndex As Integer, vProp As Variant
  78         iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName)
  79         If iPropIndex &gt;= 0 Then
  80                 vProp = pvPropertyValuesArray(iPropIndex) &apos; access array subscript
  81                 _FindProperty() = vProp
  82         EndIf
  83
  84 End Function    &apos;  _FindProperty V1.3.0
  85
  86 REM =======================================================================================================================
  87 Function _GetPropertyValue(pvPropertyValuesArray, ByVal psPropName As String, Optional pvDefaultValue) As Variant
  88 &apos; Get the value of a particular named property from an array of PropertyValue&apos;s.
  89 &apos; vDefaultValue      -   This value is returned if the property is not found in the array.
  90
  91 Dim iPropIndex As Integer, vProp As Variant, vValue As Variant
  92         iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName)
  93         If iPropIndex &gt;= 0 Then
  94                 vProp = pvPropertyValuesArray(iPropIndex)       &apos; access array subscript
  95                 vValue = vProp.Value                                            &apos; get the value from the PropertyValue
  96                 _GetPropertyValue() = vValue
  97         Else
  98                 If IsMissing(pvDefaultValue) Then pvDefaultValue = Null
  99                 _GetPropertyValue() = pvDefaultValue
 100    EndIf
 101 End Function    &apos;  _GetPropertyValue V1.3.0
 102
 103 REM =======================================================================================================================
 104 Sub _SetPropertyValue(pvPropertyValuesArray, ByVal psPropName As String, ByVal pvValue)
 105 &apos; Set the value of a particular named property from an array of PropertyValue&apos;s.
 106
 107 Dim iPropIndex As Integer, vProp As Variant, iNumProperties As Integer
 108         iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName)
 109         &apos; Did we find it?
 110         If iPropIndex &gt;= 0 Then
 111         &apos; Found, the PropertyValue is already in the array. Just modify its value.
 112                 vProp = pvPropertyValuesArray(iPropIndex)       &apos; access array subscript
 113                 vProp.Value = pvValue                                           &apos; set the property value.
 114                 pvPropertyValuesArray(iPropIndex) = vProp       &apos; put it back into array
 115         Else
 116         &apos; Not found, the array contains no PropertyValue with this name. Append new element to array.
 117                 iNumProperties = _NumPropertyValues(pvPropertyValuesArray)
 118                 If iNumProperties = 0 Then
 119                         pvPropertyValuesArray = Array(_MakePropertyValue(psPropName, pvValue))
 120                 Else
 121                 &apos; Make array larger.
 122                         Redim Preserve pvPropertyValuesArray(iNumProperties)
 123                         &apos; Assign new PropertyValue
 124                         pvPropertyValuesArray(iNumProperties) = _MakePropertyValue(psPropName, pvValue)
 125                 EndIf
 126         EndIf
 127
 128 End Sub         &apos;  _SetPropertyValue V1.3.0
 129
 130 REM =======================================================================================================================
 131 Sub _DeleteProperty(pvPropertyValuesArray, ByVal psPropName As String)
 132 &apos; Delete a particular named property from an array of PropertyValue&apos;s.
 133
 134 Dim iPropIndex As Integer
 135         iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName)
 136         _DeleteIndexedProperty(pvPropertyValuesArray, iPropIndex)
 137
 138 End Sub         &apos;  _DeletePropertyValue V1.3.0
 139
 140 REM =======================================================================================================================
 141 Public Sub _DeleteIndexedProperty(pvPropertyValuesArray, ByVal piPropIndex As Integer)
 142 &apos; Delete a particular indexed property from an array of PropertyValue&apos;s.
 143
 144 Dim iNumProperties As Integer, i As Integer
 145         iNumProperties = _NumPropertyValues(pvPropertyValuesArray)
 146
 147         &apos; Did we find it?
 148         If piPropIndex &lt; 0 Then
 149                 &apos; Do nothing
 150         ElseIf iNumProperties = 1 Then
 151                 &apos; Just return a new empty array
 152                 pvPropertyValuesArray = Array()
 153         Else
 154                 &apos; If it is NOT the last item in the array, then shift other elements down into it&apos;s position.
 155                 If piPropIndex &lt; iNumProperties - 1 Then
 156                         &apos; Bump items down lower in the array.
 157                         For i = piPropIndex To iNumProperties - 2
 158                                 pvPropertyValuesArray(i) = pvPropertyValuesArray(i + 1)
 159                         Next i
 160                 EndIf
 161                 &apos; Redimension the array to have one fewer element.
 162                 Redim Preserve pvPropertyValuesArray(iNumProperties - 2)
 163         EndIf
 164
 165 End Sub         &apos;  _DeleteIndexedProperty V1.3.0
 166
 167 REM =======================================================================================================================
 168 Public Function _PropValuesToStr(pvPropertyValuesArray) As String
 169 &apos; Convenience function to return a string which explains what PropertyValue&apos;s are in the array of PropertyValue&apos;s.
 170
 171 Dim iNumProperties As Integer, sResult As String, i As Integer, vProp As Variant
 172 Dim sName As String, vValue As Variant
 173         iNumProperties = _NumPropertyValues(pvPropertyValuesArray)
 174
 175         sResult = Cstr(iNumProperties) &amp; &quot; Properties:&quot;
 176         For i = 0 To iNumProperties - 1
 177                 vProp = pvPropertyValuesArray(i)
 178                 sName = vProp.Name
 179                 vValue = vProp.Value
 180                 sResult = sResult &amp; Chr(13) &amp; &quot;  &quot; &amp; sName &amp; &quot; = &quot; &amp; _CStr(vValue)
 181         Next i
 182         _PropValuesToStr() = sResult
 183
 184 End Function    &apos;  _PropValuesToStr V1.3.0
 185 </script:module>