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