58192e3f75
TempVar objects contain variables (name/value pair) that can be dynamically created and removed by macros. They're useful to transmit values from one document to another, e.g. an .odb document and one or more non-Base documents. Change-Id: I2cb5b3e27620eda16bdeaf59788b80c393fe7d9c
191 lines
No EOL
8.1 KiB
XML
191 lines
No EOL
8.1 KiB
XML
<?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 _Name As String
|
|
Private _Value As Variant
|
|
|
|
REM -----------------------------------------------------------------------------------------------------------------------
|
|
REM --- CONSTRUCTORS / DESTRUCTORS ---
|
|
REM -----------------------------------------------------------------------------------------------------------------------
|
|
Private Sub Class_Initialize()
|
|
_Type = OBJTEMPVAR
|
|
_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("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 -----------------------------------------------------------------------------------------------------------------------
|
|
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, _Name, vPropertiesList)
|
|
Else
|
|
vProperty = PropertiesGet._Properties(sObject, _Name, 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
|
|
Dim cstThisSub As String
|
|
cstThisSub = Utils._PCase(_Type) & ".getProperty"
|
|
Utils._SetCalledSub(cstThisSub)
|
|
setProperty = _PropertySet(psProperty, pvValue)
|
|
Utils._ResetCalledSub(cstThisSub)
|
|
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 Len(_A2B_.CalledSub) > 8 And Left(_A2B_.CalledSub, 8) = "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> |