TempVar.xba 8.2 KB

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