Kaydet (Commit) 58192e3f authored tarafından Jean-Pierre Ledure's avatar Jean-Pierre Ledure

Access2Base - New TempVars collection and TempVar objects

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
üst f83f61bc
...@@ -45,6 +45,7 @@ $(eval $(call gb_Package_add_files,wizards_basicsrvaccess2base,$(LIBO_SHARE_FOLD ...@@ -45,6 +45,7 @@ $(eval $(call gb_Package_add_files,wizards_basicsrvaccess2base,$(LIBO_SHARE_FOLD
Recordset.xba \ Recordset.xba \
script.xlb \ script.xlb \
SubForm.xba \ SubForm.xba \
TempVar.xba \
Test.xba \ Test.xba \
Trace.xba \ Trace.xba \
Utils.xba \ Utils.xba \
......
...@@ -86,6 +86,7 @@ Global Const COLLPROPERTIES = "PROPERTIES" ...@@ -86,6 +86,7 @@ Global Const COLLPROPERTIES = "PROPERTIES"
Global Const COLLQUERYDEFS = "QUERYDEFS" Global Const COLLQUERYDEFS = "QUERYDEFS"
Global Const COLLRECORDSETS = "RECORDSETS" Global Const COLLRECORDSETS = "RECORDSETS"
Global Const COLLTABLEDEFS = "TABLEDEFS" Global Const COLLTABLEDEFS = "TABLEDEFS"
Global Const COLLTEMPVARS = "TEMPVARS"
REM ----------------------------------------------------------------------------------------------------------------------- REM -----------------------------------------------------------------------------------------------------------------------
Global Const OBJAPPLICATION = "APPLICATION" Global Const OBJAPPLICATION = "APPLICATION"
...@@ -102,6 +103,7 @@ Global Const OBJQUERYDEF = "QUERYDEF" ...@@ -102,6 +103,7 @@ Global Const OBJQUERYDEF = "QUERYDEF"
Global Const OBJRECORDSET = "RECORDSET" Global Const OBJRECORDSET = "RECORDSET"
Global Const OBJSUBFORM = "SUBFORM" Global Const OBJSUBFORM = "SUBFORM"
Global Const OBJTABLEDEF = "TABLEDEF" Global Const OBJTABLEDEF = "TABLEDEF"
Global Const OBJTEMPVAR = "TEMPVAR"
REM ----------------------------------------------------------------------------------------------------------------------- REM -----------------------------------------------------------------------------------------------------------------------
Global Const CTLCONTROL = "CONTROL" ' ClassId Global Const CTLCONTROL = "CONTROL" ' ClassId
...@@ -152,6 +154,7 @@ Type Root ...@@ -152,6 +154,7 @@ Type Root
FindRecord As Object FindRecord As Object
StatusBar As Object StatusBar As Object
Dialogs As Object ' Collection Dialogs As Object ' Collection
TempVars As Object ' Collection
CurrentDoc() As Variant ' Array of document containers - [0] = Base document, [1 ... N] = other documents CurrentDoc() As Variant ' Array of document containers - [0] = Base document, [1 ... N] = other documents
End Type End Type
...@@ -1130,6 +1133,60 @@ Error_Arg: ...@@ -1130,6 +1133,60 @@ Error_Arg:
Goto Exit_Function Goto Exit_Function
End Function ' SysCmd V0.9.1 End Function ' SysCmd V0.9.1
REM -----------------------------------------------------------------------------------------------------------------------
Public Function TempVars(ByVal Optional pvIndex As Variant) As Variant
' Return either a Collection or a TempVar object
If _ErrorHandler() Then On Local Error Goto Error_Function
Const cstThisSub = "TempVars"
Utils._SetCalledSub(cstThisSub)
Dim iMode As Integer, vTempVars As Variant, bFound As Boolean
Const cstCount = 0
Const cstByIndex = 1
Const cstByName = 2
If IsMissing(pvIndex) Then
iMode = cstCount
Else
If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
If VarType(pvIndex) = vbString Then iMode = cstByName Else iMode = cstByIndex
End If
Set vTempVars = Nothing
Select Case iMode
Case cstCount ' Build Collection object
Set vTempVars = New Collect
With vTempVars
._CollType = COLLTEMPVARS
._Count = _A2B_.TempVars.Count
End With
Case cstByIndex ' Build TempVar object
If pvIndex < 0 Or pvIndex >= _A2B_.TempVars.Count Then Goto Trace_Error_Index
Set vTempVars = _A2B_.TempVars.Item(pvIndex + 1) ' Builtin collections start at 1
Case cstByName
bFound = _hasItem(COLLTEMPVARS, pvIndex)
If Not bFound Then Goto Trace_NotFound
vTempVars = _A2B_.TempVars.Item(UCase(pvIndex))
End Select
Set TempVars = vTempVars
Exit_Function:
Utils._ResetCalledSub(cstThisSub)
Exit Function
Error_Function:
TraceError(TRACEABORT, Err, cstThisSub, Erl)
GoTo Exit_Function
Trace_Error_Index:
TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1)
Set vTempVars = Nothing
Goto Exit_Function
Trace_NotFound:
TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel("TEMPVAR"), pvIndex))
Goto Exit_Function
End Function ' TempVars V1.2.0
REM ----------------------------------------------------------------------------------------------------------------------- REM -----------------------------------------------------------------------------------------------------------------------
Public Function Version() As String Public Function Version() As String
Version = Utils._GetProductName() Version = Utils._GetProductName()
...@@ -1226,10 +1283,12 @@ Const cstBase = "com.sun.star.comp.dba.ODatabaseDocument" ...@@ -1226,10 +1283,12 @@ Const cstBase = "com.sun.star.comp.dba.ODatabaseDocument"
With .CurrentDoc(0) With .CurrentDoc(0)
If Not .Active Then GoTo Trace_Error If Not .Active Then GoTo Trace_Error
If IsNull(.Document) Then GoTo Trace_Error If IsNull(.Document) Then GoTo Trace_Error
If Not Utils._hasUNOProperty(ThisComponent, "URL") Then Goto Trace_Error
If Utils._ImplementationName(ThisComponent) <> cstBase Or .Document.URL <> ThisComponent.URL Then ' Give the parent a try If Utils._ImplementationName(ThisComponent) <> cstBase Or .Document.URL <> ThisComponent.URL Then ' Give the parent a try
If Not Utils._hasUNOProperty(ThisComponent, "Parent") Then Goto Trace_Error If Not Utils._hasUNOProperty(ThisComponent, "Parent") Then Goto Trace_Error
If IsNull(ThisComponent.Parent) Then Goto Trace_Error If IsNull(ThisComponent.Parent) Then Goto Trace_Error
If Utils._ImplementationName(ThisComponent.Parent) <> cstBase Then Goto Trace_Error If Utils._ImplementationName(ThisComponent.Parent) <> cstBase Then Goto Trace_Error
If Not Utils._hasUNOProperty(ThisComponent.Parent, "URL") Then Goto Trace_Error
If .Document.URL <> ThisComponent.Parent.URL Then Goto Trace_Error If .Document.URL <> ThisComponent.Parent.URL Then Goto Trace_Error
End If End If
End With End With
...@@ -1246,20 +1305,28 @@ Trace_Error: ...@@ -1246,20 +1305,28 @@ Trace_Error:
End Function ' _CurrentDoc V1.1.0 End Function ' _CurrentDoc V1.1.0
REM ----------------------------------------------------------------------------------------------------------------------- REM -----------------------------------------------------------------------------------------------------------------------
Public Function _hasDialog(ByVal psName As String) As Boolean Public Function _hasItem(psCollType As String, ByVal psName As String) As Boolean
' Return True if psName if in the collection of started dialogs ' Return True if psName if in the collection
Dim oDialog As Object Dim oItem As Object
On Local Error Goto Error_Function ' Whatever ErrorHandler ! On Local Error Goto Error_Function ' Whatever ErrorHandler !
Set oDialog = _A2B_.Dialogs.Item(UCase(psName))
_hasDialog = True _hasItem = True
Select Case psCollType
Case COLLALLDIALOGS
Set oItem = _A2B_.Dialogs.Item(UCase(psName))
Case COLLTEMPVARS
Set oItem = _A2B_.TempVars.Item(UCase(psName))
Case Else
_hasItem = False
End Select
Exit_Function: Exit_Function:
Exit Function Exit Function
Error_Function: ' Item by key aborted Error_Function: ' Item by key aborted
_hasDialog = False _hasItem = False
GoTo Exit_Function GoTo Exit_Function
End Function ' _hasDialog V1.1.0 End Function ' _hasItem V1.2.0
REM ----------------------------------------------------------------------------------------------------------------------- REM -----------------------------------------------------------------------------------------------------------------------
Private Function _NewBar() As Object Private Function _NewBar() As Object
...@@ -1297,11 +1364,12 @@ Dim vBar As Variant, vWindow As Variant, vController As Object ...@@ -1297,11 +1364,12 @@ Dim vBar As Variant, vWindow As Variant, vController As Object
End Function ' _NewBar V1.1.0 End Function ' _NewBar V1.1.0
REM ----------------------------------------------------------------------------------------------------------------------- REM -----------------------------------------------------------------------------------------------------------------------
Public Sub _RootInit() Public Sub _RootInit(Optional ByVal pbForce As Boolean)
' Initialize _A2B_ global variable ' Initialize _A2B_ global variable. Reinit forced if pbForce = True
Dim vRoot As Root, vCurrentDoc() As Variant Dim vRoot As Root, vCurrentDoc() As Variant
If IsEmpty(_A2B_) Then If IsMissing(pbForce) Then pbForce = False
If IsEmpty(_A2B_) Or pbForce Then
_A2B_ = vRoot _A2B_ = vRoot
With _A2B_ With _A2B_
.VersionNumber = Access2Base_Version .VersionNumber = Access2Base_Version
...@@ -1316,6 +1384,7 @@ Dim vRoot As Root, vCurrentDoc() As Variant ...@@ -1316,6 +1384,7 @@ Dim vRoot As Root, vCurrentDoc() As Variant
Set .FindRecord = Nothing Set .FindRecord = Nothing
Set .StatusBar = Nothing Set .StatusBar = Nothing
Set .Dialogs = New Collection Set .Dialogs = New Collection
Set .TempVars = New Collection
vCurrentDoc() = Array() vCurrentDoc() = Array()
ReDim vCurrentDoc(0 To 0) ReDim vCurrentDoc(0 To 0)
Set vCurrentDoc(0) = Nothing Set vCurrentDoc(0) = Nothing
......
...@@ -88,7 +88,7 @@ Dim vNames() As Variant, oProperty As Object ...@@ -88,7 +88,7 @@ Dim vNames() As Variant, oProperty As Object
Case COLLFIELDS Case COLLFIELDS
Select Case _ParentType Select Case _ParentType
Case OBJQUERYDEF Case OBJQUERYDEF
Set Item = _ParentDatabase.QueryDefs(_ParentName).Fields(pvItem) ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< Set Item = _ParentDatabase.QueryDefs(_ParentName).Fields(pvItem)
Case OBJRECORDSET Case OBJRECORDSET
Set Item = _ParentDatabase.Recordsets(_ParentName).Fields(pvItem) Set Item = _ParentDatabase.Recordsets(_ParentName).Fields(pvItem)
Case OBJTABLEDEF Case OBJTABLEDEF
...@@ -129,10 +129,13 @@ Dim vNames() As Variant, oProperty As Object ...@@ -129,10 +129,13 @@ Dim vNames() As Variant, oProperty As Object
Set Item = _ParentDatabase.Recordsets(pvItem) Set Item = _ParentDatabase.Recordsets(pvItem)
Case COLLTABLEDEFS Case COLLTABLEDEFS
Set Item = _ParentDatabase.TableDefs(pvItem) Set Item = _ParentDatabase.TableDefs(pvItem)
Case COLLTEMPVARS
Set Item = Application.TempVars(pvItem)
Case Else Case Else
End Select End Select
Exit_Function: Exit_Function:
Utils._ResetCalledSub(cstThisSub)
Exit Property Exit Property
Error_Function: Error_Function:
TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl) TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl)
...@@ -170,21 +173,23 @@ REM ---------------------------------------------------------------------------- ...@@ -170,21 +173,23 @@ REM ----------------------------------------------------------------------------
REM --- CLASS METHODS --- REM --- CLASS METHODS ---
REM ----------------------------------------------------------------------------------------------------------------------- REM -----------------------------------------------------------------------------------------------------------------------
Public Function Add(Optional pvObject As Variant) As Boolean Public Function Add(Optional pvNew As Variant, Optional pvValue As Variant) As Boolean
' Append a new TableDef or Field object to the TableDefs/Fields collections ' Append a new TableDef or TempVar object to the TableDefs/TempVars collections
Const cstThisSub = "Collection.Add" Const cstThisSub = "Collection.Add"
Utils._SetCalledSub(cstThisSub) Utils._SetCalledSub(cstThisSub)
If _ErrorHandler() Then On Local Error Goto Error_Function If _ErrorHandler() Then On Local Error Goto Error_Function
Dim odbDatabase As Object, oConnection As Object, oTables As Object, sName As String, oTable As Object Dim odbDatabase As Object, oConnection As Object, oTables As Object, oTable As Object
Dim vObject As Variant, oTempVar As Object
Add = False Add = False
If IsMissing(pvObject) Then Call _TraceArguments() If IsMissing(pvNew) Then Call _TraceArguments()
If Not Utils._CheckArgument(pvObject, 1, vbObject) Then Goto Exit_Function
With pvObject Select Case _CollType
Select Case ._Type Case COLLTABLEDEFS
Case OBJTABLEDEF If Not Utils._CheckArgument(pvObject, 1, vbObject) Then Goto Exit_Function
Set vObject = pvNew
With vObject
Set odbDatabase = ._ParentDatabase Set odbDatabase = ._ParentDatabase
If odbDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable If odbDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable
Set oConnection = odbDatabase.Connection Set oConnection = odbDatabase.Connection
...@@ -196,11 +201,21 @@ Dim odbDatabase As Object, oConnection As Object, oTables As Object, sName As St ...@@ -196,11 +201,21 @@ Dim odbDatabase As Object, oConnection As Object, oTables As Object, sName As St
Set .TableDescriptor = Nothing Set .TableDescriptor = Nothing
.TableFieldsCount = 0 .TableFieldsCount = 0
.TableKeysCount = 0 .TableKeysCount = 0
End With
Case COLLTEMPVARS
If Not Utils._CheckArgument(pvNew, 1, vbString) Then Goto Exit_Function
If pvNew = "" Then Goto Error_Name
If IsMissing(pvValue) Then Call _TraceArguments()
If Application._hasItem(COLLTEMPVARS, pvNew) Then Goto Error_Name
Set oTempVar = New TempVar
oTempVar._Name = pvNew
oTempVar._Value = pvValue
_A2B_.TempVars.Add(oTempVar, UCase(pvNew))
Case Else Case Else
Goto Error_NotApplicable Goto Error_NotApplicable
End Select End Select
End With
_Count = _Count + 1
Add = True Add = True
Exit_Function: Exit_Function:
...@@ -213,7 +228,11 @@ Error_NotApplicable: ...@@ -213,7 +228,11 @@ Error_NotApplicable:
TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub) TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
Goto Exit_Function Goto Exit_Function
Error_Sequence: Error_Sequence:
TraceError(TRACEFATAL, ERRTABLECREATION, Utils._CalledSub(), 0, 1, pvObject._Name) TraceError(TRACEFATAL, ERRTABLECREATION, Utils._CalledSub(), 0, 1, vObject._Name)
Goto Exit_Function
Error_Name:
TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), False, ,Array(1, pvNew))
AddItem = False
Goto Exit_Function Goto Exit_Function
End Function ' Add V1.1.0 End Function ' Add V1.1.0
...@@ -247,6 +266,7 @@ Dim odbDatabase As Object, oColl As Object, vName As Variant ...@@ -247,6 +266,7 @@ Dim odbDatabase As Object, oColl As Object, vName As Variant
Goto Error_NotApplicable Goto Error_NotApplicable
End Select End Select
_Count = _Count - 1
Delete = True Delete = True
Exit_Function: Exit_Function:
...@@ -283,6 +303,73 @@ Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean ...@@ -283,6 +303,73 @@ Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
End Function ' hasProperty End Function ' hasProperty
REM -----------------------------------------------------------------------------------------------------------------------
Public Function Remove(ByVal Optional pvName As Variant) As Boolean
' Remove a TempVar from the TempVars collection
Const cstThisSub = "Collection.Remove"
Utils._SetCalledSub(cstThisSub)
If _ErrorHandler() Then On Local Error Goto Error_Function
Dim oColl As Object, vName As Variant
Remove = False
If IsMissing(pvName) Then pvName = ""
If Not Utils._CheckArgument(pvName, 1, vbString) Then Goto Exit_Function
If pvName = "" Then Call _TraceArguments()
Select Case _CollType
Case COLLTEMPVARS
If Not _hasItem(COLLTEMPVARS, pvName) Then Goto Error_Name
_A2B_.TempVars.Remove(UCase(pvName))
Case Else
Goto Error_NotApplicable
End Select
_Count = _Count - 1
Remove = True
Exit_Function:
Utils._ResetCalledSub(cstThisSub)
Exit Function
Error_Function:
TraceError(TRACEABORT, Err, cstThisSub, Erl)
GoTo Exit_Function
Error_NotApplicable:
TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
Goto Exit_Function
Error_Name:
TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), False, ,Array(1, pvName))
AddItem = False
Goto Exit_Function
End Function ' Remove V1.2.0
REM -----------------------------------------------------------------------------------------------------------------------
Public Function RemoveAll() As Boolean
' Remove the whole TempVars collection
Const cstThisSub = "Collection.Remove"
Utils._SetCalledSub(cstThisSub)
If _ErrorHandler() Then On Local Error Goto Error_Function
Select Case _CollType
Case COLLTEMPVARS
Set _A2B_.TempVars = New Collection
_Count = 0
Case Else
Goto Error_NotApplicable
End Select
Exit_Function:
Utils._ResetCalledSub(cstThisSub)
Exit Function
Error_Function:
TraceError(TRACEABORT, Err, cstThisSub, Erl)
GoTo Exit_Function
Error_NotApplicable:
TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
Goto Exit_Function
End Function ' RemoveAll V1.2.0
REM ----------------------------------------------------------------------------------------------------------------------- REM -----------------------------------------------------------------------------------------------------------------------
REM --- PRIVATE FUNCTIONS --- REM --- PRIVATE FUNCTIONS ---
REM ----------------------------------------------------------------------------------------------------------------------- REM -----------------------------------------------------------------------------------------------------------------------
...@@ -320,6 +407,4 @@ Error_Function: ...@@ -320,6 +407,4 @@ Error_Function:
_PropertyGet = Nothing _PropertyGet = Nothing
GoTo Exit_Function GoTo Exit_Function
End Function ' _PropertyGet End Function ' _PropertyGet
</script:module> </script:module>
\ No newline at end of file
...@@ -487,7 +487,7 @@ Dim oStart As Object ...@@ -487,7 +487,7 @@ Dim oStart As Object
Start = True Start = True
Set UnoDialog = oStart Set UnoDialog = oStart
With _A2B_ With _A2B_
If Application._hasDialog(_Name) Then .Dialogs.Remove(_Name) &apos; Inserted to solve errors, when aborts between start and terminate If Application._hasItem(COLLALLDIALOGS, _Name) Then .Dialogs.Remove(_Name) &apos; Inserted to solve errors, when aborts between start and terminate
.Dialogs.Add(UnoDialog, UCase(_Name)) .Dialogs.Add(UnoDialog, UCase(_Name))
End With End With
End If End If
...@@ -574,7 +574,7 @@ Dim vEMPTY As Variant ...@@ -574,7 +574,7 @@ Dim vEMPTY As Variant
Case UCase(&quot;Height&quot;) Case UCase(&quot;Height&quot;)
_PropertyGet = UnoDialog.getPosSize().Height _PropertyGet = UnoDialog.getPosSize().Height
Case UCase(&quot;IsLoaded&quot;) Case UCase(&quot;IsLoaded&quot;)
_PropertyGet = Application._hasDialog(_Name) _PropertyGet = Application._hasItem(COLLALLDIALOGS, _Name)
Case UCase(&quot;Name&quot;) Case UCase(&quot;Name&quot;)
_PropertyGet = _Name _PropertyGet = _Name
Case UCase(&quot;ObjectType&quot;) Case UCase(&quot;ObjectType&quot;)
......
...@@ -404,12 +404,13 @@ Dim sXPos As String, sYPos As String ...@@ -404,12 +404,13 @@ Dim sXPos As String, sYPos As String
sXPos = Iif(IsNull(_XPos), &quot;&quot;, &quot;XPos&quot;) sXPos = Iif(IsNull(_XPos), &quot;&quot;, &quot;XPos&quot;)
sYPos = Iif(IsNull(_YPos), &quot;&quot;, &quot;YPos&quot;) sYPos = Iif(IsNull(_YPos), &quot;&quot;, &quot;YPos&quot;)
_PropertiesList = Utils._TrimArray(&quot;ButtonLeft&quot;, &quot;ButtonRight&quot;, &quot;ButtonMiddle&quot;, &quot;ClickCount&quot; _ _PropertiesList = Utils._TrimArray(Array( _
&quot;ButtonLeft&quot;, &quot;ButtonRight&quot;, &quot;ButtonMiddle&quot;, &quot;ClickCount&quot; _
, &quot;ContextShortcut&quot;, &quot;EventName&quot;, &quot;EventType&quot;, &quot;FocusChangeTemporary&quot;, _ , &quot;ContextShortcut&quot;, &quot;EventName&quot;, &quot;EventType&quot;, &quot;FocusChangeTemporary&quot;, _
, &quot;KeyAlt&quot;, &quot;KeyChar&quot;, &quot;KeyCode&quot;, &quot;KeyCtrl&quot;, &quot;KeyFunction&quot;, &quot;KeyShift&quot; _ , &quot;KeyAlt&quot;, &quot;KeyChar&quot;, &quot;KeyCode&quot;, &quot;KeyCtrl&quot;, &quot;KeyFunction&quot;, &quot;KeyShift&quot; _
, &quot;ObjectType&quot;, &quot;Recommendation&quot;, &quot;RowChangeAction&quot;, &quot;Source&quot; _ , &quot;ObjectType&quot;, &quot;Recommendation&quot;, &quot;RowChangeAction&quot;, &quot;Source&quot; _
, sSubComponentName, sSubComponentType, sXPos, sYPos _ , sSubComponentName, sSubComponentType, sXPos, sYPos _
) ))
End Function &apos; _PropertiesList End Function &apos; _PropertiesList
......
...@@ -84,6 +84,7 @@ Dim sLocal As String ...@@ -84,6 +84,7 @@ Dim sLocal As String
Case &quot;REPORT&quot; : sLocal = &quot;Report&quot; Case &quot;REPORT&quot; : sLocal = &quot;Report&quot;
Case &quot;RECORDSET&quot; : sLocal = &quot;Recordset&quot; Case &quot;RECORDSET&quot; : sLocal = &quot;Recordset&quot;
Case &quot;FIELD&quot; : sLocal = &quot;Field&quot; Case &quot;FIELD&quot; : sLocal = &quot;Field&quot;
Case &quot;TEMPVAR&quot; : sLocal = &quot;Temporary variable&quot;
&apos;---------------------------------------------------------------------------------------------------------------------- &apos;----------------------------------------------------------------------------------------------------------------------
Case &quot;ERR#&quot; : sLocal = &quot;Error #&quot; Case &quot;ERR#&quot; : sLocal = &quot;Error #&quot;
Case &quot;ERROCCUR&quot; : sLocal = &quot;occurred&quot; Case &quot;ERROCCUR&quot; : sLocal = &quot;occurred&quot;
...@@ -188,6 +189,7 @@ Dim sLocal As String ...@@ -188,6 +189,7 @@ Dim sLocal As String
Case &quot;REPORT&quot; : sLocal = &quot;Rapport&quot; Case &quot;REPORT&quot; : sLocal = &quot;Rapport&quot;
Case &quot;RECORDSET&quot; : sLocal = &quot;Recordset&quot; Case &quot;RECORDSET&quot; : sLocal = &quot;Recordset&quot;
Case &quot;FIELD&quot; : sLocal = &quot;Champ&quot; Case &quot;FIELD&quot; : sLocal = &quot;Champ&quot;
Case &quot;TEMPVAR&quot; : sLocal = &quot;Variable temporaire&quot;
&apos;---------------------------------------------------------------------------------------------------------------------- &apos;----------------------------------------------------------------------------------------------------------------------
Case &quot;ERR#&quot; : sLocal = &quot;L&apos;erreur #&quot; Case &quot;ERR#&quot; : sLocal = &quot;L&apos;erreur #&quot;
Case &quot;ERROCCUR&quot; : sLocal = &quot;s&apos;est produite&quot; Case &quot;ERROCCUR&quot; : sLocal = &quot;s&apos;est produite&quot;
......
...@@ -394,7 +394,8 @@ Const cstEXCLAMATION = &quot;!&quot; ...@@ -394,7 +394,8 @@ Const cstEXCLAMATION = &quot;!&quot;
Const cstDOT = &quot;.&quot; Const cstDOT = &quot;.&quot;
If _ErrorHandler() Then On Local Error Goto Error_Function If _ErrorHandler() Then On Local Error Goto Error_Function
Utils._SetCalledSub(&quot;getObject&quot;) Const cstThisSub = &quot;getObject&quot;
Utils._SetCalledSub(cstThisSub)
If IsMissing(pvShortcut) Then Call _TraceArguments() If IsMissing(pvShortcut) Then Call _TraceArguments()
If Not Utils._CheckArgument(pvShortcut, 1, vbString) Then Goto Exit_Function If Not Utils._CheckArgument(pvShortcut, 1, vbString) Then Goto Exit_Function
...@@ -404,7 +405,7 @@ Dim oDoc As Object ...@@ -404,7 +405,7 @@ Dim oDoc As Object
Set vCurrentObject = Nothing Set vCurrentObject = Nothing
sComponents = Split(Trim(pvShortcut), cstEXCLAMATION) sComponents = Split(Trim(pvShortcut), cstEXCLAMATION)
If UBound(sComponents) = 0 Then Goto Trace_Error If UBound(sComponents) = 0 Then Goto Trace_Error
If Not Utils._InList(UCase(sComponents(0)), Array(&quot;FORMS&quot;, &quot;DIALOGS&quot;)) Then Goto Trace_Error If Not Utils._InList(UCase(sComponents(0)), Array(&quot;FORMS&quot;, &quot;DIALOGS&quot;, &quot;TEMPVARS&quot;)) Then Goto Trace_Error
If sComponents(1) = &quot;0&quot; Or Left(sComponents(1), 2) = &quot;0.&quot; Then If sComponents(1) = &quot;0&quot; Or Left(sComponents(1), 2) = &quot;0.&quot; Then
Set oDoc = _A2B_.CurrentDoc(Application._CurrentDoc()) Set oDoc = _A2B_.CurrentDoc(Application._CurrentDoc())
If oDoc.DbConnect = DBCONNECTFORM Then sComponents(1) = oDoc.DbContainers(0).FormName Else Goto Trace_Error If oDoc.DbConnect = DBCONNECTFORM Then sComponents(1) = oDoc.DbContainers(0).FormName Else Goto Trace_Error
...@@ -417,6 +418,7 @@ Dim oDoc As Object ...@@ -417,6 +418,7 @@ Dim oDoc As Object
Select Case UCase(sComponents(0)) Select Case UCase(sComponents(0))
Case &quot;FORMS&quot; : vCurrentObject._CollType = COLLFORMS Case &quot;FORMS&quot; : vCurrentObject._CollType = COLLFORMS
Case &quot;DIALOGS&quot; : vCurrentObject._CollType = COLLALLDIALOGS Case &quot;DIALOGS&quot; : vCurrentObject._CollType = COLLALLDIALOGS
Case &quot;TEMPVARS&quot; : vCurrentObject._CollType = COLLTEMPVARS
End Select End Select
For iCurrentIndex = 1 To UBound(sComponents) &apos; Start parsing ... For iCurrentIndex = 1 To UBound(sComponents) &apos; Start parsing ...
sSubComponents = Split(sComponents(iCurrentIndex), cstDOT) sSubComponents = Split(sComponents(iCurrentIndex), cstDOT)
...@@ -439,6 +441,9 @@ Dim oDoc As Object ...@@ -439,6 +441,9 @@ Dim oDoc As Object
vCurrentObject = Application.AllDialogs(sDialog) vCurrentObject = Application.AllDialogs(sDialog)
If Not vCurrentObject.IsLoaded Then Goto Trace_Error If Not vCurrentObject.IsLoaded Then Goto Trace_Error
Set vCurrentObject.UnoDialog = _A2B_.Dialogs.Item(sDialog) Set vCurrentObject.UnoDialog = _A2B_.Dialogs.Item(sDialog)
Case COLLTEMPVARS
If UBound(sComponents) &gt; 1 Then Goto Trace_Error
vCurrentObject = Application.TempVars(sComponents(1))
&apos;Case Else &apos;Case Else
End Select End Select
Case OBJFORM, OBJSUBFORM, OBJCONTROL, OBJDIALOG Case OBJFORM, OBJSUBFORM, OBJCONTROL, OBJDIALOG
...@@ -450,13 +455,13 @@ Dim oDoc As Object ...@@ -450,13 +455,13 @@ Dim oDoc As Object
Set getObject = vCurrentObject Set getObject = vCurrentObject
Exit_Function: Exit_Function:
Utils._ResetCalledSub(&quot;getObject&quot;) Utils._ResetCalledSub(cstThisSub)
Exit Function Exit Function
Trace_Error: Trace_Error:
TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(1, pvShortcut)) TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(1, pvShortcut))
Goto Exit_Function Goto Exit_Function
Error_Function: Error_Function:
TraceError(TRACEABORT, Err, &quot;getObject&quot;, Erl) TraceError(TRACEABORT, Err, cstThisSub, Erl)
GoTo Exit_Function GoTo Exit_Function
End Function &apos; getObject V0.9.5 End Function &apos; getObject V0.9.5
...@@ -733,6 +738,9 @@ Public Function _getProperty(pvItem As Variant, ByVal psProperty As String, ByVa ...@@ -733,6 +738,9 @@ Public Function _getProperty(pvItem As Variant, ByVal psProperty As String, ByVa
Utils._SetCalledSub(&quot;get&quot; &amp; psProperty) Utils._SetCalledSub(&quot;get&quot; &amp; psProperty)
_getProperty = Nothing _getProperty = Nothing
&apos;pvItem must be an object and have the requested property
If Not Utils._CheckArgument(pvItem, 1, vbObject) Then Goto Exit_Function
If Not PropertiesGet._hasProperty(pvItem._Type, pvItem._PropertiesList(), psProperty) Then Goto Trace_Error
&apos;Check Index argument &apos;Check Index argument
If Not IsMissing(pvIndex) Then If Not IsMissing(pvIndex) Then
If Not Utils._CheckArgument(pvIndex, 3, Utils._AddNumeric()) Then Goto Exit_Function If Not Utils._CheckArgument(pvIndex, 3, Utils._AddNumeric()) Then Goto Exit_Function
...@@ -916,18 +924,18 @@ Public Function _getProperty(pvItem As Variant, ByVal psProperty As String, ByVa ...@@ -916,18 +924,18 @@ Public Function _getProperty(pvItem As Variant, ByVal psProperty As String, ByVa
Case UCase(&quot;Locked&quot;) Case UCase(&quot;Locked&quot;)
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
If IsNull(pvItem.Locked) Then Goto Trace_Error If IsNull(pvItem.Locked) Then Goto Trace_Error
_getProperty = pvItem.Locked _ge ExitProperty = pvItem.Locked
Case UCase(&quot;MultiSelect&quot;) Case UCase(&quot;MultiSelect&quot;)
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
_getProperty = pvItem.MultiSelect _getProperty = pvItem.MultiSelect
Case UCase(&quot;Name&quot;) Case UCase(&quot;Name&quot;)
If Not Utils._CheckArgument(pvItem, 1, _ If Not Utils._CheckArgument(pvItem, 1, _
Array(OBJFORM, OBJSUBFORM, OBJCONTROL, OBJOPTIONGROUP, OBJPROPERTY, OBJDIALOG, OBJTABLEDEF, OBJRECORDSET, OBJFIELD) _ Array(OBJFORM, OBJSUBFORM, OBJCONTROL, OBJOPTIONGROUP, OBJPROPERTY, OBJDIALOG, OBJTABLEDEF, OBJRECORDSET, OBJFIELD, OBJTEMPVAR) _
) Then Goto Exit_Function ) Then Goto Exit_Function
_getProperty = pvItem.Name _getProperty = pvItem.Name
Case UCase(&quot;ObjectType&quot;) Case UCase(&quot;ObjectType&quot;)
If Not Utils._CheckArgument(pvItem, 1, Array(OBJDATABASE, OBJCOLLECTION, OBJFORM, OBJDIALOG, OBJSUBFORM, OBJCONTROL _ If Not Utils._CheckArgument(pvItem, 1, Array(OBJDATABASE, OBJCOLLECTION, OBJFORM, OBJDIALOG, OBJSUBFORM, OBJCONTROL _
, OBJEVENT, OBJOPTIONGROUP, OBJPROPERTY, OBJRECORDSET, OBJTABLEDEF, OBJFIELD) _ , OBJEVENT, OBJOPTIONGROUP, OBJPROPERTY, OBJRECORDSET, OBJTABLEDEF, OBJFIELD, OBJTEMPVAR) _
) Then Goto Exit_Function ) Then Goto Exit_Function
_getProperty = pvItem.ObjectType _getProperty = pvItem.ObjectType
Case UCase(&quot;OpenArgs&quot;) Case UCase(&quot;OpenArgs&quot;)
...@@ -1021,7 +1029,7 @@ Public Function _getProperty(pvItem As Variant, ByVal psProperty As String, ByVa ...@@ -1021,7 +1029,7 @@ Public Function _getProperty(pvItem As Variant, ByVal psProperty As String, ByVa
If Not Utils._CheckArgument(pvItem, 1, OBJFIELD) Then Goto Exit_Function If Not Utils._CheckArgument(pvItem, 1, OBJFIELD) Then Goto Exit_Function
_getProperty = pvItem.TypeName _getProperty = pvItem.TypeName
Case UCase(&quot;Value&quot;) Case UCase(&quot;Value&quot;)
If Not Utils._CheckArgument(pvItem, 1, Array(OBJCONTROL, OBJOPTIONGROUP, OBJPROPERTY, OBJFIELD)) Then Goto Exit_Function If Not Utils._CheckArgument(pvItem, 1, Array(OBJCONTROL, OBJOPTIONGROUP, OBJPROPERTY, OBJFIELD, OBJTEMPVAR)) Then Goto Exit_Function
_getProperty = pvItem.Value _getProperty = pvItem.Value
Case UCase(&quot;Visible&quot;) Case UCase(&quot;Visible&quot;)
If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG, OBJCONTROL)) Then Goto Exit_Function If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG, OBJCONTROL)) Then Goto Exit_Function
...@@ -1159,7 +1167,7 @@ Dim i As Integer, j As Integer, iCount As Integer ...@@ -1159,7 +1167,7 @@ Dim i As Integer, j As Integer, iCount As Integer
Set vProperties = Nothing Set vProperties = Nothing
Select Case pvObject._Type Select Case pvObject._Type
Case OBJCOLLECTION, OBJPROPERTY, OBJFORM, OBJEVENT, OBJSUBFORM, OBJCONTROL, OBJOPTIONGROUP _ Case OBJCOLLECTION, OBJPROPERTY, OBJFORM, OBJEVENT, OBJSUBFORM, OBJCONTROL, OBJOPTIONGROUP _
, OBJDATABASE, OBJTABLEDEF, OBJQUERYDEF, OBJDIALOG, OBJFIELD, OBJRECORDSET , OBJDATABASE, OBJTABLEDEF, OBJQUERYDEF, OBJDIALOG, OBJFIELD, OBJRECORDSET, OBJTEMPVAR
vPropertiesList = pvObject._PropertiesList() vPropertiesList = pvObject._PropertiesList()
Case Else Case Else
End Select End Select
......
...@@ -375,6 +375,8 @@ Private Function _setProperty(pvItem As Variant, ByVal psProperty As String, ByV ...@@ -375,6 +375,8 @@ Private Function _setProperty(pvItem As Variant, ByVal psProperty As String, ByV
Utils._SetCalledSub(&quot;set&quot; &amp; psProperty) Utils._SetCalledSub(&quot;set&quot; &amp; psProperty)
If _ErrorHandler() Then On Local Error Goto Error_Function If _ErrorHandler() Then On Local Error Goto Error_Function
&apos;pvItem must be an object and have the requested property
If Not Utils._CheckArgument(pvIndex, 1, vbObject) Then Goto Exit_Function
&apos;Check Index argument &apos;Check Index argument
If Not IsMissing(pvIndex) Then If Not IsMissing(pvIndex) Then
If Not Utils._CheckArgument(pvIndex, 4, Utils._AddNumeric()) Then Goto Exit_Function If Not Utils._CheckArgument(pvIndex, 4, Utils._AddNumeric()) Then Goto Exit_Function
...@@ -386,6 +388,7 @@ Dim odbDatabase As Object, vNames As Variant, bFound As Boolean, sName As String ...@@ -386,6 +388,7 @@ Dim odbDatabase As Object, vNames As Variant, bFound As Boolean, sName As String
Dim ocButton As Variant, iRadioIndex As Integer Dim ocButton As Variant, iRadioIndex As Integer
_setProperty = True _setProperty = True
If _A2B_.CalledSub = &quot;setProperty&quot; Then iArgNr = 3 Else iArgNr = 2 If _A2B_.CalledSub = &quot;setProperty&quot; Then iArgNr = 3 Else iArgNr = 2
If Not PropertiesGet._hasProperty(pvItem._Type, pvItem._PropertiesList(), psProperty) Then Goto Trace_Error_Control
Select Case UCase(psProperty) Select Case UCase(psProperty)
Case UCase(&quot;AbsolutePosition&quot;) Case UCase(&quot;AbsolutePosition&quot;)
If Not Utils._CheckArgument(pvItem, 1, OBJRECORDSET) Then Goto Exit_Function If Not Utils._CheckArgument(pvItem, 1, OBJRECORDSET) Then Goto Exit_Function
...@@ -529,7 +532,7 @@ Dim ocButton As Variant, iRadioIndex As Integer ...@@ -529,7 +532,7 @@ Dim ocButton As Variant, iRadioIndex As Integer
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
pvItem.TripleState = pvValue pvItem.TripleState = pvValue
Case UCase(&quot;Value&quot;) Case UCase(&quot;Value&quot;)
If Not Utils._CheckArgument(pvItem, 1, Array(OBJCONTROL, OBJOPTIONGROUP, OBJFIELD)) Then Goto Exit_Function If Not Utils._CheckArgument(pvItem, 1, Array(OBJCONTROL, OBJOPTIONGROUP, OBJFIELD, OBJTEMPVAR)) Then Goto Exit_Function
pvItem.Value = pvValue pvItem.Value = pvValue
Case UCase(&quot;Visible&quot;) Case UCase(&quot;Visible&quot;)
If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG, OBJCONTROL)) Then Goto Exit_Function If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG, OBJCONTROL)) Then Goto Exit_Function
......
<?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 &apos; Must be TEMPVAR
Private _Name As String
Private _Value As Variant
REM -----------------------------------------------------------------------------------------------------------------------
REM --- CONSTRUCTORS / DESTRUCTORS ---
REM -----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJTEMPVAR
_Name = &quot;&quot;
_Value = Null
End Sub &apos; Constructor
REM -----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Terminate()
On Local Error Resume Next
Call Class_Initialize()
End Sub &apos; Destructor
REM -----------------------------------------------------------------------------------------------------------------------
Public Sub Dispose()
Call Class_Terminate()
End Sub &apos; Explicit destructor
REM -----------------------------------------------------------------------------------------------------------------------
REM --- CLASS GET/LET/SET PROPERTIES ---
REM -----------------------------------------------------------------------------------------------------------------------
Property Get Name() As String
Name = _PropertyGet(&quot;Name&quot;)
End Property &apos; Name (get)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get ObjectType() As String
ObjectType = _PropertyGet(&quot;ObjectType&quot;)
End Property &apos; ObjectType (get)
REM -----------------------------------------------------------------------------------------------------------------------
Property Get Value() As Variant
Value = _PropertyGet(&quot;Value&quot;)
End Property &apos; Value (get)
Property Let Value(ByVal pvValue As Variant)
Call _PropertySet(&quot;Value&quot;, pvValue)
End Property &apos; Value (set)
REM -----------------------------------------------------------------------------------------------------------------------
REM --- CLASS METHODS ---
REM -----------------------------------------------------------------------------------------------------------------------
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
&apos; Return property value of psProperty property name
Utils._SetCalledSub(&quot;Property.getProperty&quot;)
If IsMissing(pvProperty) Then Call _TraceArguments()
getProperty = _PropertyGet(pvProperty)
Utils._ResetCalledSub(&quot;Property.getProperty&quot;)
End Function &apos; getProperty
REM -----------------------------------------------------------------------------------------------------------------------
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
&apos; 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 &apos; hasProperty
REM -----------------------------------------------------------------------------------------------------------------------
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
&apos; Return
&apos; a Collection object if pvIndex absent
&apos; 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 &apos; Properties
REM -----------------------------------------------------------------------------------------------------------------------
Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean
&apos; Return True if property setting OK
Dim cstThisSub As String
cstThisSub = Utils._PCase(_Type) &amp; &quot;.getProperty&quot;
Utils._SetCalledSub(cstThisSub)
setProperty = _PropertySet(psProperty, pvValue)
Utils._ResetCalledSub(cstThisSub)
End Function
REM -----------------------------------------------------------------------------------------------------------------------
REM --- PRIVATE FUNCTIONS ---
REM -----------------------------------------------------------------------------------------------------------------------
Private Function _PropertiesList() As Variant
_PropertiesList = Array(&quot;Name&quot;, &quot;ObjectType&quot;, &quot;Value&quot;)
End Function &apos; _PropertiesList
REM -----------------------------------------------------------------------------------------------------------------------
Private Function _PropertyGet(ByVal psProperty As String) As Variant
&apos; Return property value of the psProperty property name
If _ErrorHandler() Then On Local Error Goto Error_Function
Utils._SetCalledSub(&quot;TempVar.get&quot; &amp; psProperty)
_PropertyGet = Nothing
Select Case UCase(psProperty)
Case UCase(&quot;Name&quot;)
_PropertyGet = _Name
Case UCase(&quot;ObjectType&quot;)
_PropertyGet = _Type
Case UCase(&quot;Value&quot;)
_PropertyGet = _Value
Case Else
Goto Trace_Error
End Select
Exit_Function:
Utils._ResetCalledSub(&quot;TempVar.get&quot; &amp; psProperty)
Exit Function
Trace_Error:
TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
_PropertyGet = Nothing
Goto Exit_Function
Error_Function:
TraceError(TRACEABORT, Err, &quot;TempVar._PropertyGet&quot;, Erl)
_PropertyGet = Nothing
GoTo Exit_Function
End Function &apos; _PropertyGet
REM -----------------------------------------------------------------------------------------------------------------------
Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
Utils._SetCalledSub(&quot;TempVar.set&quot; &amp; psProperty)
If _ErrorHandler() Then On Local Error Goto Error_Function
_PropertySet = True
&apos;Execute
Dim iArgNr As Integer
If Len(_A2B_.CalledSub) &gt; 8 And Left(_A2B_.CalledSub, 8) = &quot;TempVar.&quot; Then iArgNr = 1 Else iArgNr = 2
Select Case UCase(psProperty)
Case UCase(&quot;Value&quot;)
_Value = pvValue
_A2B_.TempVars.Item(UCase(_Name)).Value = pvValue
Case Else
Goto Trace_Error
End Select
Exit_Function:
Utils._ResetCalledSub(&quot;TempVar.set&quot; &amp; 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, &quot;TempVar._PropertySet&quot;, Erl)
_PropertySet = False
GoTo Exit_Function
End Function &apos; _PropertySet
</script:module>
\ No newline at end of file
...@@ -103,6 +103,7 @@ Dim iVarType As Integer ...@@ -103,6 +103,7 @@ Dim iVarType As Integer
If VarType(pvItem) = vbCurrency Or VarType(pvItem) = vbDecimal Or VarType(pvItem) = vbBigint Then pvItem = CDbl(pvItem) If VarType(pvItem) = vbCurrency Or VarType(pvItem) = vbDecimal Or VarType(pvItem) = vbBigint Then pvItem = CDbl(pvItem)
Exit_Function: Exit_Function:
Const cstObject = &quot;[com.sun.star.script.NativeObjectWrapper]&quot;
If Not _CheckArgument Then If Not _CheckArgument Then
If IsMissing(pvError) Then pvError = True If IsMissing(pvError) Then pvError = True
If pvError Then If pvError Then
...@@ -502,7 +503,7 @@ Dim oDoc As Object, oForms As Variant ...@@ -502,7 +503,7 @@ Dim oDoc As Object, oForms As Variant
If ._DbConnect = DBCONNECTFORM Then bPseudoExists = True Else bPseudoExists = .Document.CurrentController.IsConnected If ._DbConnect = DBCONNECTFORM Then bPseudoExists = True Else bPseudoExists = .Document.CurrentController.IsConnected
Case OBJDIALOG Case OBJDIALOG
If ._Name &lt;&gt; &quot;&quot; Then &apos; Check validity of dialog name If ._Name &lt;&gt; &quot;&quot; Then &apos; Check validity of dialog name
bPseudoExists = ( Application._hasDialog(._Name) ) bPseudoExists = ( Application._hasItem(COLLALLDIALOGS, ._Name) )
End If End If
Case OBJCOLLECTION Case OBJCOLLECTION
bPseudoExists = True bPseudoExists = True
...@@ -532,6 +533,10 @@ Dim oDoc As Object, oForms As Variant ...@@ -532,6 +533,10 @@ Dim oDoc As Object, oForms As Variant
bPseudoExists = ( Not IsNull(.RowSet) ) bPseudoExists = ( Not IsNull(.RowSet) )
Case OBJFIELD Case OBJFIELD
bPseudoExists = ( ._Name &lt;&gt; &quot;&quot; And Not IsNull(.Column) ) bPseudoExists = ( ._Name &lt;&gt; &quot;&quot; And Not IsNull(.Column) )
Case OBJTEMPVAR
If ._Name &lt;&gt; &quot;&quot; Then &apos; Check validity of tempvar name
bPseudoExists = ( Application._hasItem(COLLTEMPVARS, ._Name) )
End If
Case Else Case Else
End Select End Select
End With End With
...@@ -592,6 +597,7 @@ REM ---------------------------------------------------------------------------- ...@@ -592,6 +597,7 @@ REM ----------------------------------------------------------------------------
Public Sub _ResetCalledSub(ByVal psSub As String) As String Public Sub _ResetCalledSub(ByVal psSub As String) As String
&apos; Called in bottom of each public function. _A2B_.CalledSub variable is used for error handling &apos; Called in bottom of each public function. _A2B_.CalledSub variable is used for error handling
&apos; Used to trace routine in/outs and to clarify error messages &apos; Used to trace routine in/outs and to clarify error messages
If IsEmpty(_A2B_) Then Call Application._RootInit() &apos; Only is Utils module recompiled
If _A2B_.CalledSub = psSub Then _A2B_.CalledSub = &quot;&quot; If _A2B_.CalledSub = psSub Then _A2B_.CalledSub = &quot;&quot;
If _A2B_.MinimalTraceLevel = 1 Then TraceLog(TRACEDEBUG, _GetLabel(&quot;Exiting&quot;) &amp; &quot; &quot; &amp; psSub &amp; &quot; ...&quot;, False) If _A2B_.MinimalTraceLevel = 1 Then TraceLog(TRACEDEBUG, _GetLabel(&quot;Exiting&quot;) &amp; &quot; &quot; &amp; psSub &amp; &quot; ...&quot;, False)
End Sub &apos; ResetCalledSub End Sub &apos; ResetCalledSub
......
...@@ -25,4 +25,5 @@ ...@@ -25,4 +25,5 @@
<library:element library:name="Field"/> <library:element library:name="Field"/>
<library:element library:name="DataDef"/> <library:element library:name="DataDef"/>
<library:element library:name="Recordset"/> <library:element library:name="Recordset"/>
<library:element library:name="TempVar"/>
</library:library> </library:library>
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment