[Libreoffice-commits] core.git: wizards/source
Jean-Pierre Ledure
jp at ledure.be
Sun Aug 17 04:19:06 PDT 2014
wizards/source/access2base/Application.xba | 23 +++++++++++++++--------
wizards/source/access2base/DoCmd.xba | 8 ++++----
wizards/source/access2base/Event.xba | 7 ++++---
wizards/source/access2base/L10N.xba | 4 ++--
wizards/source/access2base/PropertiesGet.xba | 2 +-
wizards/source/access2base/Trace.xba | 11 +++++++----
wizards/source/access2base/Utils.xba | 1 +
wizards/source/access2base/acConstants.xba | 2 +-
8 files changed, 35 insertions(+), 23 deletions(-)
New commits:
commit 8393014898d67795f44835791aa0d9ed535be5d3
Author: Jean-Pierre Ledure <jp at ledure.be>
Date: Tue Aug 12 12:08:48 2014 +0200
Access2Base - non-Base components
So far the first call to the API was a call to the OpenConnection method.
Without an OpenConnection some methods issued a cryptic "Object variable not set" Basic run-time message.
It is now intercepted to make it clearer.
A number of features are not database related: error handling, events handling, windows move/resize, dialogs, ...
They have been identified and adapted to be callable without database connection.
As such they are callable from any LO component, not only Base.
Change-Id: I99f408c8404a6192149747228b2b8493b9df5ae3
Reviewed-on: https://gerrit.libreoffice.org/10883
Reviewed-by: Jean-Pierre Ledure <jp at ledure.be>
Tested-by: Jean-Pierre Ledure <jp at ledure.be>
diff --git a/wizards/source/access2base/Application.xba b/wizards/source/access2base/Application.xba
index 04dceb0..8b2af9a 100644
--- a/wizards/source/access2base/Application.xba
+++ b/wizards/source/access2base/Application.xba
@@ -291,7 +291,7 @@ Public Function AllForms(ByVal Optional pvIndex As Variant) As Variant
' Easiest use for standalone forms: AllForms(0)
' If no argument, return a Collection type
-If _ErrorHandler() Then On Local Error Goto Error_Function
+ If _ErrorHandler() Then On Local Error Goto Error_Function
Const cstThisSub = "AllForms"
Utils._SetCalledSub(cstThisSub)
Dim iIndex As Integer, vAllForms As Variant
@@ -443,10 +443,11 @@ Dim i As Integer, bFound As Boolean, sURL As String, iCurrentDoc As Integer, oCu
bFound = False
Set CurrentDb = Nothing
+ If IsEmpty(_A2B_) Then GoTo Exit_Function
With _A2B_
If Not IsArray(.CurrentDoc) Then Goto Exit_Function
If UBound(.CurrentDoc) < 0 Then Goto Exit_Function
- iCurrentDoc = _CurrentDoc()
+ iCurrentDoc = _CurrentDoc(, False)
If iCurrentDoc >= 0 Then Set CurrentDb = .CurrentDoc(iCurrentDoc).DbContainers(0).Database
End With
@@ -980,6 +981,7 @@ End Function ' OpenDatabase V1.1.0
REM -----------------------------------------------------------------------------------------------------------------------
Public Function ProductCode()
+ If IsEmpty(_A2B_) Then Call Application._RootInit() ' First use of Access2Base in current AOO/LibO session
ProductCode = "Access2Base " & _A2B_.VersionNumber
End Function ' ProductCode V0.9.1
@@ -991,10 +993,10 @@ Public Function SysCmd(Optional pvAction As Variant _
' Manage progress meter in the status bar
' Other values supported by MSAccess are ignored
+ If _ErrorHandler() Then On Local Error Goto Error_Function
Const cstThisSub = "SysCmd"
Utils._SetCalledSub(cstThisSub)
SysCmd = False
- If _ErrorHandler() Then On Local Error Goto Error_Function
Const cstMissing = -1
Const cstBarLength = 350
@@ -1117,6 +1119,7 @@ REM Without arguments same as CurrentDb() except that it generates an error if d
REM With 2 arguments return the corresponding entry in Root
Dim odbDatabase As Variant
+ If IsEmpty(_A2B_) Then GoTo Trace_Error
If IsMissing(piDocEntry) Then
Set odbDatabase = Application.CurrentDb()
Else
@@ -1139,16 +1142,16 @@ Trace_Error:
End Function ' _CurrentDb V1.1.0
REM -----------------------------------------------------------------------------------------------------------------------
-Public Function _CurrentDoc(Optional pvURL As String) As Integer
+Public Function _CurrentDoc(Optional pvURL As String, Optional pbAbort As Boolean) As Integer
' Returns the entry in _A2B_.CurrentDoc(...) referring to the current document
Dim i As Integer, bFound As Boolean, sURL As String
bFound = False
- _CurrentDoc = -1 ' Convention for _A2B_ not initalized or no entry found
+ If IsEmpty(_A2B_) Then GoTo Trace_Error
With _A2B_
- If Not IsArray(.CurrentDoc) Then Goto Exit_Function
- If UBound(.CurrentDoc) < 0 Then Goto Exit_Function
+ If Not IsArray(.CurrentDoc) Then Goto Trace_Error
+ If UBound(.CurrentDoc) < 0 Then Goto Trace_Error
For i = 1 To UBound(.CurrentDoc) ' [0] reserved to database .odb document
If IsMissing(pvURL) Then ' Not on 1 single line ?!?
If Utils._hasUNOProperty(ThisComponent, "URL") Then
@@ -1166,12 +1169,16 @@ Dim i As Integer, bFound As Boolean, sURL As String
End If
Next i
If Not bFound Then
- If Not IsNull(.CurrentDoc(0)) Then _CurrentDoc = 0
+ If Not IsNull(.CurrentDoc(0)) Then _CurrentDoc = 0 Else GoTo Trace_Error
End If
End With
Exit_Function:
Exit Function
+Trace_Error:
+ If IsMissing(pbAbort) Then pbAbort = True
+ If pbAbort Then TraceError(TRACEABORT, ERRDBNOTCONNECTED, Utils._CalledSub(), 0, 1) Else _CurrentDoc = -1
+ Goto Exit_Function
End Function ' _CurrentDoc V1.1.0
REM -----------------------------------------------------------------------------------------------------------------------
diff --git a/wizards/source/access2base/DoCmd.xba b/wizards/source/access2base/DoCmd.xba
index 54249ef..b88dcef 100644
--- a/wizards/source/access2base/DoCmd.xba
+++ b/wizards/source/access2base/DoCmd.xba
@@ -272,6 +272,7 @@ Dim bFound As Boolean, b2ndRound As Boolean, bStop As Boolean
Dim vFindValue As Variant, oFindrecord As Object
Set oFindRecord = _A2B_.FindRecord
+ If IsNull(oFindRecord) Then GoTo Error_FindRecord
With oFindRecord
If .FindRecord = 0 Then Goto Error_FindRecord
@@ -655,8 +656,8 @@ Public Function GoToControl(Optional ByVal pvControlName As variant) As Boolean
' Set the focus on the named control on the active form.
' Return False if the control does not exist or is disabled,
- Utils._SetCalledSub("GoToControl")
If _ErrorHandler() Then On Local Error Goto Error_Function
+ Utils._SetCalledSub("GoToControl")
If IsMissing(pvControlName) Then Call _TraceArguments()
If Not Utils._CheckArgument(pvControlName, 1, vbString) Then Goto Exit_Function
@@ -848,8 +849,8 @@ Public Function MoveSize(ByVal Optional pvLeft As Variant _
, ByVal Optional pvHeight As Variant _
) As Variant
' Execute MoveSize action
- Utils._SetCalledSub("MoveSize")
If _ErrorHandler() Then On Local Error Goto Error_Function
+ Utils._SetCalledSub("MoveSize")
MoveSize = False
If IsMissing(pvLeft) Then pvLeft = -1
If IsMissing(pvTop) Then pvTop = -1
@@ -1323,7 +1324,6 @@ Error_Sub:
End Sub ' RunApp V0.8.5
REM -----------------------------------------------------------------------------------------------------------------------
-REM -----------------------------------------------------------------------------------------------------------------------
Public Function RunCommand(Optional pvCommand As Variant) As Boolean
' Execute command via DispatchHelper
@@ -1771,9 +1771,9 @@ REM ----------------------------------------------------------------------------
Public Function ShowAllrecords() As Boolean
' Removes any existing filter that exists on the current table, query or form
+ If _ErrorHandler() Then On Local Error Goto Error_Function
Const cstThisSub = "ShowAllRecords"
Utils._SetCalledSub(cstThisSub)
- If _ErrorHandler() Then On Local Error Goto Error_Function
ShowAllRecords = False
Dim oWindow As Object, oDatabase As Object
diff --git a/wizards/source/access2base/Event.xba b/wizards/source/access2base/Event.xba
index e1408ab..0f3ed4b 100644
--- a/wizards/source/access2base/Event.xba
+++ b/wizards/source/access2base/Event.xba
@@ -297,9 +297,6 @@ Const cstDatabaseForm = "com.sun.star.comp.forms.ODatabaseForm"
End Select
' Evaluate ContextShortcut
- iCurrentDoc = Application._CurrentDoc()
- If iCurrentDoc < 0 Then Goto Exit_Function
- Set oDoc = _A2B_.CurrentDoc(iCurrentDoc)
sShortcut = ""
sImplementation = Utils._ImplementationName(oObject)
@@ -314,6 +311,10 @@ Const cstDatabaseForm = "com.sun.star.comp.forms.ODatabaseForm"
Case Else
End Select
+ iCurrentDoc = Application._CurrentDoc(, False)
+ If iCurrentDoc < 0 Then Goto Exit_Function
+ Set oDoc = _A2B_.CurrentDoc(iCurrentDoc)
+
' To manage 2x triggers of "Before record action" form event
If _EventType = "ROWCHANGEEVENT" And sImplementation <> "com.sun.star.comp.forms.ODatabaseForm" Then _Recommendation = "IGNORE"
diff --git a/wizards/source/access2base/L10N.xba b/wizards/source/access2base/L10N.xba
index ff1ce5b..b5f99a0 100644
--- a/wizards/source/access2base/L10N.xba
+++ b/wizards/source/access2base/L10N.xba
@@ -25,7 +25,7 @@ Dim sLocal As String
Select Case psLocale
Case "EN", "DEFAULT"
Select Case UCase(psShortlabel)
- Case "ERR" & ERRDBNOTCONNECTED : sLocal = "Connection to the database is not active"
+ Case "ERR" & ERRDBNOTCONNECTED : sLocal = "No active connection to a database found"
Case "ERR" & ERRMISSINGARGUMENTS : sLocal = "Arguments are missing or are not initialized"
Case "ERR" & ERRWRONGARGUMENT : sLocal = "Argument nr. %0 [Value = '%1'] is invalid"
Case "ERR" & ERRMAINFORM : sLocal = "Document '%0' does not contain any form"
@@ -129,7 +129,7 @@ Dim sLocal As String
End Select
Case "FR"
Select Case UCase(psShortlabel)
- Case "ERR" & ERRDBNOTCONNECTED : sLocal = "Pas de connexion active à la banque de données"
+ Case "ERR" & ERRDBNOTCONNECTED : sLocal = "Pas de connexion active trouvée à une banque de données"
Case "ERR" & ERRMISSINGARGUMENTS : sLocal = "Des arguments sont manquants ou non initialisés"
Case "ERR" & ERRWRONGARGUMENT : sLocal = "L'argument n° %0 [Valeur = '%1'] n'est pas valable"
Case "ERR" & ERRMAINFORM : sLocal = "Le document '%0' ne contient aucun formulaire"
diff --git a/wizards/source/access2base/PropertiesGet.xba b/wizards/source/access2base/PropertiesGet.xba
index ae4d170..e5bee5f 100644
--- a/wizards/source/access2base/PropertiesGet.xba
+++ b/wizards/source/access2base/PropertiesGet.xba
@@ -393,10 +393,10 @@ Public Function getObject(Optional pvShortcut As Variant) As Variant
Const cstEXCLAMATION = "!"
Const cstDOT = "."
+ If _ErrorHandler() Then On Local Error Goto Error_Function
Utils._SetCalledSub("getObject")
If IsMissing(pvShortcut) Then Call _TraceArguments()
If Not Utils._CheckArgument(pvShortcut, 1, vbString) Then Goto Exit_Function
- If _ErrorHandler() Then On Local Error Goto Error_Function
Dim iCurrentIndex As Integer, vCurrentObject As Variant, sCurrentProperty As String
Dim sComponents() As String, sSubComponents() As String, sDialog As String
diff --git a/wizards/source/access2base/Trace.xba b/wizards/source/access2base/Trace.xba
index 5017208..3c2943a 100644
--- a/wizards/source/access2base/Trace.xba
+++ b/wizards/source/access2base/Trace.xba
@@ -29,7 +29,7 @@ REM TraceConsole()
REM -----------------------------------------------------------------------------------------------------------------------
Public Sub TraceConsole()
' Display the Trace dialog with current trace log values and parameter choices
-If _ErrorHandler() Then On Local Error Goto Error_Sub
+ If _ErrorHandler() Then On Local Error Goto Error_Sub
Dim sLineBreak As String, oDialogLib As Object, oTraceDialog As Object
sLineBreak = Chr(10)
@@ -156,6 +156,7 @@ Public Sub TraceError(ByVal psErrorLevel As String _
' store error codes in trace buffer
On Local Error Resume Next
+ If IsEmpty(_A2B_) Then Call Application._RootInit() ' First use of Access2Base in current LibO/AOO session
Dim sErrorText As String, sErrorDesc As String, oDb As Object
sErrorDesc = _ErrorMessage(piErrorCode, pvArgs)
@@ -210,7 +211,8 @@ Public Sub TraceLog(Byval psTraceLevel As String _
, ByVal Optional pbMsgBox As Boolean _
)
' Store Text in trace log (circular buffer)
-If _ErrorHandler() Then On Local Error Goto Error_Sub
+
+ If _ErrorHandler() Then On Local Error Goto Error_Sub
Dim vTraceLogs() As String, sTraceLevel As String
With _A2B_
@@ -267,7 +269,7 @@ Private Sub _DumpToFile(oEvent As Object)
' Modified from Andrew Pitonyak's Base Macro Programming §10.4
-If _ErrorHandler() Then On Local Error GoTo Error_Sub
+ If _ErrorHandler() Then On Local Error GoTo Error_Sub
Dim sPath as String, iFileNumber As Integer, i As Integer
@@ -299,6 +301,7 @@ REM ----------------------------------------------------------------------------
Public Function _ErrorHandler(Optional ByVal pbCheck As Boolean) As Boolean
' Indicate if error handler is activated or not
' When argument present set error handler
+ If IsEmpty(_A2B_) Then Call Application._RootInit() ' First use of Access2Base in current LibO/AOO session
If Not IsMissing(pbCheck) Then _A2B_.ErrorHandler = pbCheck
_ErrorHandler = _A2B_.ErrorHandler
Exit Function
@@ -340,7 +343,7 @@ Public Function _PromptFilePicker(ByVal psSuffix As String) As String
' Return "" if Cancel
' Modified from Andrew Pitonyak's Base Macro Programming §10.4
-If _ErrorHandler() Then On Local Error GoTo Error_Function
+ If _ErrorHandler() Then On Local Error GoTo Error_Function
Dim oFileDialog as Object, oUcb as object, oPath As Object
Dim iAccept as Integer, sInitPath as String
diff --git a/wizards/source/access2base/Utils.xba b/wizards/source/access2base/Utils.xba
index 99c3cd8..5a9b302 100644
--- a/wizards/source/access2base/Utils.xba
+++ b/wizards/source/access2base/Utils.xba
@@ -600,6 +600,7 @@ REM ----------------------------------------------------------------------------
Public Sub _SetCalledSub(ByVal psSub As String) As String
' Called in top of each public function.
' Used to trace routine in/outs and to clarify error messages
+ If IsEmpty(_A2B_) Then Call Application._RootInit() ' First use of Access2Base in current LibO/AOO session
If _A2B_.CalledSub = "" Then _A2B_.CalledSub = psSub
If _A2B_.MinimalTraceLevel = 1 Then TraceLog(TRACEDEBUG, _GetLabel("Entering") & " " & psSub & " ...", False)
End Sub ' SetCalledSub
diff --git a/wizards/source/access2base/acConstants.xba b/wizards/source/access2base/acConstants.xba
index f8c1b4b..400a029 100644
--- a/wizards/source/access2base/acConstants.xba
+++ b/wizards/source/access2base/acConstants.xba
@@ -8,7 +8,7 @@ REM ============================================================================
Option Explicit
REM Access2Base -----------------------------------------------------
-Global Const Access2Base_Version = "1.1.0a"
+Global Const Access2Base_Version = "1.1.0b"
REM AcCloseSave
REM -----------------------------------------------------------------
More information about the Libreoffice-commits
mailing list