wizards/source/access2base/Application.xba | 14 +++++++++++
wizards/source/access2base/Collect.xba | 9 +++++--
wizards/source/access2base/CommandBar.xba | 4 +++
wizards/source/access2base/CommandBarControl.xba | 2 +
wizards/source/access2base/Control.xba | 5 ++++
wizards/source/access2base/DataDef.xba | 11 ++++++---
wizards/source/access2base/Database.xba | 18 ++++++++++-----
wizards/source/access2base/Dialog.xba | 8 +++++-
wizards/source/access2base/Field.xba | 2 +
wizards/source/access2base/Form.xba | 8 +++++-
wizards/source/access2base/Methods.xba | 1
wizards/source/access2base/Module.xba | 2 +
wizards/source/access2base/OptionGroup.xba | 4 +++
wizards/source/access2base/PropertiesGet.xba | 3 ++
wizards/source/access2base/Property.xba | 2 +
wizards/source/access2base/Recordset.xba | 6 +++--
wizards/source/access2base/Root_.xba | 18 +++++++++++++++
wizards/source/access2base/SubForm.xba | 5 ++++
wizards/source/access2base/TempVar.xba | 2 +
wizards/source/access2base/Trace.xba | 27 +++++++++++++----------
wizards/source/access2base/Utils.xba | 6 +++--
21 files changed, 125 insertions(+), 32 deletions(-)
New commits:
commit 28dcdd5f6c2204718519e215d2ef5466743536c7
Author: Jean-Pierre Ledure <j...@ledure.be>
AuthorDate: Thu Jun 13 14:42:49 2019 +0200
Commit: Jean-Pierre Ledure <j...@ledure.be>
CommitDate: Thu Jun 13 14:46:27 2019 +0200
Access2Base - Robustness changes
Addition of _This address in every Basic object
Default parameters reviewed when ambiguous
Typo's corrections
diff --git a/wizards/source/access2base/Application.xba
b/wizards/source/access2base/Application.xba
index a29bdd813654..87477163c936 100644
--- a/wizards/source/access2base/Application.xba
+++ b/wizards/source/access2base/Application.xba
@@ -237,6 +237,7 @@ Const cstSepar = "!"
If UBound(vDocLibraries) + UBound(vMacLibraries) < 0 Then
' No library
Set vAllDialogs = New Collect
+ Set vAllDialogs._This = vAllDialogs
vAllDialogs._CollType = COLLALLDIALOGS
vAllDialogs._ParentType = OBJAPPLICATION
vAllDialogs._ParentName = ""
@@ -287,6 +288,7 @@ Const cstSepar = "!"
If iMode = cstCount Then
Set vAllDialogs = New Collect
+ Set vAllDialogs._This = vAllDialogs
vAllDialogs._CollType = COLLALLDIALOGS
vAllDialogs._ParentType = OBJAPPLICATION
vAllDialogs._ParentName = ""
@@ -297,6 +299,7 @@ Const cstSepar = "!"
End If
Set vAllDialogs = New Dialog
With vAllDialogs
+ ._This = vAllDialogs
._Name = vDialogs(j)
._Shortcut = "Dialogs!" & vDialogs(j)
Set ._Dialog = oLibDialog
@@ -362,6 +365,7 @@ Const cstSeparator = "\;"
' Process when NO ARGUMENT
If IsMissing(pvIndex) Then '
No argument
Set oCounter = New Collect
+ Set oCounter._This = oCounter
oCounter._CollType = COLLALLFORMS
oCounter._ParentType = OBJAPPLICATION
oCounter._ParentName = ""
@@ -372,6 +376,7 @@ Const cstSeparator = "\;"
' Process when ARGUMENT = STRING or INDEX => Initialize form object
Set ofForm = New Form
+ Set ofForm._This = ofForm
Select Case vCurrentDoc.DbConnect
Case DBCONNECTBASE
ofForm._DocEntry = 0
@@ -487,6 +492,7 @@ Const cstDot = "."
If UBound(vDocLibraries) + UBound(vMacLibraries) < 0 Then
' No library
Set vAllModules = New Collect
+ Set vAllModules._This = vAllModules
vAllModules._CollType = COLLALLMODULES
vAllModules._ParentType = OBJAPPLICATION
vAllModules._ParentName = ""
@@ -537,6 +543,7 @@ Const cstDot = "."
If iMode = cstCount Then
Set vAllModules = New Collect
+ Set vAllModules._This =vAllModules
vAllModules._CollType = COLLALLMODULES
vAllModules._ParentType = OBJAPPLICATION
vAllModules._ParentName = ""
@@ -546,6 +553,7 @@ Const cstDot = "."
If iMode = cstByIndex Then Goto Trace_Error_Index Else
Goto Trace_Not_Found
End If
Set vAllModules = New Module
+ Set vAllModules._This = vAllModules
vAllModules._Name = vModules(j)
vAllModules._LibraryName = sLibrary
Set vAllModules._Library = oLibrary
@@ -718,6 +726,7 @@ Const cstCustom = "CUSTOM"
Select Case True
Case IsMissing(pvIndex)
Set oObject = New Collect
+ Set oObject._This = oObject
oObject._CollType = COLLCOMMANDBARS
oObject._ParentType = OBJAPPLICATION
oObject._Count = iObjectsCount
@@ -1028,6 +1037,7 @@ Dim iCount As Integer
If IsMissing(pvIndex) Then
iCount = Application._CountOpenForms()
Set oCounter = New Collect
+ Set oCounter._This = oCounter
oCounter._CollType = COLLFORMS
oCounter._ParentType = OBJAPPLICATION
oCounter._ParentName = ""
@@ -1289,7 +1299,7 @@ Public Function OpenDatabase ( _
, ByVal Optional pvUser As Variant _
, ByVal Optional pvPassword As Variant _
, ByVal Optional pvReadOnly As Variant _
- ) As Object
+ ) As Variant
' Return a database object based on input arguments:
' Call template:
@@ -1498,6 +1508,7 @@ Const cstByName = 2
Case cstCount
' Build Collection object
Set vTempVars = New Collect
With vTempVars
+ ._This = vTempVars
._CollType = COLLTEMPVARS
._Count = _A2B_.TempVars.Count
End With
@@ -1722,6 +1733,7 @@ Private Function _NewCommandBar(psModule As String _
Dim oObject As Object
Set oObject = New CommandBar
With oObject
+ ._This = oObject
._Type = OBJCOMMANDBAR
._Name = psToolbarName
._ResourceURL = psToolbarFullName
diff --git a/wizards/source/access2base/Collect.xba
b/wizards/source/access2base/Collect.xba
index e63307511168..043af979f6b0 100644
--- a/wizards/source/access2base/Collect.xba
+++ b/wizards/source/access2base/Collect.xba
@@ -18,6 +18,7 @@ REM --- CLASS ROOT FIELDS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private _Type As String ' Must be
COLLECTION
+Private _This As Object ' Workaround for
absence of This builtin function
Private _CollType As String
Private _ParentType As String
Private _ParentName As String ' Name or shortcut
@@ -29,6 +30,7 @@ REM --- CONSTRUCTORS / DESTRUCTORS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJCOLLECTION
+ Set _This = Nothing
_CollType = ""
_ParentType = ""
_ParentName = ""
@@ -56,7 +58,7 @@ Property Get Count() As Long
End Property ' Count (get)
REM
-----------------------------------------------------------------------------------------------------------------------
-Property Get Item(ByVal Optional pvItem As Variant) As Variant
+Function Item(ByVal Optional pvItem As Variant) As Variant
'Return property value.
'pvItem either numeric index or property name
@@ -150,12 +152,12 @@ Dim vNames() As Variant, oProperty As Object
Exit_Function:
Utils._ResetCalledSub(cstThisSub)
- Exit Property
+ Exit Function
Error_Function:
TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl)
Set Item = Nothing
GoTo Exit_Function
-End Property ' V1.1.0
+End Function ' V1.1.0
REM
-----------------------------------------------------------------------------------------------------------------------
Property Get ObjectType() As String
@@ -225,6 +227,7 @@ Dim vObject As Variant, oTempVar As Object
If IsMissing(pvValue) Then Call _TraceArguments()
If _A2B_.hasItem(COLLTEMPVARS, pvNew) Then Goto
Error_Name
Set oTempVar = New TempVar
+ oTempVar._This = oTempVar
oTempVar._Name = pvNew
oTempVar._Value = pvValue
_A2B_.TempVars.Add(oTempVar, UCase(pvNew))
diff --git a/wizards/source/access2base/CommandBar.xba
b/wizards/source/access2base/CommandBar.xba
index 1d287bed098b..45a0ad513f1d 100644
--- a/wizards/source/access2base/CommandBar.xba
+++ b/wizards/source/access2base/CommandBar.xba
@@ -16,6 +16,7 @@ REM --- CLASS ROOT FIELDS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private _Type As String ' Must be
COMMANDBAR
+Private _This As Object ' Workaround for
absence of This builtin function
Private _Name As String
Private _ResourceURL As String
Private _Window As Object '
com.sun.star.frame.XFrame
@@ -29,6 +30,7 @@ REM --- CONSTRUCTORS / DESTRUCTORS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJCOMMANDBAR
+ Set _This = Nothing
_Name = ""
_ResourceURL = ""
Set _Window = Nothing
@@ -149,6 +151,7 @@ Dim oObject As Object
If pvIndex = iItemsCount - 1 Then
Set oObject = New CommandBarControl
With oObject
+ ._This = oObject
._ParentCommandBarName = _Name
._ParentCommandBar = oToolbar
._ParentBuiltin = ( _BarBuiltin
= 1 )
@@ -169,6 +172,7 @@ Dim oObject As Object
Select Case True
Case IsMissing(pvIndex)
Set oObject = New Collect
+ Set oObject._This = oObject
oObject._CollType = COLLCOMMANDBARCONTROLS
oObject._ParentType = OBJCOMMANDBAR
oObject._ParentName = _Name
diff --git a/wizards/source/access2base/CommandBarControl.xba
b/wizards/source/access2base/CommandBarControl.xba
index b7ea84a03e8c..f0c7403cbb51 100644
--- a/wizards/source/access2base/CommandBarControl.xba
+++ b/wizards/source/access2base/CommandBarControl.xba
@@ -16,6 +16,7 @@ REM --- CLASS ROOT FIELDS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private _Type As String '
Must be COMMANDBARCONTROL
+Private _This As Object '
Workaround for absence of This builtin function
Private _InternalIndex As Integer ' Index
in toolbar including separators
Private _Index As Integer '
Index in collection, starting at 1 !!
Private _ControlType As Integer ' 1 of
the msoControl* constants
@@ -30,6 +31,7 @@ REM --- CONSTRUCTORS / DESTRUCTORS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJCOMMANDBARCONTROL
+ Set _This = Nothing
_Index = -1
_ParentCommandBarName = ""
Set _ParentCommandBar = Nothing
diff --git a/wizards/source/access2base/Control.xba
b/wizards/source/access2base/Control.xba
index 3a41609ef48e..39afaee804a3 100644
--- a/wizards/source/access2base/Control.xba
+++ b/wizards/source/access2base/Control.xba
@@ -16,6 +16,7 @@ REM --- CLASS ROOT FIELDS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private _Type As String
' Must be CONTROL
+Private _This As Object
' Workaround for absence of This builtin function
Private _ImplementationName As String
Private _ClassId As Integer
Private _ParentType As String
' One of CTLPARENTISxxxx constants
@@ -38,6 +39,7 @@ REM --- CONSTRUCTORS / DESTRUCTORS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJCONTROL
+ Set _This = Nothing
_ClassId = -1
_ParentType = ""
_Shortcut = ""
@@ -765,6 +767,7 @@ Dim j As Integer, oView As Object
If IsMissing(pvIndex) Then '
No argument, return Collection pseudo-object
Set oCounter = New Collect
+ Set oCounter._This = oCounter
oCounter._CollType = COLLCONTROLS
oCounter._ParentType = OBJCONTROL
oCounter._ParentName = _Shortcut
@@ -778,6 +781,7 @@ Dim j As Integer, oView As Object
' Start building the ocControl object
' Determine exact name
Set ocControl = New Control
+ Set ocControl._This = ocControl
ocControl._ParentType = CTLPARENTISGRID
sParentShortcut = _Shortcut
sControls() = ControlModel.getElementNames()
@@ -1512,6 +1516,7 @@ Dim oControlEvents As Object, sEventName As String
Case UCase("Form")
Set ofSubForm = New SubForm ' Start
building the SUBFORM object
With ofSubForm
+ Set ._This = ofSubForm
Set .DatabaseForm = ControlModel
._Name = _Name
._Shortcut = _Shortcut & ".Form"
diff --git a/wizards/source/access2base/DataDef.xba
b/wizards/source/access2base/DataDef.xba
index a7d589fa5fc3..0202e13b0064 100644
--- a/wizards/source/access2base/DataDef.xba
+++ b/wizards/source/access2base/DataDef.xba
@@ -16,6 +16,7 @@ REM --- CLASS ROOT FIELDS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private _Type As String
' Must be TABLEDEF or QUERYDEF
+Private _This As Object
' Workaround for absence of This builtin function
Private _Name As String
' For tables: [[Catalog.]Schema.]Table
Private _ParentDatabase As Object
Private _ReadOnly As Boolean
@@ -33,6 +34,7 @@ REM --- CONSTRUCTORS / DESTRUCTORS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = ""
+ Set _This = Nothing
_Name = ""
Set _ParentDatabase = Nothing
_ReadOnly = False
@@ -127,6 +129,7 @@ Const cstMaxKeyLength = 30
Set oNewField = New Field
With oNewField
+ ._This = oNewField
._Name = pvFieldName
._ParentName = _Name
._ParentType = OBJTABLEDEF
@@ -277,6 +280,7 @@ Dim i As Integer, bFound As Boolean, oFields As Object
Select Case True
Case IsMissing(pvIndex)
Set oObject = New Collect
+ Set oObject._This = oObject
oObject._CollType = COLLFIELDS
oObject._ParentType = _Type
oObject._ParentName = _Name
@@ -300,6 +304,7 @@ Dim i As Integer, bFound As Boolean, oFields As Object
End Select
Set oObject = New Field
+ Set oObject._This = oObject
oObject._Name = sObjectName
Set oObject.Column = oFields.getByName(sObjectName)
oObject._ParentName = _Name
@@ -362,17 +367,17 @@ Dim lCommandType As Long, sCommand As String, oObject As
Object,bPassThrough As
If IsMissing(pvType) Then
pvType = cstNull
Else
- If Not Utils._CheckArgument(pvType, 1, Utils._AddNumeric(),
dbOpenForwardOnly) Then Goto Exit_Function
+ If Not Utils._CheckArgument(pvType, 1, Utils._AddNumeric(),
Array(cstNull, dbOpenForwardOnly)) Then Goto Exit_Function
End If
If IsMissing(pvOptions) Then
pvOptions = cstNull
Else
- If Not Utils._CheckArgument(pvOptions, 2, Utils._AddNumeric(),
dbSQLPassThrough) Then Goto Exit_Function
+ If Not Utils._CheckArgument(pvOptions, 2, Utils._AddNumeric(),
Array(cstNull, dbSQLPassThrough)) Then Goto Exit_Function
End If
If IsMissing(pvLockEdit) Then
pvLockEdit = cstNull
Else
- If Not Utils._CheckArgument(pvLockEdit, 3, Utils._AddNumeric(),
dbReadOnly) Then Goto Exit_Function
+ If Not Utils._CheckArgument(pvLockEdit, 3, Utils._AddNumeric(),
Array(cstNull, dbReadOnly)) Then Goto Exit_Function
End If
Select Case _Type
diff --git a/wizards/source/access2base/Database.xba
b/wizards/source/access2base/Database.xba
index cbaa96555e06..10fb447b2951 100644
--- a/wizards/source/access2base/Database.xba
+++ b/wizards/source/access2base/Database.xba
@@ -362,6 +362,7 @@ Dim vNameComponents() As Variant, iNames As Integer
End If
Next i
Set oNewTable = New DataDef
+ Set oNewTable._This = oNewTable
oNewTable._Type = OBJTABLEDEF
oNewTable._Name = pvTableName
vNameComponents = Split(pvTableName, ".")
@@ -593,17 +594,17 @@ Dim sObjects() As String, bFound As Boolean, oTables As
Object, oQueries As Obje
If IsMissing(pvType) Then
pvType = cstNull
Else
- If Not Utils._CheckArgument(pvType, 2, Utils._AddNumeric(),
dbOpenForwardOnly) Then Goto Exit_Function
+ If Not Utils._CheckArgument(pvType, 2, Utils._AddNumeric(),
Array(cstNull, dbOpenForwardOnly)) Then Goto Exit_Function
End If
If IsMissing(pvOptions) Then
pvOptions = cstNull
Else
- If Not Utils._CheckArgument(pvOptions, 3, Utils._AddNumeric(),
dbSQLPassThrough) Then Goto Exit_Function
+ If Not Utils._CheckArgument(pvOptions, 3, Utils._AddNumeric(),
Array(cstNull, dbSQLPassThrough)) Then Goto Exit_Function
End If
If IsMissing(pvLockEdit) Then
pvLockEdit = cstNull
Else
- If Not Utils._CheckArgument(pvLockEdit, 4, Utils._AddNumeric(),
dbReadOnly) Then Goto Exit_Function
+ If Not Utils._CheckArgument(pvLockEdit, 4, Utils._AddNumeric(),
Array(cstNull, dbReadOnly)) Then Goto Exit_Function
End If
sSource = Split(UCase(Trim(pvSource)), " ")(0)
@@ -906,6 +907,7 @@ Dim i As Integer, bFound As Boolean, oQueries As Object
Select Case True
Case IsMissing(pvIndex)
Set oObject = New Collect
+ Set oObject._This = oObject
oObject._CollType = COLLQUERYDEFS
oObject._ParentType = OBJDATABASE
oObject._ParentName = ""
@@ -929,6 +931,7 @@ Dim i As Integer, bFound As Boolean, oQueries As Object
End Select
Set oObject = New DataDef
+ Set oObject._This = oObject
oObject._Type = OBJQUERYDEF
oObject._Name = sObjectName
Set oObject._ParentDatabase = _This
@@ -969,6 +972,7 @@ Dim i As Integer, bFound As Boolean, oTables As Object
Select Case True
Case IsMissing(pvIndex)
Set oObject = New Collect
+ Set oObject._This = oObject
oObject._CollType = COLLRECORDSETS
oObject._ParentType = OBJDATABASE
oObject._ParentName = ""
@@ -1062,6 +1066,7 @@ Dim i As Integer, bFound As Boolean, oTables As Object
Select Case True
Case IsMissing(pvIndex)
Set oObject = New Collect
+ Set oObject._This = oObject
oObject._CollType = COLLTABLEDEFS
oObject._ParentType = OBJDATABASE
oObject._ParentName = ""
@@ -1086,6 +1091,7 @@ Dim i As Integer, bFound As Boolean, oTables As Object
Set oObject = New DataDef
With oObject
+ ._This = oObject
._Type = OBJTABLEDEF
._Name = sObjectName
Set ._ParentDatabase = _This
@@ -1194,7 +1200,7 @@ Exit_Function:
Set oStatement = Nothing
Exit Function
Error_Function:
- TraceError(TRACEABORT, ERRDFUNCTION, _A2B_.CalledSub, 0, , sSQL)
+ TraceError(TRACEFATAL, ERRDFUNCTION, _A2B_.CalledSub, 0, , sSQL)
Goto Exit_Function
End Function ' DFunction V1.5.0
@@ -1802,7 +1808,7 @@ Dim i As Integer, vEvents As Variant, sEvent As String,
vEvent As Variant
Select Case UCase(psProperty)
Case UCase("Connect")
- _PropertyGet = Document.Datasource.URL
+ If IsNull(Document) Then _PropertyGet = ""
Else _PropertyGet = Document.Datasource.URL
' Location = ConvertFromUrl(URL)
Case UCase("Name")
_PropertyGet = Title
@@ -1815,7 +1821,7 @@ Dim i As Integer, vEvents As Variant, sEvent As String,
vEvent As Variant
,
UCase("OnTitleChanged"), UCase("OnUnfocus"),
UCase("OnUnload"), UCase("OnViewClosed"),
UCase("OnViewCreated")
' Find script event
sEvent = ""
- vEvents = Document.getEvents().ElementNames
' Returns an array
+ If IsNull(Document) Then vEvents = Array() Else vEvents
= Document.getEvents().ElementNames ' Returns an array
For i = 0 To UBound(vEvents)
If UCase(vEvents(i)) = UCase(psProperty) Then
sEvent = vEvents(i)
diff --git a/wizards/source/access2base/Dialog.xba
b/wizards/source/access2base/Dialog.xba
index 9dc816ee7316..244f5a11be83 100644
--- a/wizards/source/access2base/Dialog.xba
+++ b/wizards/source/access2base/Dialog.xba
@@ -16,6 +16,7 @@ REM --- CLASS ROOT FIELDS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private _Type As String
' Must be DIALOG
+Private _This As Object
' Workaround for absence of This builtin function
Private _Name As String
Private _Shortcut As String
Private _Dialog As Object
' com.sun.star.io.XInputStreamProvider
@@ -28,6 +29,7 @@ REM --- CONSTRUCTORS / DESTRUCTORS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJDIALOG
+ Set _This = Nothing
_Name = ""
Set _Dialog = Nothing
_Storage = ""
@@ -252,6 +254,7 @@ Dim ogGroup As Object, vGroup() As Variant, vIndex() As
Variant
ReDim vGroup(0 To iGroupCount - 1)
ReDim vIndex(0 To iGroupCount - 1)
With ogGroup
+ ._This = ogGroup
._Name = sGroupName
._Count = iGroupCount
._ButtonsGroup = vGroup
@@ -349,6 +352,7 @@ Dim j As Integer
Set ocControl = Nothing
If Not IsLoaded Then Goto Trace_Error_NotOpen
Set ocControl = New Control
+ Set ocControl._This = ocControl
ocControl._ParentType = CTLPARENTISDIALOG
sParentShortcut = _Shortcut
sControls() = UnoDialog.Model.getElementNames()
@@ -356,6 +360,7 @@ Dim j As Integer
If IsMissing(pvIndex) Then '
No argument, return Collection object
Set oCounter = New Collect
+ Set oCounter._This = oCounter
oCounter._CollType = COLLCONTROLS
oCounter._Count = iControlCount
Set Controls = oCounter
@@ -511,7 +516,6 @@ Public Function Move( ByVal Optional pvLeft As
Variant _
) As Variant
' Execute Move method
Utils._SetCalledSub("Dialog.Move")
- If IsMissing(pvLeft) Then Call _TraceArguments()
On Local Error Goto Error_Function
Move = False
Dim iArgNr As Integer
@@ -519,7 +523,7 @@ Dim iArgNr As Integer
Case UCase("Move")
: iArgNr = 1
Case UCase("Dialog.Move") :
iArgNr = 0
End Select
- If IsMissing(pvLeft) Then Call _TraceArguments()
+ If IsMissing(pvLeft) Then pvLeft = -1
If IsMissing(pvTop) Then pvTop = -1
If IsMissing(pvWidth) Then pvWidth = -1
If IsMissing(pvHeight) Then pvHeight = -1
diff --git a/wizards/source/access2base/Field.xba
b/wizards/source/access2base/Field.xba
index adf73818243d..7fd2f704383a 100644
--- a/wizards/source/access2base/Field.xba
+++ b/wizards/source/access2base/Field.xba
@@ -16,6 +16,7 @@ REM --- CLASS ROOT FIELDS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private _Type As String
' Must be FIELD
+Private _This As Object
' Workaround for absence of This builtin function
Private _Name As String
Private _Precision As Long
Private _ParentName As String
@@ -33,6 +34,7 @@ REM --- CONSTRUCTORS / DESTRUCTORS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJFIELD
+ Set _This = Nothing
_Name = ""
_ParentName = ""
_ParentType = ""
diff --git a/wizards/source/access2base/Form.xba
b/wizards/source/access2base/Form.xba
index b660564db07f..e9c87c803811 100644
--- a/wizards/source/access2base/Form.xba
+++ b/wizards/source/access2base/Form.xba
@@ -16,6 +16,7 @@ REM --- CLASS ROOT FIELDS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private _Type As String
' Must be FORM
+Private _This As Object
' Workaround for absence of This builtin function
Private _Shortcut As String
Private _Name As String
Private _DocEntry As Integer
' Doc- and DbContainer entries in Root structure
@@ -35,6 +36,7 @@ REM --- CONSTRUCTORS / DESTRUCTORS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJFORM
+ Set _This = Nothing
_Shortcut = ""
_Name = ""
_DocEntry = -1
@@ -502,6 +504,7 @@ Dim oDatabaseForm As Object, iCtlCount As Integer
If IsMissing(pvIndex) Then '
No argument, return Collection pseudo-object
Set oCounter = New Collect
+ Set oCounter._This = oCounter
oCounter._CollType = COLLCONTROLS
oCounter._ParentType = OBJFORM
oCounter._ParentName = _Name
@@ -554,6 +557,7 @@ Dim oDatabaseForm As Object, iCtlCount As Integer
'Initialize a new Control object
Set ocControl = New Control
With ocControl
+ ._This = ocControl
._ParentType = CTLPARENTISFORM
._Name = sName
._Shortcut = _Shortcut & "!" &
Utils._Surround(sName)
@@ -635,7 +639,6 @@ Public Function Move( ByVal Optional pvLeft As
Variant _
) As Variant
' Execute Move method
Utils._SetCalledSub("Form.Move")
- If IsMissing(pvLeft) Then Call _TraceArguments()
If _ErrorHandler() Then On Local Error Goto Error_Function
Move = False
Dim iArgNr As Integer
@@ -643,7 +646,7 @@ Dim iArgNr As Integer
Case UCase("Move") :
iArgNr = 1
Case UCase("Form.Move") :
iArgNr = 0
End Select
- If IsMissing(pvLeft) Then Call _TraceArguments()
+ If IsMissing(pvLeft) Then pvLeft = -1
If IsMissing(pvTop) Then pvTop = -1
If IsMissing(pvWidth) Then pvWidth = -1
If IsMissing(pvHeight) Then pvHeight = -1
@@ -942,6 +945,7 @@ Dim i As Integer, oObject As Object
If DatabaseForm.Command = "" Then Goto
Trace_Error ' No underlying data ??
Set oObject = New Recordset
With DatabaseForm
+ oObject._This = oObject
oObject._CommandType = .CommandType
oObject._Command = .Command
oObject._ParentName = _Name
diff --git a/wizards/source/access2base/Methods.xba
b/wizards/source/access2base/Methods.xba
index 8d8cf81d9906..7f809c6c1915 100644
--- a/wizards/source/access2base/Methods.xba
+++ b/wizards/source/access2base/Methods.xba
@@ -251,6 +251,7 @@ Const cstPixels = 10
' Tolerance on coordinates when drawn approximat
If bFound Then
ogGroup = New Optiongroup
+ ogGroup._This = ogGroup
ogGroup._Name = sGroupName
ogGroup._ButtonsGroup = vOptionButtons
ogGroup._Count = UBound(vOptionButtons) + 1
diff --git a/wizards/source/access2base/Module.xba
b/wizards/source/access2base/Module.xba
index e2f60b79dfb6..383d792a4f0f 100644
--- a/wizards/source/access2base/Module.xba
+++ b/wizards/source/access2base/Module.xba
@@ -16,6 +16,7 @@ REM --- CLASS ROOT FIELDS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private _Type As String
' Must be MODULE
+Private _This As Object
' Workaround for absence of This builtin function
Private _Name As String
Private _Library As Object
' com.sun.star.container.XNameAccess
Private _LibraryName As String
@@ -34,6 +35,7 @@ REM --- CONSTRUCTORS / DESTRUCTORS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJMODULE
+ Set _This = Nothing
_Name = ""
Set _Library = Nothing
_LibraryName = ""
diff --git a/wizards/source/access2base/OptionGroup.xba
b/wizards/source/access2base/OptionGroup.xba
index 1f3cb72f8d49..6eeac087a7eb 100644
--- a/wizards/source/access2base/OptionGroup.xba
+++ b/wizards/source/access2base/OptionGroup.xba
@@ -16,6 +16,7 @@ REM --- CLASS ROOT FIELDS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private _Type As String
' Must be FORM
+Private _This As Object
' Workaround for absence of This builtin function
Private _Name As String
Private _ParentType As String
Private _ParentComponent As Object
@@ -31,6 +32,7 @@ REM --- CONSTRUCTORS / DESTRUCTORS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJOPTIONGROUP
+ Set _This = Nothing
_Name = ""
_ParentType = ""
_ParentComponent = Nothing
@@ -118,6 +120,7 @@ Dim ocControl As Variant, iArgNr As Integer, i As Integer
If IsMissing(pvIndex) Then '
No argument, return Collection object
Set oCounter = New Collect
+ Set oCounter._This = oCounter
oCounter._SubType = OBJCONTROL
oCounter._ParentType = OBJOPTIONGROUP
oCounter._ParentName = _Name
@@ -133,6 +136,7 @@ Dim ocControl As Variant, iArgNr As Integer, i As Integer
' Start building the ocControl object
' Determine exact name
Set ocControl = New Control
+ Set ocControl._This = ocControl
ocControl._ParentType = CTLPARENTISGROUP
ocControl._Shortcut = ""
diff --git a/wizards/source/access2base/PropertiesGet.xba
b/wizards/source/access2base/PropertiesGet.xba
index 35da47d401c2..46433027a601 100644
--- a/wizards/source/access2base/PropertiesGet.xba
+++ b/wizards/source/access2base/PropertiesGet.xba
@@ -428,6 +428,7 @@ Dim oDoc As Object
sComponents(UBound(sComponents)) = sSubComponents(0)
' Ignore final property, if any
Set vCurrentObject = New Collect
+ Set vCurrentObject._This = vCurrentObject
Select Case UCase(sComponents(0))
Case "FORMS" : vCurrentObject._CollType =
COLLFORMS
Case "DIALOGS" :
vCurrentObject._CollType = COLLALLDIALOGS
@@ -1165,6 +1166,7 @@ Dim iArgNr As Integer, iLen As Integer
If IsMissing(pvIndex) Then '
Call without index argument prepares a Collection object
Set oCounter = New Collect
+ Set oCounter._This = oCounter
oCounter._CollType = COLLPROPERTIES
oCounter._ParentType = UCase(psObject)
oCounter._ParentName = psObjectName
@@ -1180,6 +1182,7 @@ Dim iArgNr As Integer, iLen As Integer
TraceError(TRACEFATAL, ERRCOLLECTION,
Utils._CalledSub(), 0, 1)
Else
Set opProperty = New Property
+ Set opProperty._This = opProperty
opProperty._Name = pvPropertiesList(pvIndex)
opProperty._Value = Null
Set vProperties = opProperty
diff --git a/wizards/source/access2base/Property.xba
b/wizards/source/access2base/Property.xba
index 4d077f5c1420..178f29b0ff9a 100644
--- a/wizards/source/access2base/Property.xba
+++ b/wizards/source/access2base/Property.xba
@@ -16,6 +16,7 @@ REM --- CLASS ROOT FIELDS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private _Type As String ' Must be PROPERTY
+Private _This As Object ' Workaround for
absence of This builtin function
Private _Name As String
Private _Value As Variant
Private _ParentDatabase As Object
@@ -25,6 +26,7 @@ REM --- CONSTRUCTORS / DESTRUCTORS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJPROPERTY
+ Set _This = Nothing
_Name = ""
_Value = Null
End Sub ' Constructor
diff --git a/wizards/source/access2base/Recordset.xba
b/wizards/source/access2base/Recordset.xba
index cc46790532d9..0dcb682157eb 100644
--- a/wizards/source/access2base/Recordset.xba
+++ b/wizards/source/access2base/Recordset.xba
@@ -16,8 +16,8 @@ REM --- CLASS ROOT FIELDS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private _Type As String
' Must be RECORDSET
+Private _This As Object
' Workaround for absence of This builtin function
Private _Name As String
' Unique, generated
-Private _This As Object
Private _Fields() As Variant
Private _ParentName As String
Private _ParentType As String
@@ -51,8 +51,8 @@ REM --- CONSTRUCTORS / DESTRUCTORS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJRECORDSET
- _Name = ""
Set _This = Nothing
+ _Name = ""
_Fields = Array()
_ParentName = ""
Set _ParentDatabase = Nothing
@@ -496,6 +496,7 @@ Dim i As Integer, oFields As Object, iIndex As Integer
' No argument, return a collection
If IsMissing(pvIndex) Then
Set oObject = New Collect
+ Set oObject._This = oObject
oObject._CollType = COLLFIELDS
oObject._ParentType = OBJRECORDSET
oObject._ParentName = _Name
@@ -538,6 +539,7 @@ Dim i As Integer, oFields As Object, iIndex As Integer
' Otherwise create new field object
Else
Set oObject = New Field
+ Set oObject._This = oObject
oObject._Name = sObjectName
Set oObject.Column = oFields.getByName(sObjectName)
If Utils._hasUNOProperty(oObject.Column, "Precision")
Then oObject._Precision = oObject.Column.Precision
diff --git a/wizards/source/access2base/Root_.xba
b/wizards/source/access2base/Root_.xba
index ce82e7d43b7d..dfb9c075f0ca 100644
--- a/wizards/source/access2base/Root_.xba
+++ b/wizards/source/access2base/Root_.xba
@@ -26,6 +26,7 @@ Private TraceLogCount As Integer
Private TraceLogLast As Integer
Private TraceLogMaxEntries As Integer
Private LastErrorCode As Integer
+Private LastErrorLevel As String
Private ErrorText As String
Private ErrorLongText As String
Private CalledSub As String
@@ -41,6 +42,7 @@ Private StatusBar As Object
Private Dialogs As Object
' Collection
Private TempVars As Object
' Collection
Private CurrentDoc() As Variant '
Array of document containers - [0] = Base document, [1 ... N] = other documents
+Private PythonVars() As Variant '
Array of objects created in Python scripts
REM
-----------------------------------------------------------------------------------------------------------------------
REM --- CONSTRUCTORS / DESTRUCTORS
---
@@ -54,6 +56,7 @@ Private Sub Class_Initialize()
TraceLogLast = 0
TraceLogMaxEntries = 0
LastErrorCode = 0
+ LastErrorLevel = ""
ErrorText = ""
ErrorLongText = ""
CalledSub = ""
@@ -75,6 +78,7 @@ Private Sub Class_Initialize()
CurrentDoc = Array()
ReDim CurrentDoc(0 To 0)
Set CurrentDoc(0) = Nothing
+ PythonVars = Array()
End Sub ' Constructor
REM
-----------------------------------------------------------------------------------------------------------------------
@@ -96,6 +100,20 @@ REM --- CLASS METHODS
---
REM
-----------------------------------------------------------------------------------------------------------------------
REM
-----------------------------------------------------------------------------------------------------------------------
+Public Function AddPython(ByRef pvObject As Variant) As Long
+' Store the object as a new entry in PythonVars and return its entry
number
+
+Dim lVars As Long, vObject As Variant
+
+ lVars = UBound(PythonVars) + 1
+ ReDim Preserve PythonVars(0 To lVars)
+ PythonVars(lVars) = pvObject
+
+ AddPython = lVars
+
+End Function ' AddPython V6.4
+
+REM
-----------------------------------------------------------------------------------------------------------------------
Public Sub CloseConnection()
' Close all connections established by current document to free memory.
' - if Base document => close the one concerned database connection
diff --git a/wizards/source/access2base/SubForm.xba
b/wizards/source/access2base/SubForm.xba
index 0b0773419d24..85556e8d4716 100644
--- a/wizards/source/access2base/SubForm.xba
+++ b/wizards/source/access2base/SubForm.xba
@@ -16,6 +16,7 @@ REM --- CLASS ROOT FIELDS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private _Type As String
' Must be SUBFORM
+Private _This As Object
' Workaround for absence of This builtin function
Private _Shortcut As String
Private _Name As String
Private _MainForm As String
@@ -30,6 +31,7 @@ REM --- CONSTRUCTORS / DESTRUCTORS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJSUBFORM
+ Set _This = Nothing
_Shortcut = ""
_Name = ""
_MainForm = ""
@@ -379,6 +381,7 @@ Dim j As Integer
If IsMissing(pvIndex) Then '
No argument, return Collection pseudo-object
Set oCounter = New Collect
+ Set oCounter._This = oCounter
oCounter._CollType = COLLCONTROLS
oCounter._ParentType = OBJSUBFORM
oCounter._ParentName = _Shortcut
@@ -392,6 +395,7 @@ Dim j As Integer
' Start building the ocControl object
' Determine exact name
Set ocControl = New Control
+ Set ocControl._This = ocControl
ocControl._ParentType = CTLPARENTISSUBFORM
sParentShortcut = _Shortcut
sControls() = DatabaseForm.getElementNames()
@@ -628,6 +632,7 @@ Dim oDatabase As Object, vBookmark As Variant, oObject As
Object
If DatabaseForm.Command = "" Then Goto
Trace_Error ' No underlying data ??
Set oObject = New Recordset
With DatabaseForm
+ Set oObject._This = oObject
oObject._CommandType = .CommandType
oObject._Command = .Command
oObject._ParentName = _Name
diff --git a/wizards/source/access2base/TempVar.xba
b/wizards/source/access2base/TempVar.xba
index 54a0eb219809..b7a053dc78ce 100644
--- a/wizards/source/access2base/TempVar.xba
+++ b/wizards/source/access2base/TempVar.xba
@@ -16,6 +16,7 @@ REM --- CLASS ROOT FIELDS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private _Type As String ' Must be TEMPVAR
+Private _This As Object ' Workaround for
absence of This builtin function
Private _Name As String
Private _Value As Variant
@@ -24,6 +25,7 @@ REM --- CONSTRUCTORS / DESTRUCTORS
---
REM
-----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
_Type = OBJTEMPVAR
+ Set _This = Nothing
_Name = ""
_Value = Null
End Sub ' Constructor
diff --git a/wizards/source/access2base/Trace.xba
b/wizards/source/access2base/Trace.xba
index c7bb7a47cbd4..220f1f623e5a 100644
--- a/wizards/source/access2base/Trace.xba
+++ b/wizards/source/access2base/Trace.xba
@@ -8,7 +8,7 @@ REM
============================================================================
Option Explicit
-Public Const cstLogMaxEntries = 20
+Public Const cstLogMaxEntries = 99
REM Typical Usage
REM TraceLog("INFO", "The OK button was
pressed")
@@ -163,8 +163,10 @@ Dim sErrorText As String, sErrorDesc As String, oDb As
Object
& Iif(psErrorProc
<> "", " " & _GetLabel("ERRIN") &
" " & psErrorProc, Iif(_A2B_.CalledSub = "",
"", " " & _Getlabel("ERRIN") & "
" & _A2B_.CalledSub))
With _A2B_
.LastErrorCode = piErrorCode
+ .LastErrorLevel = psErrorLevel
.ErrorText = sErrorDesc
.ErrorLongText = sErrorText
+ .CalledSub = ""
End With
If IsMissing(pvMsgBox) Then pvMsgBox = ( psErrorLevel = TRACEERRORS Or
psErrorLevel = TRACEFATAL Or psErrorLevel = TRACEABORT )
TraceLog(psErrorLevel, sErrorText, pvMsgBox)
@@ -172,7 +174,7 @@ Dim sErrorText As String, sErrorDesc As String, oDb As
Object
' Unexpected error detected in user program or in Access2Base
If psErrorLevel = TRACEFATAL Or psErrorLevel = TRACEABORT Then
If psErrorLevel = TRACEFATAL Then
- Set oDb = Application.CurrentDb()
+ Set oDb = _A2B_.CurrentDb()
If Not IsNull(oDb) Then oDb.CloseAllrecordsets()
End If
Stop
@@ -181,18 +183,21 @@ Dim sErrorText As String, sErrorDesc As String, oDb As
Object
End Sub ' TraceError V0.9.5
REM
-----------------------------------------------------------------------------------------------------------------------
-Public Function TraceErrorCode(ByVal Optional piMode As Integer) As Variant
-' Return the last encountered error code or description
+Public Function TraceErrorCode() As Variant
+' Return the last encountered error code, level, description in an array
' UNPUBLISHED
-Const cstCode = 0, cstDesc = 1, cstLongDesc = 2
+Dim vError As Variant
- If IsMissing(piMode) Then piMode = cstCode
- Select Case piMode
- Case cstCode : TraceErrorCode =
_A2B_.LastErrorCode
- Case cstDesc : TraceErrorCode = _A2B_.ErrorText
- Case cstLongDesc : TraceErrorCode =
_A2B_.ErrorLongText
- End Select
+ With _A2B_
+ vError = Array( _
+ .LastErrorCode _
+ , .LastErrorLevel _
+ , .ErrorText _
+ , .ErrorLongText _
+ )
+ End With
+ TraceErrorCode = vError
End Function ' TraceErrorCode V6.3
diff --git a/wizards/source/access2base/Utils.xba
b/wizards/source/access2base/Utils.xba
index 07e0d03a3183..56a2e8a85dd3 100644
--- a/wizards/source/access2base/Utils.xba
+++ b/wizards/source/access2base/Utils.xba
@@ -194,7 +194,8 @@ Const cstByteLength = 25
sArg = Replace(sArg, ",",
".")
Case vbBigint : sArg =
CStr(CLng(pvArg))
Case vbDate :
sArg = Year(pvArg) & "-" & Right("0" &
Month(pvArg), 2) & "-" & Right("0" &
Day(pvArg), 2) _
-
& " " & Right("0" &
Hour(pvArg), 2) & ":" & Right("0" &
Minute(pvArg), 2)
+
& " " & Right("0" &
Hour(pvArg), 2) & ":" & Right("0" &
Minute(pvArg), 2) _
+
& ":" & Right("0" &
Second(pvArg), 2)
Case Else :
sArg = CStr(pvArg)
End Select
End If
@@ -1040,7 +1041,7 @@ REM
----------------------------------------------------------------------------
Public Sub _ResetCalledSub(ByVal psSub 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 IsEmpty(_A2B_) Then Call Application._RootInit() '
Only when Utils module recompiled
With _A2B_
If .CalledSub = psSub Then .CalledSub = ""
If .MinimalTraceLevel = 1 Then TraceLog(TRACEDEBUG,
_GetLabel("Exiting") & " " & psSub & "
...", False)
@@ -1079,6 +1080,7 @@ Public Sub _SetCalledSub(ByVal psSub As String)
If .CalledSub = "" Then
.CalledSub = psSub
.LastErrorCode = 0
+ .LastErrorLevel = ""
.ErrorText = ""
.ErrorLongText = ""
End If
_______________________________________________
Libreoffice-commits mailing list
libreoffice-comm...@lists.freedesktop.org
https://lists.freedesktop.org/mailman/listinfo/libreoffice-commits
