diff options
| author | Jean-Pierre Ledure <jp@ledure.be> | 2019-06-13 14:42:49 +0200 |
|---|---|---|
| committer | Jean-Pierre Ledure <jp@ledure.be> | 2019-06-13 14:46:27 +0200 |
| commit | 28dcdd5f6c2204718519e215d2ef5466743536c7 (patch) | |
| tree | 45cde6c4ea79d84dd68ffb6675cb3003286c3640 /wizards | |
| parent | 5c7fa1518e9ca8921d2d6c2a4b09a8a6fb938804 (diff) | |
Access2Base - Robustness changes
Addition of _This address in every Basic object
Default parameters reviewed when ambiguous
Typo's corrections
Diffstat (limited to 'wizards')
21 files changed, 125 insertions, 32 deletions
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 |