Property.xba 6.6 KB

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