123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152 |
- <?xml version="1.0" encoding="UTF-8"?>
- <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
- <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Property" script:language="StarBasic">
- REM =======================================================================================================================
- REM === The Access2Base library is a part of the LibreOffice project. ===
- REM === Full documentation is available on http://www.access2base.com ===
- REM =======================================================================================================================
- Option Compatible
- Option ClassModule
- Option Explicit
- REM -----------------------------------------------------------------------------------------------------------------------
- REM --- CLASS ROOT FIELDS ---
- REM -----------------------------------------------------------------------------------------------------------------------
- Private _Type As String ' Must be PROPERTY
- Private _This As Object ' Workaround for absence of This builtin function
- Private _Parent As Object
- Private _Name As String
- Private _Value As Variant
- Private _ParentDatabase As Object
- REM -----------------------------------------------------------------------------------------------------------------------
- REM --- CONSTRUCTORS / DESTRUCTORS ---
- REM -----------------------------------------------------------------------------------------------------------------------
- Private Sub Class_Initialize()
- _Type = OBJPROPERTY
- Set _This = Nothing
- Set _Parent = Nothing
- _Name = ""
- _Value = Null
- End Sub ' Constructor
- REM -----------------------------------------------------------------------------------------------------------------------
- Private Sub Class_Terminate()
- On Local Error Resume Next
- Call Class_Initialize()
- End Sub ' Destructor
- REM -----------------------------------------------------------------------------------------------------------------------
- Public Sub Dispose()
- Call Class_Terminate()
- End Sub ' Explicit destructor
- REM -----------------------------------------------------------------------------------------------------------------------
- REM --- CLASS GET/LET/SET PROPERTIES ---
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get Name() As String
- Name = _PropertyGet("Name")
- End Property ' Name (get)
- Public Function pName() As String ' For compatibility with < V0.9.0
- pName = _PropertyGet("Name")
- End Function ' pName (get)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get ObjectType() As String
- ObjectType = _PropertyGet("ObjectType")
- End Property ' ObjectType (get)
- REM -----------------------------------------------------------------------------------------------------------------------
- Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
- ' Return
- ' a Collection object if pvIndex absent
- ' a Property object otherwise
- Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
- vPropertiesList = _PropertiesList()
- sObject = Utils._PCase(_Type)
- If IsMissing(pvIndex) Then
- vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList)
- Else
- vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList, pvIndex)
- vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
- End If
-
- Exit_Function:
- Set Properties = vProperty
- Exit Function
- End Function ' Properties
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get Value() As Variant
- Value = _PropertyGet("Value")
- End Property ' Value (get)
- REM -----------------------------------------------------------------------------------------------------------------------
- REM --- CLASS METHODS ---
- REM -----------------------------------------------------------------------------------------------------------------------
- Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
- ' Return property value of psProperty property name
- Utils._SetCalledSub("Property.getProperty")
- If IsMissing(pvProperty) Then Call _TraceArguments()
- getProperty = _PropertyGet(pvProperty)
- Utils._ResetCalledSub("Property.getProperty")
-
- End Function ' getProperty
- REM -----------------------------------------------------------------------------------------------------------------------
- Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
- ' Return True if object has a valid property called pvProperty (case-insensitive comparison !)
- If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
- Exit Function
-
- End Function ' hasProperty
- REM -----------------------------------------------------------------------------------------------------------------------
- REM --- PRIVATE FUNCTIONS ---
- REM -----------------------------------------------------------------------------------------------------------------------
- Private Function _PropertiesList() As Variant
- _PropertiesList = Array("Name", "ObjectType", "Value")
- End Function ' _PropertiesList
- REM -----------------------------------------------------------------------------------------------------------------------
- Private Function _PropertyGet(ByVal psProperty As String) As Variant
- ' Return property value of the psProperty property name
- If _ErrorHandler() Then On Local Error Goto Error_Function
- Utils._SetCalledSub("Property.get" & psProperty)
- _PropertyGet = Nothing
-
- Select Case UCase(psProperty)
- Case UCase("Name")
- _PropertyGet = _Name
- Case UCase("ObjectType")
- _PropertyGet = _Type
- Case UCase("Value")
- _PropertyGet = _Value
- Case Else
- Goto Trace_Error
- End Select
-
- Exit_Function:
- Utils._ResetCalledSub("Property.get" & psProperty)
- Exit Function
- Trace_Error:
- TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
- _PropertyGet = Nothing
- Goto Exit_Function
- Error_Function:
- TraceError(TRACEABORT, Err, "Property._PropertyGet", Erl)
- _PropertyGet = Nothing
- GoTo Exit_Function
- End Function ' _PropertyGet
- </script:module>
|