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