[Libreoffice-commits] core.git: wizards/Package_access2base.mk wizards/source
Jean-Pierre Ledure
jp at ledure.be
Sun Oct 5 09:14:26 PDT 2014
wizards/Package_access2base.mk | 1
wizards/source/access2base/Application.xba | 89 +++++++++++-
wizards/source/access2base/Collect.xba | 117 ++++++++++++++--
wizards/source/access2base/Dialog.xba | 4
wizards/source/access2base/Event.xba | 5
wizards/source/access2base/L10N.xba | 2
wizards/source/access2base/PropertiesGet.xba | 26 ++-
wizards/source/access2base/PropertiesSet.xba | 5
wizards/source/access2base/TempVar.xba | 191 +++++++++++++++++++++++++++
wizards/source/access2base/Utils.xba | 12 +
wizards/source/access2base/script.xlb | 3
11 files changed, 411 insertions(+), 44 deletions(-)
New commits:
commit 58192e3f7529af877b935f2cd390b8ddaf00459f
Author: Jean-Pierre Ledure <jp at ledure.be>
Date: Sun Oct 5 18:03:17 2014 +0200
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
diff --git a/wizards/Package_access2base.mk b/wizards/Package_access2base.mk
index 2f551c1..7471d1c 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 3dbf894..14a2fdd 100644
--- a/wizards/source/access2base/Application.xba
+++ b/wizards/source/access2base/Application.xba
@@ -86,6 +86,7 @@ Global Const COLLPROPERTIES = "PROPERTIES"
Global Const COLLQUERYDEFS = "QUERYDEFS"
Global Const COLLRECORDSETS = "RECORDSETS"
Global Const COLLTABLEDEFS = "TABLEDEFS"
+Global Const COLLTEMPVARS = "TEMPVARS"
REM -----------------------------------------------------------------------------------------------------------------------
Global Const OBJAPPLICATION = "APPLICATION"
@@ -102,6 +103,7 @@ Global Const OBJQUERYDEF = "QUERYDEF"
Global Const OBJRECORDSET = "RECORDSET"
Global Const OBJSUBFORM = "SUBFORM"
Global Const OBJTABLEDEF = "TABLEDEF"
+Global Const OBJTEMPVAR = "TEMPVAR"
REM -----------------------------------------------------------------------------------------------------------------------
Global Const CTLCONTROL = "CONTROL" ' ClassId
@@ -152,6 +154,7 @@ Type Root
FindRecord As Object
StatusBar As Object
Dialogs As Object ' Collection
+ TempVars As Object ' Collection
CurrentDoc() As Variant ' Array of document containers - [0] = Base document, [1 ... N] = other documents
End Type
@@ -1131,6 +1134,60 @@ Error_Arg:
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 -----------------------------------------------------------------------------------------------------------------------
Public Function Version() As String
Version = Utils._GetProductName()
End Function ' Version V0.9.1
@@ -1226,10 +1283,12 @@ Const cstBase = "com.sun.star.comp.dba.ODatabaseDocument"
With .CurrentDoc(0)
If Not .Active 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 Not Utils._hasUNOProperty(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 Not Utils._hasUNOProperty(ThisComponent.Parent, "URL") Then Goto Trace_Error
If .Document.URL <> ThisComponent.Parent.URL Then Goto Trace_Error
End If
End With
@@ -1246,20 +1305,28 @@ Trace_Error:
End Function ' _CurrentDoc V1.1.0
REM -----------------------------------------------------------------------------------------------------------------------
-Public Function _hasDialog(ByVal psName As String) As Boolean
-' Return True if psName if in the collection of started dialogs
+Public Function _hasItem(psCollType As String, ByVal psName As String) As Boolean
+' Return True if psName if in the collection
-Dim oDialog As Object
+Dim oItem As Object
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
Error_Function: ' Item by key aborted
- _hasDialog = False
+ _hasItem = False
GoTo Exit_Function
-End Function ' _hasDialog V1.1.0
+End Function ' _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 ' _NewBar V1.1.0
REM -----------------------------------------------------------------------------------------------------------------------
-Public Sub _RootInit()
-' Initialize _A2B_ global variable
+Public Sub _RootInit(Optional ByVal pbForce As Boolean)
+' 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 34feab0..ebbf6fc 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) ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ 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
-' 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
+' Append a new TableDef or TempVar object to the TableDefs/TempVars collections
Const cstThisSub = "Collection.Add"
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 <> 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 = "" 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 ' 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 ' 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 --- PRIVATE FUNCTIONS ---
REM -----------------------------------------------------------------------------------------------------------------------
Private Function _PropertiesList() As Variant
@@ -320,6 +407,4 @@ Error_Function:
_PropertyGet = Nothing
GoTo Exit_Function
End Function ' _PropertyGet
-
-
</script:module>
\ No newline at end of file
diff --git a/wizards/source/access2base/Dialog.xba b/wizards/source/access2base/Dialog.xba
index 7847438..00ba51e 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) ' Inserted to solve errors, when aborts between start and terminate
+ If Application._hasItem(COLLALLDIALOGS, _Name) Then .Dialogs.Remove(_Name) ' 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("Height")
_PropertyGet = UnoDialog.getPosSize().Height
Case UCase("IsLoaded")
- _PropertyGet = Application._hasDialog(_Name)
+ _PropertyGet = Application._hasItem(COLLALLDIALOGS, _Name)
Case UCase("Name")
_PropertyGet = _Name
Case UCase("ObjectType")
diff --git a/wizards/source/access2base/Event.xba b/wizards/source/access2base/Event.xba
index 73bcd82..ddf37aa 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), "", "XPos")
sYPos = Iif(IsNull(_YPos), "", "YPos")
- _PropertiesList = Utils._TrimArray("ButtonLeft", "ButtonRight", "ButtonMiddle", "ClickCount" _
+ _PropertiesList = Utils._TrimArray(Array( _
+ "ButtonLeft", "ButtonRight", "ButtonMiddle", "ClickCount" _
, "ContextShortcut", "EventName", "EventType", "FocusChangeTemporary", _
, "KeyAlt", "KeyChar", "KeyCode", "KeyCtrl", "KeyFunction", "KeyShift" _
, "ObjectType", "Recommendation", "RowChangeAction", "Source" _
, sSubComponentName, sSubComponentType, sXPos, sYPos _
- )
+ ))
End Function ' _PropertiesList
diff --git a/wizards/source/access2base/L10N.xba b/wizards/source/access2base/L10N.xba
index b5f99a0..3ec24d2 100644
--- a/wizards/source/access2base/L10N.xba
+++ b/wizards/source/access2base/L10N.xba
@@ -84,6 +84,7 @@ Dim sLocal As String
Case "REPORT" : sLocal = "Report"
Case "RECORDSET" : sLocal = "Recordset"
Case "FIELD" : sLocal = "Field"
+ Case "TEMPVAR" : sLocal = "Temporary variable"
'----------------------------------------------------------------------------------------------------------------------
Case "ERR#" : sLocal = "Error #"
Case "ERROCCUR" : sLocal = "occurred"
@@ -188,6 +189,7 @@ Dim sLocal As String
Case "REPORT" : sLocal = "Rapport"
Case "RECORDSET" : sLocal = "Recordset"
Case "FIELD" : sLocal = "Champ"
+ Case "TEMPVAR" : sLocal = "Variable temporaire"
'----------------------------------------------------------------------------------------------------------------------
Case "ERR#" : sLocal = "L'erreur #"
Case "ERROCCUR" : sLocal = "s'est produite"
diff --git a/wizards/source/access2base/PropertiesGet.xba b/wizards/source/access2base/PropertiesGet.xba
index e5bee5f..d4df22c 100644
--- a/wizards/source/access2base/PropertiesGet.xba
+++ b/wizards/source/access2base/PropertiesGet.xba
@@ -394,7 +394,8 @@ Const cstEXCLAMATION = "!"
Const cstDOT = "."
If _ErrorHandler() Then On Local Error Goto Error_Function
- Utils._SetCalledSub("getObject")
+Const cstThisSub = "getObject"
+ 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("FORMS", "DIALOGS")) Then Goto Trace_Error
+ If Not Utils._InList(UCase(sComponents(0)), Array("FORMS", "DIALOGS", "TEMPVARS")) Then Goto Trace_Error
If sComponents(1) = "0" Or Left(sComponents(1), 2) = "0." 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 "FORMS" : vCurrentObject._CollType = COLLFORMS
Case "DIALOGS" : vCurrentObject._CollType = COLLALLDIALOGS
+ Case "TEMPVARS" : vCurrentObject._CollType = COLLTEMPVARS
End Select
For iCurrentIndex = 1 To UBound(sComponents) ' 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) > 1 Then Goto Trace_Error
+ vCurrentObject = Application.TempVars(sComponents(1))
'Case Else
End Select
Case OBJFORM, OBJSUBFORM, OBJCONTROL, OBJDIALOG
@@ -450,13 +455,13 @@ Dim oDoc As Object
Set getObject = vCurrentObject
Exit_Function:
- Utils._ResetCalledSub("getObject")
+ Utils._ResetCalledSub(cstThisSub)
Exit Function
Trace_Error:
TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(1, pvShortcut))
Goto Exit_Function
Error_Function:
- TraceError(TRACEABORT, Err, "getObject", Erl)
+ TraceError(TRACEABORT, Err, cstThisSub, Erl)
GoTo Exit_Function
End Function ' getObject V0.9.5
@@ -733,6 +738,9 @@ Public Function _getProperty(pvItem As Variant, ByVal psProperty As String, ByVa
Utils._SetCalledSub("get" & psProperty)
_getProperty = Nothing
+'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
'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("Locked")
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("MultiSelect")
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
_getProperty = pvItem.MultiSelect
Case UCase("Name")
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("ObjectType")
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("OpenArgs")
@@ -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("Value")
- 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("Visible")
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 c6422cd..d60c3ce 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("set" & psProperty)
If _ErrorHandler() Then On Local Error Goto Error_Function
+'pvItem must be an object and have the requested property
+ If Not Utils._CheckArgument(pvIndex, 1, vbObject) Then Goto Exit_Function
'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 = "setProperty" 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("AbsolutePosition")
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("Value")
- 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("Visible")
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 0000000..f3230ed
--- /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 ' Must be TEMPVAR
+Private _Name As String
+Private _Value As Variant
+
+REM -----------------------------------------------------------------------------------------------------------------------
+REM --- CONSTRUCTORS / DESTRUCTORS ---
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Sub Class_Initialize()
+ _Type = OBJTEMPVAR
+ _Name = ""
+ _Value = Null
+End Sub ' Constructor
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Sub Class_Terminate()
+ On Local Error Resume Next
+ Call Class_Initialize()
+End Sub ' Destructor
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Sub Dispose()
+ Call Class_Terminate()
+End Sub ' Explicit destructor
+
+REM -----------------------------------------------------------------------------------------------------------------------
+REM --- CLASS GET/LET/SET PROPERTIES ---
+REM -----------------------------------------------------------------------------------------------------------------------
+
+Property Get Name() As String
+ Name = _PropertyGet("Name")
+End Property ' Name (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get ObjectType() As String
+ ObjectType = _PropertyGet("ObjectType")
+End Property ' ObjectType (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get Value() As Variant
+ Value = _PropertyGet("Value")
+End Property ' Value (get)
+
+Property Let Value(ByVal pvValue As Variant)
+ Call _PropertySet("Value", pvValue)
+End Property ' Value (set)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+REM --- CLASS METHODS ---
+REM -----------------------------------------------------------------------------------------------------------------------
+
+Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
+' Return property value of psProperty property name
+
+ Utils._SetCalledSub("Property.getProperty")
+ If IsMissing(pvProperty) Then Call _TraceArguments()
+ getProperty = _PropertyGet(pvProperty)
+ Utils._ResetCalledSub("Property.getProperty")
+
+End Function ' getProperty
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
+' Return True if object has a valid property called pvProperty (case-insensitive comparison !)
+
+ If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
+ Exit Function
+
+End Function ' hasProperty
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
+' Return
+' a Collection object if pvIndex absent
+' a Property object otherwise
+
+Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
+ vPropertiesList = _PropertiesList()
+ sObject = Utils._PCase(_Type)
+ If IsMissing(pvIndex) Then
+ vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList)
+ Else
+ vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList, pvIndex)
+ vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
+ End If
+
+Exit_Function:
+ Set Properties = vProperty
+ Exit Function
+End Function ' Properties
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean
+' Return True if property setting OK
+Dim cstThisSub As String
+ cstThisSub = Utils._PCase(_Type) & ".getProperty"
+ Utils._SetCalledSub(cstThisSub)
+ setProperty = _PropertySet(psProperty, pvValue)
+ Utils._ResetCalledSub(cstThisSub)
+End Function
+
+REM -----------------------------------------------------------------------------------------------------------------------
+REM --- PRIVATE FUNCTIONS ---
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _PropertiesList() As Variant
+ _PropertiesList = Array("Name", "ObjectType", "Value")
+End Function ' _PropertiesList
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _PropertyGet(ByVal psProperty As String) As Variant
+' Return property value of the psProperty property name
+
+ If _ErrorHandler() Then On Local Error Goto Error_Function
+ Utils._SetCalledSub("TempVar.get" & psProperty)
+ _PropertyGet = Nothing
+
+ Select Case UCase(psProperty)
+ Case UCase("Name")
+ _PropertyGet = _Name
+ Case UCase("ObjectType")
+ _PropertyGet = _Type
+ Case UCase("Value")
+ _PropertyGet = _Value
+ Case Else
+ Goto Trace_Error
+ End Select
+
+Exit_Function:
+ Utils._ResetCalledSub("TempVar.get" & psProperty)
+ Exit Function
+Trace_Error:
+ TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
+ _PropertyGet = Nothing
+ Goto Exit_Function
+Error_Function:
+ TraceError(TRACEABORT, Err, "TempVar._PropertyGet", Erl)
+ _PropertyGet = Nothing
+ GoTo Exit_Function
+End Function ' _PropertyGet
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
+
+ Utils._SetCalledSub("TempVar.set" & psProperty)
+ If _ErrorHandler() Then On Local Error Goto Error_Function
+ _PropertySet = True
+
+'Execute
+Dim iArgNr As Integer
+
+ If Len(_A2B_.CalledSub) > 8 And Left(_A2B_.CalledSub, 8) = "TempVar." Then iArgNr = 1 Else iArgNr = 2
+ Select Case UCase(psProperty)
+ Case UCase("Value")
+ _Value = pvValue
+ _A2B_.TempVars.Item(UCase(_Name)).Value = pvValue
+ Case Else
+ Goto Trace_Error
+ End Select
+
+Exit_Function:
+ Utils._ResetCalledSub("TempVar.set" & psProperty)
+ Exit Function
+Trace_Error:
+ TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
+ _PropertySet = False
+ Goto Exit_Function
+Trace_Error_Value:
+ TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty))
+ _PropertySet = False
+ Goto Exit_Function
+Error_Function:
+ TraceError(TRACEABORT, Err, "TempVar._PropertySet", Erl)
+ _PropertySet = False
+ GoTo Exit_Function
+End Function ' _PropertySet
+</script:module>
\ No newline at end of file
diff --git a/wizards/source/access2base/Utils.xba b/wizards/source/access2base/Utils.xba
index 5a9b302..ace29d9 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 = "[com.sun.star.script.NativeObjectWrapper]"
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 <> "" Then ' 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 <> "" And Not IsNull(.Column) )
+ Case OBJTEMPVAR
+ If ._Name <> "" Then ' 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
' Called in bottom of each public function. _A2B_.CalledSub variable is used for error handling
' Used to trace routine in/outs and to clarify error messages
+ If IsEmpty(_A2B_) Then Call Application._RootInit() ' Only is Utils module recompiled
If _A2B_.CalledSub = psSub Then _A2B_.CalledSub = ""
If _A2B_.MinimalTraceLevel = 1 Then TraceLog(TRACEDEBUG, _GetLabel("Exiting") & " " & psSub & " ...", False)
End Sub ' 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 ' TrimArray V0.9.0
diff --git a/wizards/source/access2base/script.xlb b/wizards/source/access2base/script.xlb
index 7bc8a9c..78efee9 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>
More information about the Libreoffice-commits
mailing list