D7net
Home
Console
Upload
information
Create File
Create Folder
About
Tools
:
/
lib
/
libreoffice
/
share
/
basic
/
Access2Base
/
Filename :
TempVar.xba
back
Copy
<?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="TempVar" 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 TEMPVAR Private _This As Object ' Workaround for absence of This builtin function Private _Parent As Object Private _Name As String Private _Value As Variant REM ----------------------------------------------------------------------------------------------------------------------- REM --- CONSTRUCTORS / DESTRUCTORS --- REM ----------------------------------------------------------------------------------------------------------------------- Private Sub Class_Initialize() _Type = OBJTEMPVAR 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) REM ----------------------------------------------------------------------------------------------------------------------- Property Get ObjectType() As String ObjectType = _PropertyGet("ObjectType") End Property ' ObjectType (get) REM ----------------------------------------------------------------------------------------------------------------------- Property Get Value() As Variant Value = _PropertyGet("Value") End Property ' Value (get) Property Let Value(ByVal pvValue As Variant) Call _PropertySet("Value", pvValue) End Property ' Value (set) REM ----------------------------------------------------------------------------------------------------------------------- REM --- CLASS METHODS --- REM ----------------------------------------------------------------------------------------------------------------------- Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant ' Return property value of psProperty property name Utils._SetCalledSub("TempVar.getProperty") If IsMissing(pvProperty) Then Call _TraceArguments() getProperty = _PropertyGet(pvProperty) Utils._ResetCalledSub("TempVar.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 ----------------------------------------------------------------------------------------------------------------------- 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 ----------------------------------------------------------------------------------------------------------------------- Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean ' Return True if property setting OK Utils._SetCalledSub("TempVar.getProperty") setProperty = _PropertySet(psProperty, pvValue) Utils._ResetCalledSub("TempVar.getProperty") End Function 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("TempVar.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("TempVar.get" & psProperty) Exit Function Trace_Error: TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty) _PropertyGet = Nothing Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "TempVar._PropertyGet", Erl) _PropertyGet = Nothing GoTo Exit_Function End Function ' _PropertyGet REM ----------------------------------------------------------------------------------------------------------------------- Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean Utils._SetCalledSub("TempVar.set" & psProperty) If _ErrorHandler() Then On Local Error Goto Error_Function _PropertySet = True 'Execute Dim iArgNr As Integer If _IsLeft(_A2B_.CalledSub, "TempVar.") Then iArgNr = 1 Else iArgNr = 2 Select Case UCase(psProperty) Case UCase("Value") _Value = pvValue _A2B_.TempVars.Item(UCase(_Name)).Value = pvValue Case Else Goto Trace_Error End Select Exit_Function: Utils._ResetCalledSub("TempVar.set" & psProperty) Exit Function Trace_Error: TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty) _PropertySet = False Goto Exit_Function Trace_Error_Value: TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty)) _PropertySet = False Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "TempVar._PropertySet", Erl) _PropertySet = False GoTo Exit_Function End Function ' _PropertySet </script:module>