diff options
author | Jean-Pierre Ledure <jp@ledure.be> | 2014-08-12 12:08:48 +0200 |
---|---|---|
committer | Jean-Pierre Ledure <jp@ledure.be> | 2014-08-17 06:18:45 -0500 |
commit | 8393014898d67795f44835791aa0d9ed535be5d3 (patch) | |
tree | 56c5c25caa6746279461d416cb3bde0b52be31e7 /wizards | |
parent | 99b9e06b7cdfd1f3336226583d73aa49cc6ce305 (diff) |
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@ledure.be>
Tested-by: Jean-Pierre Ledure <jp@ledure.be>
Diffstat (limited to 'wizards')
-rw-r--r-- | wizards/source/access2base/Application.xba | 23 | ||||
-rw-r--r-- | wizards/source/access2base/DoCmd.xba | 8 | ||||
-rw-r--r-- | wizards/source/access2base/Event.xba | 7 | ||||
-rw-r--r-- | wizards/source/access2base/L10N.xba | 4 | ||||
-rw-r--r-- | wizards/source/access2base/PropertiesGet.xba | 2 | ||||
-rw-r--r-- | wizards/source/access2base/Trace.xba | 11 | ||||
-rw-r--r-- | wizards/source/access2base/Utils.xba | 1 | ||||
-rw-r--r-- | wizards/source/access2base/acConstants.xba | 2 |
8 files changed, 35 insertions, 23 deletions
diff --git a/wizards/source/access2base/Application.xba b/wizards/source/access2base/Application.xba index 04dceb079b0b..8b2af9a392e6 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 54249ef12734..b88dcefb446f 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 e1408ab691e2..0f3ed4bc8945 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 ff1ce5bcc29e..b5f99a0d7b95 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 ae4d170b20ae..e5bee5f6f8a5 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 5017208155bb..3c2943a7be96 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 99c3cd883e2c..5a9b302c093a 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 f8c1b4bbe5ee..400a0292470d 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 ----------------------------------------------------------------- |