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
author: Jean-Pierre Ledure <jp@ledure.be> 2014-10-05 18:03:17 +0200
committer: Jean-Pierre Ledure <jp@ledure.be> 2014-10-05 18:13:55 +0200
commit: 58192e3f7529af877b935f2cd390b8ddaf00459f (patch)
tree: 5c2d9846264d3f675e42a9f631b0fef53e3c9f76 /wizards/source/access2base
parent: f83f61bc984d35eff27bf0c736675d27eb9e1d37 (diff)
10 files changed, 410 insertions, 44 deletions
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>
author	Jean-Pierre Ledure <jp@ledure.be>	2014-10-05 18:03:17 +0200
committer	Jean-Pierre Ledure <jp@ledure.be>	2014-10-05 18:13:55 +0200
commit	58192e3f7529af877b935f2cd390b8ddaf00459f (patch)
tree	5c2d9846264d3f675e42a9f631b0fef53e3c9f76 /wizards/source/access2base
parent	f83f61bc984d35eff27bf0c736675d27eb9e1d37 (diff)