summaryrefslogtreecommitdiff
path: root/wizards
diff options
context:
space:
mode:
authorJean-Pierre Ledure <jp@ledure.be>2014-10-05 18:03:17 +0200
committerJean-Pierre Ledure <jp@ledure.be>2014-10-05 18:13:55 +0200
commit58192e3f7529af877b935f2cd390b8ddaf00459f (patch)
tree5c2d9846264d3f675e42a9f631b0fef53e3c9f76 /wizards
parentf83f61bc984d35eff27bf0c736675d27eb9e1d37 (diff)
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
Diffstat (limited to 'wizards')
-rw-r--r--wizards/Package_access2base.mk1
-rw-r--r--wizards/source/access2base/Application.xba89
-rw-r--r--wizards/source/access2base/Collect.xba117
-rw-r--r--wizards/source/access2base/Dialog.xba4
-rw-r--r--wizards/source/access2base/Event.xba5
-rw-r--r--wizards/source/access2base/L10N.xba2
-rw-r--r--wizards/source/access2base/PropertiesGet.xba26
-rw-r--r--wizards/source/access2base/PropertiesSet.xba5
-rw-r--r--wizards/source/access2base/TempVar.xba191
-rw-r--r--wizards/source/access2base/Utils.xba12
-rw-r--r--wizards/source/access2base/script.xlb3
11 files changed, 411 insertions, 44 deletions
diff --git a/wizards/Package_access2base.mk b/wizards/Package_access2base.mk
index 2f551c139f62..7471d1ce8a07 100644
--- a/wizards/Package_access2base.mk
+++ b/wizards/Package_access2base.mk
@@ -45,6 +45,7 @@ $(eval $(call gb_Package_add_files,wizards_basicsrvaccess2base,$(LIBO_SHARE_FOLD
Recordset.xba \
script.xlb \
SubForm.xba \
+ TempVar.xba \
Test.xba \
Trace.xba \
Utils.xba \
diff --git a/wizards/source/access2base/Application.xba b/wizards/source/access2base/Application.xba
index 3dbf8945e81c..14a2fdd9ccee 100644
--- a/wizards/source/access2base/Application.xba
+++ b/wizards/source/access2base/Application.xba
@@ -86,6 +86,7 @@ Global Const COLLPROPERTIES = &quot;PROPERTIES&quot;
Global Const COLLQUERYDEFS = &quot;QUERYDEFS&quot;
Global Const COLLRECORDSETS = &quot;RECORDSETS&quot;
Global Const COLLTABLEDEFS = &quot;TABLEDEFS&quot;
+Global Const COLLTEMPVARS = &quot;TEMPVARS&quot;
REM -----------------------------------------------------------------------------------------------------------------------
Global Const OBJAPPLICATION = &quot;APPLICATION&quot;
@@ -102,6 +103,7 @@ Global Const OBJQUERYDEF = &quot;QUERYDEF&quot;
Global Const OBJRECORDSET = &quot;RECORDSET&quot;
Global Const OBJSUBFORM = &quot;SUBFORM&quot;
Global Const OBJTABLEDEF = &quot;TABLEDEF&quot;
+Global Const OBJTEMPVAR = &quot;TEMPVAR&quot;
REM -----------------------------------------------------------------------------------------------------------------------
Global Const CTLCONTROL = &quot;CONTROL&quot; &apos; ClassId
@@ -152,6 +154,7 @@ Type Root
FindRecord As Object
StatusBar As Object
Dialogs As Object &apos; Collection
+ TempVars As Object &apos; Collection
CurrentDoc() As Variant &apos; Array of document containers - [0] = Base document, [1 ... N] = other documents
End Type
@@ -1131,6 +1134,60 @@ Error_Arg:
End Function &apos; SysCmd V0.9.1
REM -----------------------------------------------------------------------------------------------------------------------
+Public Function TempVars(ByVal Optional pvIndex As Variant) As Variant
+&apos; Return either a Collection or a TempVar object
+
+ If _ErrorHandler() Then On Local Error Goto Error_Function
+Const cstThisSub = &quot;TempVars&quot;
+ 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 &apos; Build Collection object
+ Set vTempVars = New Collect
+ With vTempVars
+ ._CollType = COLLTEMPVARS
+ ._Count = _A2B_.TempVars.Count
+ End With
+ Case cstByIndex &apos; Build TempVar object
+ If pvIndex &lt; 0 Or pvIndex &gt;= _A2B_.TempVars.Count Then Goto Trace_Error_Index
+ Set vTempVars = _A2B_.TempVars.Item(pvIndex + 1) &apos; 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(&quot;TEMPVAR&quot;), pvIndex))
+ Goto Exit_Function
+End Function &apos; TempVars V1.2.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
Public Function Version() As String
Version = Utils._GetProductName()
End Function &apos; Version V0.9.1
@@ -1226,10 +1283,12 @@ Const cstBase = &quot;com.sun.star.comp.dba.ODatabaseDocument&quot;
With .CurrentDoc(0)
If Not .Active Then GoTo Trace_Error
If IsNull(.Document) Then GoTo Trace_Error
+ If Not Utils._hasUNOProperty(ThisComponent, &quot;URL&quot;) Then Goto Trace_Error
If Utils._ImplementationName(ThisComponent) &lt;&gt; cstBase Or .Document.URL &lt;&gt; ThisComponent.URL Then &apos; Give the parent a try
If Not Utils._hasUNOProperty(ThisComponent, &quot;Parent&quot;) Then Goto Trace_Error
If IsNull(ThisComponent.Parent) Then Goto Trace_Error
If Utils._ImplementationName(ThisComponent.Parent) &lt;&gt; cstBase Then Goto Trace_Error
+ If Not Utils._hasUNOProperty(ThisComponent.Parent, &quot;URL&quot;) Then Goto Trace_Error
If .Document.URL &lt;&gt; ThisComponent.Parent.URL Then Goto Trace_Error
End If
End With
@@ -1246,20 +1305,28 @@ Trace_Error:
End Function &apos; _CurrentDoc V1.1.0
REM -----------------------------------------------------------------------------------------------------------------------
-Public Function _hasDialog(ByVal psName As String) As Boolean
-&apos; Return True if psName if in the collection of started dialogs
+Public Function _hasItem(psCollType As String, ByVal psName As String) As Boolean
+&apos; Return True if psName if in the collection
-Dim oDialog As Object
+Dim oItem As Object
On Local Error Goto Error_Function &apos; 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
Error_Function: &apos; Item by key aborted
- _hasDialog = False
+ _hasItem = False
GoTo Exit_Function
-End Function &apos; _hasDialog V1.1.0
+End Function &apos; _hasItem V1.2.0
REM -----------------------------------------------------------------------------------------------------------------------
Private Function _NewBar() As Object
@@ -1297,11 +1364,12 @@ Dim vBar As Variant, vWindow As Variant, vController As Object
End Function &apos; _NewBar V1.1.0
REM -----------------------------------------------------------------------------------------------------------------------
-Public Sub _RootInit()
-&apos; Initialize _A2B_ global variable
+Public Sub _RootInit(Optional ByVal pbForce As Boolean)
+&apos; Initialize _A2B_ global variable. Reinit forced if pbForce = True
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
With _A2B_
.VersionNumber = Access2Base_Version
@@ -1316,6 +1384,7 @@ Dim vRoot As Root, vCurrentDoc() As Variant
Set .FindRecord = Nothing
Set .StatusBar = Nothing
Set .Dialogs = New Collection
+ Set .TempVars = New Collection
vCurrentDoc() = Array()
ReDim vCurrentDoc(0 To 0)
Set vCurrentDoc(0) = Nothing
diff --git a/wizards/source/access2base/Collect.xba b/wizards/source/access2base/Collect.xba
index 34feab0236c3..ebbf6fcc14b3 100644
--- a/wizards/source/access2base/Collect.xba
+++ b/wizards/source/access2base/Collect.xba
@@ -88,7 +88,7 @@ Dim vNames() As Variant, oProperty As Object
Case COLLFIELDS
Select Case _ParentType
Case OBJQUERYDEF
- Set Item = _ParentDatabase.QueryDefs(_ParentName).Fields(pvItem) &apos; &lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;
+ Set Item = _ParentDatabase.QueryDefs(_ParentName).Fields(pvItem)
Case OBJRECORDSET
Set Item = _ParentDatabase.Recordsets(_ParentName).Fields(pvItem)
Case OBJTABLEDEF
@@ -129,10 +129,13 @@ Dim vNames() As Variant, oProperty As Object
Set Item = _ParentDatabase.Recordsets(pvItem)
Case COLLTABLEDEFS
Set Item = _ParentDatabase.TableDefs(pvItem)
+ Case COLLTEMPVARS
+ Set Item = Application.TempVars(pvItem)
Case Else
End Select
Exit_Function:
+ Utils._ResetCalledSub(cstThisSub)
Exit Property
Error_Function:
TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl)
@@ -170,21 +173,23 @@ REM ----------------------------------------------------------------------------
REM --- CLASS METHODS ---
REM -----------------------------------------------------------------------------------------------------------------------
-Public Function Add(Optional pvObject As Variant) As Boolean
-&apos; Append a new TableDef or Field object to the TableDefs/Fields collections
+Public Function Add(Optional pvNew As Variant, Optional pvValue As Variant) As Boolean
+&apos; Append a new TableDef or TempVar object to the TableDefs/TempVars collections
Const cstThisSub = &quot;Collection.Add&quot;
Utils._SetCalledSub(cstThisSub)
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
- If IsMissing(pvObject) Then Call _TraceArguments()
- If Not Utils._CheckArgument(pvObject, 1, vbObject) Then Goto Exit_Function
+ If IsMissing(pvNew) Then Call _TraceArguments()
- With pvObject
- Select Case ._Type
- Case OBJTABLEDEF
+ Select Case _CollType
+ Case COLLTABLEDEFS
+ If Not Utils._CheckArgument(pvObject, 1, vbObject) Then Goto Exit_Function
+ Set vObject = pvNew
+ With vObject
Set odbDatabase = ._ParentDatabase
If odbDatabase._DbConnect &lt;&gt; DBCONNECTBASE Then Goto Error_NotApplicable
Set oConnection = odbDatabase.Connection
@@ -196,11 +201,21 @@ Dim odbDatabase As Object, oConnection As Object, oTables As Object, sName As St
Set .TableDescriptor = Nothing
.TableFieldsCount = 0
.TableKeysCount = 0
- Case Else
- Goto Error_NotApplicable
- End Select
- End With
+ End With
+ Case COLLTEMPVARS
+ If Not Utils._CheckArgument(pvNew, 1, vbString) Then Goto Exit_Function
+ If pvNew = &quot;&quot; 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
+ Goto Error_NotApplicable
+ End Select
+ _Count = _Count + 1
Add = True
Exit_Function:
@@ -213,7 +228,11 @@ Error_NotApplicable:
TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
Goto Exit_Function
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
End Function &apos; Add V1.1.0
@@ -247,6 +266,7 @@ Dim odbDatabase As Object, oColl As Object, vName As Variant
Goto Error_NotApplicable
End Select
+ _Count = _Count - 1
Delete = True
Exit_Function:
@@ -284,6 +304,73 @@ Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
End Function &apos; hasProperty
REM -----------------------------------------------------------------------------------------------------------------------
+Public Function Remove(ByVal Optional pvName As Variant) As Boolean
+&apos; Remove a TempVar from the TempVars collection
+
+Const cstThisSub = &quot;Collection.Remove&quot;
+ 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 = &quot;&quot;
+ If Not Utils._CheckArgument(pvName, 1, vbString) Then Goto Exit_Function
+ If pvName = &quot;&quot; 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 &apos; Remove V1.2.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function RemoveAll() As Boolean
+&apos; Remove the whole TempVars collection
+
+Const cstThisSub = &quot;Collection.Remove&quot;
+ 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 &apos; RemoveAll V1.2.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
REM --- PRIVATE FUNCTIONS ---
REM -----------------------------------------------------------------------------------------------------------------------
Private Function _PropertiesList() As Variant
@@ -320,6 +407,4 @@ Error_Function:
_PropertyGet = Nothing
GoTo Exit_Function
End Function &apos; _PropertyGet
-
-
</script:module> \ No newline at end of file
diff --git a/wizards/source/access2base/Dialog.xba b/wizards/source/access2base/Dialog.xba
index 7847438056c2..00ba51ec933f 100644
--- a/wizards/source/access2base/Dialog.xba
+++ b/wizards/source/access2base/Dialog.xba
@@ -487,7 +487,7 @@ Dim oStart As Object
Start = True
Set UnoDialog = oStart
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))
End With
End If
@@ -574,7 +574,7 @@ Dim vEMPTY As Variant
Case UCase(&quot;Height&quot;)
_PropertyGet = UnoDialog.getPosSize().Height
Case UCase(&quot;IsLoaded&quot;)
- _PropertyGet = Application._hasDialog(_Name)
+ _PropertyGet = Application._hasItem(COLLALLDIALOGS, _Name)
Case UCase(&quot;Name&quot;)
_PropertyGet = _Name
Case UCase(&quot;ObjectType&quot;)
diff --git a/wizards/source/access2base/Event.xba b/wizards/source/access2base/Event.xba
index 73bcd8222546..ddf37aac3da4 100644
--- a/wizards/source/access2base/Event.xba
+++ b/wizards/source/access2base/Event.xba
@@ -404,12 +404,13 @@ Dim sXPos As String, sYPos As String
sXPos = Iif(IsNull(_XPos), &quot;&quot;, &quot;XPos&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;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; _
, sSubComponentName, sSubComponentType, sXPos, sYPos _
- )
+ ))
End Function &apos; _PropertiesList
diff --git a/wizards/source/access2base/L10N.xba b/wizards/source/access2base/L10N.xba
index b5f99a0d7b95..3ec24d22b9c9 100644
--- a/wizards/source/access2base/L10N.xba
+++ b/wizards/source/access2base/L10N.xba
@@ -84,6 +84,7 @@ Dim sLocal As String
Case &quot;REPORT&quot; : sLocal = &quot;Report&quot;
Case &quot;RECORDSET&quot; : sLocal = &quot;Recordset&quot;
Case &quot;FIELD&quot; : sLocal = &quot;Field&quot;
+ Case &quot;TEMPVAR&quot; : sLocal = &quot;Temporary variable&quot;
&apos;----------------------------------------------------------------------------------------------------------------------
Case &quot;ERR#&quot; : sLocal = &quot;Error #&quot;
Case &quot;ERROCCUR&quot; : sLocal = &quot;occurred&quot;
@@ -188,6 +189,7 @@ Dim sLocal As String
Case &quot;REPORT&quot; : sLocal = &quot;Rapport&quot;
Case &quot;RECORDSET&quot; : sLocal = &quot;Recordset&quot;
Case &quot;FIELD&quot; : sLocal = &quot;Champ&quot;
+ Case &quot;TEMPVAR&quot; : sLocal = &quot;Variable temporaire&quot;
&apos;----------------------------------------------------------------------------------------------------------------------
Case &quot;ERR#&quot; : sLocal = &quot;L&apos;erreur #&quot;
Case &quot;ERROCCUR&quot; : sLocal = &quot;s&apos;est produite&quot;
diff --git a/wizards/source/access2base/PropertiesGet.xba b/wizards/source/access2base/PropertiesGet.xba
index e5bee5f6f8a5..d4df22c23b6e 100644
--- a/wizards/source/access2base/PropertiesGet.xba
+++ b/wizards/source/access2base/PropertiesGet.xba
@@ -394,7 +394,8 @@ Const cstEXCLAMATION = &quot;!&quot;
Const cstDOT = &quot;.&quot;
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 Not Utils._CheckArgument(pvShortcut, 1, vbString) Then Goto Exit_Function
@@ -404,7 +405,7 @@ Dim oDoc As Object
Set vCurrentObject = Nothing
sComponents = Split(Trim(pvShortcut), cstEXCLAMATION)
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
Set oDoc = _A2B_.CurrentDoc(Application._CurrentDoc())
If oDoc.DbConnect = DBCONNECTFORM Then sComponents(1) = oDoc.DbContainers(0).FormName Else Goto Trace_Error
@@ -417,6 +418,7 @@ Dim oDoc As Object
Select Case UCase(sComponents(0))
Case &quot;FORMS&quot; : vCurrentObject._CollType = COLLFORMS
Case &quot;DIALOGS&quot; : vCurrentObject._CollType = COLLALLDIALOGS
+ Case &quot;TEMPVARS&quot; : vCurrentObject._CollType = COLLTEMPVARS
End Select
For iCurrentIndex = 1 To UBound(sComponents) &apos; Start parsing ...
sSubComponents = Split(sComponents(iCurrentIndex), cstDOT)
@@ -439,6 +441,9 @@ Dim oDoc As Object
vCurrentObject = Application.AllDialogs(sDialog)
If Not vCurrentObject.IsLoaded Then Goto Trace_Error
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
End Select
Case OBJFORM, OBJSUBFORM, OBJCONTROL, OBJDIALOG
@@ -450,13 +455,13 @@ Dim oDoc As Object
Set getObject = vCurrentObject
Exit_Function:
- Utils._ResetCalledSub(&quot;getObject&quot;)
+ Utils._ResetCalledSub(cstThisSub)
Exit Function
Trace_Error:
TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(1, pvShortcut))
Goto Exit_Function
Error_Function:
- TraceError(TRACEABORT, Err, &quot;getObject&quot;, Erl)
+ TraceError(TRACEABORT, Err, cstThisSub, Erl)
GoTo Exit_Function
End Function &apos; getObject V0.9.5
@@ -733,6 +738,9 @@ Public Function _getProperty(pvItem As Variant, ByVal psProperty As String, ByVa
Utils._SetCalledSub(&quot;get&quot; &amp; psProperty)
_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
If Not IsMissing(pvIndex) Then
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
Case UCase(&quot;Locked&quot;)
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
If IsNull(pvItem.Locked) Then Goto Trace_Error
- _getProperty = pvItem.Locked
+ _ge ExitProperty = pvItem.Locked
Case UCase(&quot;MultiSelect&quot;)
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
_getProperty = pvItem.MultiSelect
Case UCase(&quot;Name&quot;)
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
_getProperty = pvItem.Name
Case UCase(&quot;ObjectType&quot;)
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
_getProperty = pvItem.ObjectType
Case UCase(&quot;OpenArgs&quot;)
@@ -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
_getProperty = pvItem.TypeName
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
Case UCase(&quot;Visible&quot;)
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
Set vProperties = Nothing
Select Case pvObject._Type
Case OBJCOLLECTION, OBJPROPERTY, OBJFORM, OBJEVENT, OBJSUBFORM, OBJCONTROL, OBJOPTIONGROUP _
- , OBJDATABASE, OBJTABLEDEF, OBJQUERYDEF, OBJDIALOG, OBJFIELD, OBJRECORDSET
+ , OBJDATABASE, OBJTABLEDEF, OBJQUERYDEF, OBJDIALOG, OBJFIELD, OBJRECORDSET, OBJTEMPVAR
vPropertiesList = pvObject._PropertiesList()
Case Else
End Select
diff --git a/wizards/source/access2base/PropertiesSet.xba b/wizards/source/access2base/PropertiesSet.xba
index c6422cd3eb85..d60c3cee12a3 100644
--- a/wizards/source/access2base/PropertiesSet.xba
+++ b/wizards/source/access2base/PropertiesSet.xba
@@ -375,6 +375,8 @@ Private Function _setProperty(pvItem As Variant, ByVal psProperty As String, ByV
Utils._SetCalledSub(&quot;set&quot; &amp; psProperty)
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
If Not IsMissing(pvIndex) Then
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
Dim ocButton As Variant, iRadioIndex As Integer
_setProperty = True
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)
Case UCase(&quot;AbsolutePosition&quot;)
If Not Utils._CheckArgument(pvItem, 1, OBJRECORDSET) Then Goto Exit_Function
@@ -529,7 +532,7 @@ Dim ocButton As Variant, iRadioIndex As Integer
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
pvItem.TripleState = pvValue
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
Case UCase(&quot;Visible&quot;)
If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG, OBJCONTROL)) Then Goto Exit_Function
diff --git a/wizards/source/access2base/TempVar.xba b/wizards/source/access2base/TempVar.xba
new file mode 100644
index 000000000000..f3230ed23949
--- /dev/null
+++ b/wizards/source/access2base/TempVar.xba
@@ -0,0 +1,191 @@
+<?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
diff --git a/wizards/source/access2base/Utils.xba b/wizards/source/access2base/Utils.xba
index 5a9b302c093a..ace29d9104ec 100644
--- a/wizards/source/access2base/Utils.xba
+++ b/wizards/source/access2base/Utils.xba
@@ -103,6 +103,7 @@ Dim iVarType As Integer
If VarType(pvItem) = vbCurrency Or VarType(pvItem) = vbDecimal Or VarType(pvItem) = vbBigint Then pvItem = CDbl(pvItem)
Exit_Function:
+Const cstObject = &quot;[com.sun.star.script.NativeObjectWrapper]&quot;
If Not _CheckArgument Then
If IsMissing(pvError) Then pvError = True
If pvError Then
@@ -502,8 +503,8 @@ Dim oDoc As Object, oForms As Variant
If ._DbConnect = DBCONNECTFORM Then bPseudoExists = True Else bPseudoExists = .Document.CurrentController.IsConnected
Case OBJDIALOG
If ._Name &lt;&gt; &quot;&quot; Then &apos; Check validity of dialog name
- bPseudoExists = ( Application._hasDialog(._Name) )
- End If
+ bPseudoExists = ( Application._hasItem(COLLALLDIALOGS, ._Name) )
+ End If
Case OBJCOLLECTION
bPseudoExists = True
Case OBJCONTROL
@@ -532,6 +533,10 @@ Dim oDoc As Object, oForms As Variant
bPseudoExists = ( Not IsNull(.RowSet) )
Case OBJFIELD
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
End Select
End With
@@ -592,6 +597,7 @@ REM ----------------------------------------------------------------------------
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; 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_.MinimalTraceLevel = 1 Then TraceLog(TRACEDEBUG, _GetLabel(&quot;Exiting&quot;) &amp; &quot; &quot; &amp; psSub &amp; &quot; ...&quot;, False)
End Sub &apos; ResetCalledSub
@@ -665,7 +671,7 @@ Dim sTrim As String, vTrim() As Variant, i As Integer, j As Integer, iCount As I
Next i
End If
End If
-
+
_TrimArray() = vTrim()
End Function &apos; TrimArray V0.9.0
diff --git a/wizards/source/access2base/script.xlb b/wizards/source/access2base/script.xlb
index 7bc8a9cf7398..78efee99e8c4 100644
--- a/wizards/source/access2base/script.xlb
+++ b/wizards/source/access2base/script.xlb
@@ -25,4 +25,5 @@
<library:element library:name="Field"/>
<library:element library:name="DataDef"/>
<library:element library:name="Recordset"/>
-</library:library> \ No newline at end of file
+ <library:element library:name="TempVar"/>
+</library:library>