wizards/source/access2base/Property.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="Property" script:language="StarBasic">
   4 REM =======================================================================================================================
   5 REM ===                                 The Access2Base library is a part of the LibreOffice project.                                                                   ===
   6 REM ===                                 Full documentation is available on http://www.access2base.com                                                                   ===
   7 REM =======================================================================================================================
   8
   9 Option Compatible
  10 Option ClassModule
  11
  12 Option Explicit
  13
  14 REM -----------------------------------------------------------------------------------------------------------------------
  15 REM --- CLASS ROOT FIELDS                                                                                                                                                                                       ---
  16 REM -----------------------------------------------------------------------------------------------------------------------
  17
  18 Private _Type                   As String               &apos;  Must be PROPERTY
  19 Private _This                   As Object               &apos;  Workaround for absence of This builtin function
  20 Private _Parent                 As Object
  21 Private _Name                   As String
  22 Private _Value                  As Variant
  23 Private _ParentDatabase As Object
  24
  25 REM -----------------------------------------------------------------------------------------------------------------------
  26 REM --- CONSTRUCTORS / DESTRUCTORS                                                                                                                                                                      ---
  27 REM -----------------------------------------------------------------------------------------------------------------------
  28 Private Sub Class_Initialize()
  29         _Type = OBJPROPERTY
  30         Set _This = Nothing
  31         Set _Parent = Nothing
  32         _Name = &quot;&quot;
  33         _Value = Null
  34 End Sub         &apos;  Constructor
  35
  36 REM -----------------------------------------------------------------------------------------------------------------------
  37 Private Sub Class_Terminate()
  38         On Local Error Resume Next
  39         Call Class_Initialize()
  40 End Sub         &apos;  Destructor
  41
  42 REM -----------------------------------------------------------------------------------------------------------------------
  43 Public Sub Dispose()
  44         Call Class_Terminate()
  45 End Sub         &apos;  Explicit destructor
  46
  47 REM -----------------------------------------------------------------------------------------------------------------------
  48 REM --- CLASS GET/LET/SET PROPERTIES                                                                                                                                                            ---
  49 REM -----------------------------------------------------------------------------------------------------------------------
  50
  51 Property Get Name() As String
  52         Name = _PropertyGet(&quot;Name&quot;)
  53 End Property            &apos;  Name (get)
  54
  55 Public Function pName() As String               &apos;  For compatibility with &lt; V0.9.0
  56         pName = _PropertyGet(&quot;Name&quot;)
  57 End Function            &apos;  pName (get)
  58
  59 REM -----------------------------------------------------------------------------------------------------------------------
  60 Property Get ObjectType() As String
  61         ObjectType = _PropertyGet(&quot;ObjectType&quot;)
  62 End Property            &apos;  ObjectType (get)
  63
  64 REM -----------------------------------------------------------------------------------------------------------------------
  65 Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
  66 &apos;  Return
  67 &apos;          a Collection object if pvIndex absent
  68 &apos;          a Property object otherwise
  69
  70 Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
  71         vPropertiesList = _PropertiesList()
  72         sObject = Utils._PCase(_Type)
  73         If IsMissing(pvIndex) Then
  74                 vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList)
  75         Else
  76                 vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList, pvIndex)
  77                 vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
  78         End If
  79
  80 Exit_Function:
  81         Set Properties = vProperty
  82         Exit Function
  83 End Function    &apos;  Properties
  84
  85 REM -----------------------------------------------------------------------------------------------------------------------
  86 Property Get Value() As Variant
  87         Value = _PropertyGet(&quot;Value&quot;)
  88 End Property            &apos;  Value (get)
  89
  90 REM -----------------------------------------------------------------------------------------------------------------------
  91 REM --- CLASS METHODS                                                                                                                                                                                           ---
  92 REM -----------------------------------------------------------------------------------------------------------------------
  93
  94 Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
  95 &apos;  Return property value of psProperty property name
  96
  97         Utils._SetCalledSub(&quot;Property.getProperty&quot;)
  98         If IsMissing(pvProperty) Then Call _TraceArguments()
  99         getProperty = _PropertyGet(pvProperty)
 100         Utils._ResetCalledSub(&quot;Property.getProperty&quot;)
 101
 102 End Function            &apos;  getProperty
 103
 104 REM -----------------------------------------------------------------------------------------------------------------------
 105 Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
 106 &apos;  Return True if object has a valid property called pvProperty (case-insensitive comparison !)
 107
 108         If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
 109         Exit Function
 110
 111 End Function    &apos;  hasProperty
 112
 113 REM -----------------------------------------------------------------------------------------------------------------------
 114 REM --- PRIVATE FUNCTIONS                                                                                                                                                                                       ---
 115 REM -----------------------------------------------------------------------------------------------------------------------
 116 Private Function _PropertiesList() As Variant
 117          _PropertiesList = Array(&quot;Name&quot;, &quot;ObjectType&quot;, &quot;Value&quot;)
 118 End Function    &apos;  _PropertiesList
 119
 120 REM -----------------------------------------------------------------------------------------------------------------------
 121 Private Function _PropertyGet(ByVal psProperty As String) As Variant
 122 &apos;  Return property value of the psProperty property name
 123
 124         If _ErrorHandler() Then On Local Error Goto Error_Function
 125         Utils._SetCalledSub(&quot;Property.get&quot; &amp; psProperty)
 126         _PropertyGet = Nothing
 127
 128         Select Case UCase(psProperty)
 129                 Case UCase(&quot;Name&quot;)
 130                         _PropertyGet = _Name
 131                 Case UCase(&quot;ObjectType&quot;)
 132                         _PropertyGet = _Type
 133                 Case UCase(&quot;Value&quot;)
 134                         _PropertyGet = _Value
 135                 Case Else
 136                         Goto Trace_Error
 137         End Select
 138
 139 Exit_Function:
 140         Utils._ResetCalledSub(&quot;Property.get&quot; &amp; psProperty)
 141         Exit Function
 142 Trace_Error:
 143         TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
 144         _PropertyGet = Nothing
 145         Goto Exit_Function
 146 Error_Function:
 147         TraceError(TRACEABORT, Err, &quot;Property._PropertyGet&quot;, Erl)
 148         _PropertyGet = Nothing
 149         GoTo Exit_Function
 150 End Function            &apos;  _PropertyGet
 151
 152 </script:module>