wizards/source/access2base/TempVar.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="TempVar" 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 TEMPVAR
  18 Private _Name                   As String
  19 Private _Value                  As Variant
  20
  21 REM -----------------------------------------------------------------------------------------------------------------------
  22 REM --- CONSTRUCTORS / DESTRUCTORS                                                                                                                                                                      ---
  23 REM -----------------------------------------------------------------------------------------------------------------------
  24 Private Sub Class_Initialize()
  25         _Type = OBJTEMPVAR
  26         _Name = &quot;&quot;
  27         _Value = Null
  28 End Sub         &apos;  Constructor
  29
  30 REM -----------------------------------------------------------------------------------------------------------------------
  31 Private Sub Class_Terminate()
  32         On Local Error Resume Next
  33         Call Class_Initialize()
  34 End Sub         &apos;  Destructor
  35
  36 REM -----------------------------------------------------------------------------------------------------------------------
  37 Public Sub Dispose()
  38         Call Class_Terminate()
  39 End Sub         &apos;  Explicit destructor
  40
  41 REM -----------------------------------------------------------------------------------------------------------------------
  42 REM --- CLASS GET/LET/SET PROPERTIES                                                                                                                                                            ---
  43 REM -----------------------------------------------------------------------------------------------------------------------
  44
  45 Property Get Name() As String
  46         Name = _PropertyGet(&quot;Name&quot;)
  47 End Property            &apos;  Name (get)
  48
  49 REM -----------------------------------------------------------------------------------------------------------------------
  50 Property Get ObjectType() As String
  51         ObjectType = _PropertyGet(&quot;ObjectType&quot;)
  52 End Property            &apos;  ObjectType (get)
  53
  54 REM -----------------------------------------------------------------------------------------------------------------------
  55 Property Get Value() As Variant
  56         Value = _PropertyGet(&quot;Value&quot;)
  57 End Property            &apos;  Value (get)
  58
  59 Property Let Value(ByVal pvValue As Variant)
  60         Call _PropertySet(&quot;Value&quot;, pvValue)
  61 End Property            &apos;  Value (set)
  62
  63 REM -----------------------------------------------------------------------------------------------------------------------
  64 REM --- CLASS METHODS                                                                                                                                                                                           ---
  65 REM -----------------------------------------------------------------------------------------------------------------------
  66
  67 Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
  68 &apos;  Return property value of psProperty property name
  69
  70         Utils._SetCalledSub(&quot;Property.getProperty&quot;)
  71         If IsMissing(pvProperty) Then Call _TraceArguments()
  72         getProperty = _PropertyGet(pvProperty)
  73         Utils._ResetCalledSub(&quot;Property.getProperty&quot;)
  74
  75 End Function            &apos;  getProperty
  76
  77 REM -----------------------------------------------------------------------------------------------------------------------
  78 Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
  79 &apos;  Return True if object has a valid property called pvProperty (case-insensitive comparison !)
  80
  81         If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
  82         Exit Function
  83
  84 End Function    &apos;  hasProperty
  85
  86 REM -----------------------------------------------------------------------------------------------------------------------
  87 Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
  88 &apos;  Return
  89 &apos;          a Collection object if pvIndex absent
  90 &apos;          a Property object otherwise
  91
  92 Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
  93         vPropertiesList = _PropertiesList()
  94         sObject = Utils._PCase(_Type)
  95         If IsMissing(pvIndex) Then
  96                 vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList)
  97         Else
  98                 vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList, pvIndex)
  99                 vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
 100         End If
 101
 102 Exit_Function:
 103         Set Properties = vProperty
 104         Exit Function
 105 End Function    &apos;  Properties
 106
 107 REM -----------------------------------------------------------------------------------------------------------------------
 108 Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean
 109 &apos;  Return True if property setting OK
 110 Dim cstThisSub As String
 111         cstThisSub = Utils._PCase(_Type) &amp; &quot;.getProperty&quot;
 112         Utils._SetCalledSub(cstThisSub)
 113         setProperty = _PropertySet(psProperty, pvValue)
 114         Utils._ResetCalledSub(cstThisSub)
 115 End Function
 116
 117 REM -----------------------------------------------------------------------------------------------------------------------
 118 REM --- PRIVATE FUNCTIONS                                                                                                                                                                                       ---
 119 REM -----------------------------------------------------------------------------------------------------------------------
 120 Private Function _PropertiesList() As Variant
 121          _PropertiesList = Array(&quot;Name&quot;, &quot;ObjectType&quot;, &quot;Value&quot;)
 122 End Function    &apos;  _PropertiesList
 123
 124 REM -----------------------------------------------------------------------------------------------------------------------
 125 Private Function _PropertyGet(ByVal psProperty As String) As Variant
 126 &apos;  Return property value of the psProperty property name
 127
 128         If _ErrorHandler() Then On Local Error Goto Error_Function
 129         Utils._SetCalledSub(&quot;TempVar.get&quot; &amp; psProperty)
 130         _PropertyGet = Nothing
 131
 132         Select Case UCase(psProperty)
 133                 Case UCase(&quot;Name&quot;)
 134                         _PropertyGet = _Name
 135                 Case UCase(&quot;ObjectType&quot;)
 136                         _PropertyGet = _Type
 137                 Case UCase(&quot;Value&quot;)
 138                         _PropertyGet = _Value
 139                 Case Else
 140                         Goto Trace_Error
 141         End Select
 142
 143 Exit_Function:
 144         Utils._ResetCalledSub(&quot;TempVar.get&quot; &amp; psProperty)
 145         Exit Function
 146 Trace_Error:
 147         TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
 148         _PropertyGet = Nothing
 149         Goto Exit_Function
 150 Error_Function:
 151         TraceError(TRACEABORT, Err, &quot;TempVar._PropertyGet&quot;, Erl)
 152         _PropertyGet = Nothing
 153         GoTo Exit_Function
 154 End Function            &apos;  _PropertyGet
 155
 156 REM -----------------------------------------------------------------------------------------------------------------------
 157 Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
 158
 159         Utils._SetCalledSub(&quot;TempVar.set&quot; &amp; psProperty)
 160         If _ErrorHandler() Then On Local Error Goto Error_Function
 161         _PropertySet = True
 162
 163 &apos;Execute
 164 Dim iArgNr As Integer
 165
 166         If _IsLeft(_A2B_.CalledSub, &quot;TempVar.&quot;) Then iArgNr = 1 Else iArgNr = 2
 167         Select Case UCase(psProperty)
 168                 Case UCase(&quot;Value&quot;)
 169                         _Value = pvValue
 170                         _A2B_.TempVars.Item(UCase(_Name)).Value = pvValue
 171                 Case Else
 172                         Goto Trace_Error
 173         End Select
 174
 175 Exit_Function:
 176         Utils._ResetCalledSub(&quot;TempVar.set&quot; &amp; psProperty)
 177         Exit Function
 178 Trace_Error:
 179         TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
 180         _PropertySet = False
 181         Goto Exit_Function
 182 Trace_Error_Value:
 183         TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty))
 184         _PropertySet = False
 185         Goto Exit_Function
 186 Error_Function:
 187         TraceError(TRACEABORT, Err, &quot;TempVar._PropertySet&quot;, Erl)
 188         _PropertySet = False
 189         GoTo Exit_Function
 190 End Function            &apos;  _PropertySet
 191 </script:module>