Kaydet (Commit) 5ca8203a authored tarafından Jean-Pierre Ledure's avatar Jean-Pierre Ledure

Access2Base - FIX Manage case of form without DrawPage

When a database form is not related to data
and has no control, then the DatabaseForm object is Null.
The Null value must be intercepted in many places.
üst 9adc7bdf
...@@ -1139,7 +1139,9 @@ Dim sFilter As String, oForm As Object, oFormsCollection As Object ...@@ -1139,7 +1139,9 @@ Dim sFilter As String, oForm As Object, oFormsCollection As Object
sFilter = "(" & pvFilterName & ") And (" & pvWhereCondition & ")" sFilter = "(" & pvFilterName & ") And (" & pvWhereCondition & ")"
End If End If
Set oFormsCollection = oOpenForm.DrawPage.Forms Set oFormsCollection = oOpenForm.DrawPage.Forms
If oFormsCollection.hasByName("MainForm") Then If oFormsCollection.Count = 0 Then
Set oForm = Nothing
ElseIf oFormsCollection.hasByName("MainForm") Then
Set oForm = oFormsCollection.getByName("MainForm") Set oForm = oFormsCollection.getByName("MainForm")
ElseIf oFormsCollection.hasByName("Form") Then ElseIf oFormsCollection.hasByName("Form") Then
Set oForm = oFormsCollection.getByName("Form") Set oForm = oFormsCollection.getByName("Form")
...@@ -1148,34 +1150,38 @@ Dim sFilter As String, oForm As Object, oFormsCollection As Object ...@@ -1148,34 +1150,38 @@ Dim sFilter As String, oForm As Object, oFormsCollection As Object
Else Else
Goto Trace_Error Goto Trace_Error
End If End If
If sFilter <> "" Then If Not IsNull(oForm) Then
oForm.Filter = oDatabase._ReplaceSquareBrackets(sFilter) If sFilter <> "" Then
oForm.ApplyFilter = True oForm.Filter = oDatabase._ReplaceSquareBrackets(sFilter)
oForm.reload() oForm.ApplyFilter = True
ElseIf oForm.Filter <> "" Then ' If a filter has been set previously it must be removed oForm.reload()
oForm.Filter = "" ElseIf oForm.Filter <> "" Then ' If a filter has been set previously it must be removed
oForm.ApplyFilter = False oForm.Filter = ""
oForm.reload() oForm.ApplyFilter = False
oForm.reload()
End If
End If End If
'Housekeeping 'Housekeeping
Set ofForm = Application.AllForms(pvFormName) ' Redone to reinitialize all properties of ofForm now FormName is open Set ofForm = Application.AllForms(pvFormName) ' Redone to reinitialize all properties of ofForm now FormName is open
With ofForm With ofForm
Select Case pvDataMode If Not IsNull(.DatabaseForm) Then
Case acFormAdd Select Case pvDataMode
.AllowAdditions = True Case acFormAdd
.AllowDeletions = False .AllowAdditions = True
.AllowEdits = False .AllowDeletions = False
Case acFormEdit .AllowEdits = False
.AllowAdditions = True Case acFormEdit
.AllowDeletions = True .AllowAdditions = True
.AllowEdits = True .AllowDeletions = True
Case acFormReadOnly .AllowEdits = True
.AllowAdditions = False Case acFormReadOnly
.AllowDeletions = False .AllowAdditions = False
.AllowEdits = False .AllowDeletions = False
Case acFormPropertySettings .AllowEdits = False
End Select Case acFormPropertySettings
End Select
End If
.Visible = ( pvWindowMode <> acHidden ) .Visible = ( pvWindowMode <> acHidden )
._OpenArgs = pvOpenArgs ._OpenArgs = pvOpenArgs
'To avoid AOO 3,4 bug See http://user.services.openoffice.org/en/forum/viewtopic.php?f=13&t=53751 'To avoid AOO 3,4 bug See http://user.services.openoffice.org/en/forum/viewtopic.php?f=13&t=53751
......
...@@ -491,7 +491,7 @@ Dim j As Integer ...@@ -491,7 +491,7 @@ Dim j As Integer
Set ocControl = New Control Set ocControl = New Control
ocControl._ParentType = CTLPARENTISFORM ocControl._ParentType = CTLPARENTISFORM
sParentShortcut = _Shortcut sParentShortcut = _Shortcut
iControlCount = DatabaseForm.getCount() If IsNull(DatabaseForm) Then iControlCount = 0 Else iControlCount = DatabaseForm.getCount()
If IsMissing(pvIndex) Then ' No argument, return Collection pseudo-object If IsMissing(pvIndex) Then ' No argument, return Collection pseudo-object
Set oCounter = New Collect Set oCounter = New Collect
...@@ -777,7 +777,9 @@ Dim oDoc As Object, oFormsCollection As Object, oDatabase As Object ...@@ -777,7 +777,9 @@ Dim oDoc As Object, oFormsCollection As Object, oDatabase As Object
If Not IsNull(Component.CurrentController) Then ' A form opened then closed afterwards keeps a Component attribute If Not IsNull(Component.CurrentController) Then ' A form opened then closed afterwards keeps a Component attribute
Set ContainerWindow = Component.CurrentController.Frame.ContainerWindow Set ContainerWindow = Component.CurrentController.Frame.ContainerWindow
Set oFormsCollection = Component.getDrawPage.Forms Set oFormsCollection = Component.getDrawPage.Forms
If oFormsCollection.hasByName("MainForm") Then If oFormsCollection.Count = 0 Then
Set DatabaseForm = Nothing
ElseIf oFormsCollection.hasByName("MainForm") Then
Set DatabaseForm = oFormsCollection.getByName("MainForm") Set DatabaseForm = oFormsCollection.getByName("MainForm")
ElseIf oFormsCollection.hasByName("Form") Then ElseIf oFormsCollection.hasByName("Form") Then
Set DatabaseForm = oFormsCollection.getByName("Form") Set DatabaseForm = oFormsCollection.getByName("Form")
...@@ -801,7 +803,7 @@ Dim oDoc As Object, oFormsCollection As Object, oDatabase As Object ...@@ -801,7 +803,7 @@ Dim oDoc As Object, oFormsCollection As Object, oDatabase As Object
End If End If
End With End With
End Select End Select
_OrderBy = DatabaseForm.Order If IsNull(DatabaseForm) Then _OrderBy = "" Else _OrderBy = DatabaseForm.Order
Else Else
Set Component = Nothing Set Component = Nothing
Set ContainerWindow = Nothing Set ContainerWindow = Nothing
...@@ -857,17 +859,21 @@ Dim i As Integer, oObject As Object ...@@ -857,17 +859,21 @@ Dim i As Integer, oObject As Object
Select Case UCase(psProperty) Select Case UCase(psProperty)
Case UCase("AllowAdditions") Case UCase("AllowAdditions")
_PropertyGet = DatabaseForm.AllowInserts If IsNull(DatabaseForm) Then _PropertyGet = False Else _PropertyGet = DatabaseForm.AllowInserts
Case UCase("AllowDeletions") Case UCase("AllowDeletions")
_PropertyGet = DatabaseForm.AllowDeletes If IsNull(DatabaseForm) Then _PropertyGet = False Else _PropertyGet = DatabaseForm.AllowDeletes
Case UCase("AllowEdits") Case UCase("AllowEdits")
_PropertyGet = DatabaseForm.AllowUpdates If IsNull(DatabaseForm) Then _PropertyGet = False Else _PropertyGet = DatabaseForm.AllowUpdates
Case UCase("Bookmark") Case UCase("Bookmark")
On Local Error Resume Next ' Disable error handler because bookmarking does not always react well in events ... If IsNull(DatabaseForm) Then
If DatabaseForm.IsBookmarkable Then vBookmark = DatabaseForm.getBookmark() Else vBookmark = Nothing _PropertyGet = 0
If _ErrorHandler() Then On Local Error Goto Error_Function Else On Local Error Goto 0 Else
If IsNull(vBookmark) Then Goto Trace_Error On Local Error Resume Next ' Disable error handler because bookmarking does not always react well in events ...
_PropertyGet = vBookmark If DatabaseForm.IsBookmarkable Then vBookmark = DatabaseForm.getBookmark() Else vBookmark = Nothing
If _ErrorHandler() Then On Local Error Goto Error_Function Else On Local Error Goto 0
If IsNull(vBookmark) Then Goto Trace_Error
_PropertyGet = vBookmark
End If
Case UCase("Caption") Case UCase("Caption")
Set odatabase = Application._CurrentDb(_DocEntry, _DbEntry) Set odatabase = Application._CurrentDb(_DocEntry, _DbEntry)
Select Case oDatabase._DbConnect Select Case oDatabase._DbConnect
...@@ -875,11 +881,11 @@ Dim i As Integer, oObject As Object ...@@ -875,11 +881,11 @@ Dim i As Integer, oObject As Object
Case DBCONNECTBASE : _PropertyGet = Component.CurrentController.Frame.Title Case DBCONNECTBASE : _PropertyGet = Component.CurrentController.Frame.Title
End Select End Select
Case UCase("CurrentRecord") Case UCase("CurrentRecord")
_PropertyGet = DatabaseForm.Row If IsNull(DatabaseForm) Then _PropertyGet = 0 Else _PropertyGet = DatabaseForm.Row
Case UCase("Filter") Case UCase("Filter")
_PropertyGet = DatabaseForm.Filter If IsNull(DatabaseForm) Then _PropertyGet = "" Else _PropertyGet = DatabaseForm.Filter
Case UCase("FilterOn") Case UCase("FilterOn")
_PropertyGet = DatabaseForm.ApplyFilter If IsNull(DatabaseForm) Then _PropertyGet = False Else _PropertyGet = DatabaseForm.ApplyFilter
Case UCase("Height") Case UCase("Height")
_PropertyGet = ContainerWindow.getPosSize().Height _PropertyGet = ContainerWindow.getPosSize().Height
Case UCase("IsLoaded") ' Only for indirect access from property object Case UCase("IsLoaded") ' Only for indirect access from property object
...@@ -892,14 +898,15 @@ Dim i As Integer, oObject As Object ...@@ -892,14 +898,15 @@ Dim i As Integer, oObject As Object
, UCase("OnApproveSubmit"), UCase("OnConfirmDelete"), UCase("OnCursorMoved"), UCase("OnErrorOccurred") _ , UCase("OnApproveSubmit"), UCase("OnConfirmDelete"), UCase("OnCursorMoved"), UCase("OnErrorOccurred") _
, UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnResetted"), UCase("OnRowChanged") _ , UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnResetted"), UCase("OnRowChanged") _
, UCase("OnUnloaded"), UCase("OnUnloading") , UCase("OnUnloaded"), UCase("OnUnloading")
_PropertyGet = Utils._GetEventScriptCode(DatabaseForm, psProperty, _Name, True) If IsNull(DatabaseForm) Then _PropertyGet = "" Else _PropertyGet = Utils._GetEventScriptCode(DatabaseForm, psProperty, _Name, True)
Case UCase("OpenArgs") Case UCase("OpenArgs")
_PropertyGet = _OpenArgs _PropertyGet = _OpenArgs
Case UCase("OrderBy") Case UCase("OrderBy")
_PropertyGet = _OrderBy _PropertyGet = _OrderBy
Case UCase("OrderByOn") Case UCase("OrderByOn")
If DatabaseForm.Order = "" Then _PropertyGet = False Else _PropertyGet = True If IsNull(DatabaseForm) Then _PropertyGet = False Else _PropertyGet = ( DatabaseForm.Order <> "" )
Case UCase("Recordset") Case UCase("Recordset")
If IsNull(DatabaseForm) Then Goto Trace_Error
If DatabaseForm.Command = "" Then Goto Trace_Error ' No underlying data ?? If DatabaseForm.Command = "" Then Goto Trace_Error ' No underlying data ??
Set oObject = New Recordset Set oObject = New Recordset
With DatabaseForm With DatabaseForm
...@@ -923,7 +930,7 @@ Dim i As Integer, oObject As Object ...@@ -923,7 +930,7 @@ Dim i As Integer, oObject As Object
If Not ( oObject._BOF And oObject._EOF ) Then oObject.MoveFirst() ' Do nothing if resultset empty If Not ( oObject._BOF And oObject._EOF ) Then oObject.MoveFirst() ' Do nothing if resultset empty
Set _PropertyGet = oObject Set _PropertyGet = oObject
Case UCase("RecordSource") Case UCase("RecordSource")
_PropertyGet = DatabaseForm.Command If IsNull(DatabaseForm) Then _PropertyGet = "" Else _PropertyGet = DatabaseForm.Command
Case UCase("Visible") Case UCase("Visible")
_PropertyGet = ContainerWindow.IsVisible() _PropertyGet = ContainerWindow.IsVisible()
Case UCase("Width") Case UCase("Width")
...@@ -966,19 +973,23 @@ Dim oDatabase As Object ...@@ -966,19 +973,23 @@ Dim oDatabase As Object
Select Case UCase(psProperty) Select Case UCase(psProperty)
Case UCase("AllowAdditions") Case UCase("AllowAdditions")
If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
If IsNull(DatabaseForm) Then Goto Trace_Error
DatabaseForm.AllowInserts = pvValue DatabaseForm.AllowInserts = pvValue
DatabaseForm.reload() DatabaseForm.reload()
Case UCase("AllowDeletions") Case UCase("AllowDeletions")
If Not Utils._CheckArgument(pvValue,iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value If Not Utils._CheckArgument(pvValue,iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
If IsNull(DatabaseForm) Then Goto Trace_Error
DatabaseForm.AllowDeletes = pvValue DatabaseForm.AllowDeletes = pvValue
DatabaseForm.reload() DatabaseForm.reload()
Case UCase("AllowEdits") Case UCase("AllowEdits")
If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
If IsNull(DatabaseForm) Then Goto Trace_Error
DatabaseForm.AllowUpdates = pvValue DatabaseForm.AllowUpdates = pvValue
DatabaseForm.reload() DatabaseForm.reload()
Case UCase("Bookmark") Case UCase("Bookmark")
If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(vbObject), , False) Then Goto Trace_Error_Value If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(vbObject), , False) Then Goto Trace_Error_Value
If IsNull(pvValue) Then Goto Trace_Error_Value If IsNull(pvValue) Then Goto Trace_Error_Value
If IsNull(DatabaseForm) Then Goto Trace_Error
DatabaseForm.MoveToBookmark(pvValue) DatabaseForm.MoveToBookmark(pvValue)
Case UCase("Caption") Case UCase("Caption")
If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
...@@ -990,12 +1001,15 @@ Dim oDatabase As Object ...@@ -990,12 +1001,15 @@ Dim oDatabase As Object
Case UCase("CurrentRecord") Case UCase("CurrentRecord")
If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
If pvValue < 1 Then Goto Trace_Error_Value If pvValue < 1 Then Goto Trace_Error_Value
If IsNull(DatabaseForm) Then Goto Trace_Error
DatabaseForm.absolute(pvValue) DatabaseForm.absolute(pvValue)
Case UCase("Filter") Case UCase("Filter")
If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
If IsNull(DatabaseForm) Then Goto Trace_Error
DatabaseForm.Filter = Application._CurrentDb(_DocEntry, _DbEntry)._ReplaceSquareBrackets(pvValue) DatabaseForm.Filter = Application._CurrentDb(_DocEntry, _DbEntry)._ReplaceSquareBrackets(pvValue)
Case UCase("FilterOn") Case UCase("FilterOn")
If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
If IsNull(DatabaseForm) Then Goto Trace_Error
DatabaseForm.ApplyFilter = pvValue DatabaseForm.ApplyFilter = pvValue
DatabaseForm.reload() DatabaseForm.reload()
Case UCase("Height") Case UCase("Height")
...@@ -1010,6 +1024,7 @@ Dim oDatabase As Object ...@@ -1010,6 +1024,7 @@ Dim oDatabase As Object
, UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnResetted"), UCase("OnRowChanged") _ , UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnResetted"), UCase("OnRowChanged") _
, UCase("OnUnloaded"), UCase("OnUnloading") , UCase("OnUnloaded"), UCase("OnUnloading")
If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
If IsNull(DatabaseForm) Then Goto Trace_Error
If Not Utils._RegisterEventScript(DatabaseForm _ If Not Utils._RegisterEventScript(DatabaseForm _
, psProperty _ , psProperty _
, _GetListener(psProperty) _ , _GetListener(psProperty) _
...@@ -1017,13 +1032,16 @@ Dim oDatabase As Object ...@@ -1017,13 +1032,16 @@ Dim oDatabase As Object
) Then GoTo Trace_Error ) Then GoTo Trace_Error
Case UCase("OrderBy") Case UCase("OrderBy")
If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
If IsNull(DatabaseForm) Then Goto Trace_Error
_OrderBy = Application._CurrentDb(_DocEntry, _DbEntry)._ReplaceSquareBrackets(pvValue) _OrderBy = Application._CurrentDb(_DocEntry, _DbEntry)._ReplaceSquareBrackets(pvValue)
Case UCase("OrderByOn") Case UCase("OrderByOn")
If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
If IsNull(DatabaseForm) Then Goto Trace_Error
If pvValue Then DatabaseForm.Order = _OrderBy Else DatabaseForm.Order = "" If pvValue Then DatabaseForm.Order = _OrderBy Else DatabaseForm.Order = ""
DatabaseForm.reload() DatabaseForm.reload()
Case UCase("RecordSource") Case UCase("RecordSource")
If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
If IsNull(DatabaseForm) Then Goto Trace_Error
DatabaseForm.Command = Application._CurrentDb(_DocEntry, _DbEntry)._ReplaceSquareBrackets(pvValue) DatabaseForm.Command = Application._CurrentDb(_DocEntry, _DbEntry)._ReplaceSquareBrackets(pvValue)
DatabaseForm.CommandType = com.sun.star.sdb.CommandType.COMMAND DatabaseForm.CommandType = com.sun.star.sdb.CommandType.COMMAND
DatabaseForm.Filter = "" DatabaseForm.Filter = ""
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment