Quelle  Property.xba   Sprache: unbekannt

<?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>