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