Access2Base - Support of forms collections

In LO forms as known in the Base UI may have more than 1
main forms, all belonging to a forms collection.

MSAccess does not have that feature.

So far, only forms with 1 main form - from far the majority of cases -
were fully supported by Access2Base. For other forms, the
exploration of controls in additional main forms was not
implemented.

Current limitation: some form properties (e.g. RecordSource) are
still limited to the firt member of the forms collection.

wizards/source/access2base/Control.xba

@@ -21,6 +21,7 @@ Private	_ParentType				As String				'	One of CTLPARENTISxxxx constants
 Private	_Shortcut				As String
 Private	_Name					As String
 Private _FormComponent			As Object				'	com.sun.star.text.TextDocument
+Private _MainForm				As String				'	To be propagated to all subcontrols
 Private _DocEntry				As Integer				'	Doc- and DbContainer entries in Root structure
 Private _DbEntry				As Integer
 Private	_ControlType			As Integer
@@ -41,6 +42,7 @@ Private Sub Class_Initialize()
 	_Shortcut			= ""
 	_Name				= ""
 	Set _FormComponent	= Nothing
+	_MainForm = ""
 	_DocEntry			= -1
 	_DbEntry			= -1
 	_ThisProperties		= Array()
@@ -795,27 +797,30 @@ Dim j As Integer, oView As Object
 			If bFound Then ocControl._Name = sControls(i) Else Goto Trace_NotFound
 	End Select
 
-	ocControl._Shortcut = sParentShortcut & "!" & Utils._Surround(ocControl._Name)
-	Set ocControl.ControlModel = ControlModel.getByName(ocControl._Name)
-	ocControl._ImplementationName = ocControl.ControlModel.ColumnServiceName	'	getImplementationName aborts for subcontrols !?
-	ocControl._FormComponent = ParentComponent
-	If Utils._hasUNOProperty(ocControl.ControlModel, "ClassId") Then ocControl._ClassId = ocControl.ControlModel.ClassId
-	'	Complex bypass to find View of grid subcontrols !
-	If Not IsNull(ControlView) Then		'	Anticipate absence of ControlView in grid controls when edit mode
-		For i = 0 to ControlView.getCount() - 1
-			Set oView = ControlView.GetByIndex(i)
-			If Not IsNull(oView) Then
-				If oView.getModel.Name = ocControl._Name Then
-					Set ocControl.ControlView = oView
-					Exit For
+	With ocControl
+		._Shortcut = sParentShortcut & "!" & Utils._Surround(._Name)
+		Set .ControlModel = ControlModel.getByName(._Name)
+		._ImplementationName = .ControlModel.ColumnServiceName	'	getImplementationName aborts for subcontrols !?
+		._FormComponent = ParentComponent
+		._MainForm = _MainForm
+		If Utils._hasUNOProperty(.ControlModel, "ClassId") Then ._ClassId = .ControlModel.ClassId
+		'	Complex bypass to find View of grid subcontrols !
+		If Not IsNull(ControlView) Then		'	Anticipate absence of ControlView in grid controls when edit mode
+			For i = 0 to ControlView.getCount() - 1
+				Set oView = ControlView.GetByIndex(i)
+				If Not IsNull(oView) Then
+					If oView.getModel.Name = ._Name Then
+						Set .ControlView = oView
+						Exit For
+					End If
 				End If
-			End If
-		Next i
-	End If
+			Next i
+		End If
 
-	ocControl._Initialize()
-	ocControl._DocEntry = _DocEntry
-	ocControl._DbEntry = _DbEntry
+		._Initialize()
+		._DocEntry = _DocEntry
+		._DbEntry = _DbEntry
+	End With
 	Set Controls = ocControl
 	
 Exit_Function:
@@ -1509,6 +1514,7 @@ Dim oControlEvents As Object, sEventName As String
 				Set .DatabaseForm = ControlModel
 				._Name = _Name
 				._Shortcut = _Shortcut & ".Form"
+				._MainForm = _MainForm
 				.ParentComponent = _FormComponent
 				._DocEntry = _DocEntry
 				._DbEntry = _DbEntry

wizards/source/access2base/DoCmd.xba

@@ -1139,18 +1139,6 @@ Dim sFilter As String, oForm As Object, oFormsCollection As Object
 	Else
 		sFilter = "(" & pvFilterName & ") And (" & pvWhereCondition & ")"
 	End If
-	Set oFormsCollection = oOpenForm.DrawPage.Forms
-	If oFormsCollection.Count = 0 Then
-		Set oForm = Nothing
-	ElseIf oFormsCollection.hasByName("MainForm") Then
-		Set oForm = oFormsCollection.getByName("MainForm")
-	ElseIf oFormsCollection.hasByName("Form") Then
-		Set oForm = oFormsCollection.getByName("Form")
-	ElseIf oFormsCollection.hasByName(ofForm._Name) Then
-		Set oForm = oFormsCollection.getByName(ofForm._Name)
-	Else
-		Goto Trace_Error
-	End If
 	If Not IsNull(oForm) Then
 		If sFilter <> "" Then
 			oForm.Filter = oDatabase._ReplaceSquareBrackets(sFilter)

wizards/source/access2base/Form.xba

@@ -19,11 +19,13 @@ Private	_Shortcut				As String
 Private	_Name					As String
 Private _DocEntry				As Integer				'	Doc- and DbContainer entries in Root structure
 Private _DbEntry				As Integer
+Private _MainForms				As Variant
 Private	_IsLoaded				As Boolean
 Private	_OpenArgs				As Variant
 Private _OrderBy				As String
 Public	Component				As Object				'	com.sun.star.text.TextDocument
 Public	ContainerWindow			As Object				'	(No name)
+Public	FormsCollection			As Object				'	com.sun.star.form.OFormsCollection
 Public	DatabaseForm			As Object				'	com.sun.star.form.component.DataForm and com.sun.star.sdb.ResultSet (a.o.)
 
 REM -----------------------------------------------------------------------------------------------------------------------
@@ -35,11 +37,13 @@ Private Sub Class_Initialize()
 	_Name = ""
 	_DocEntry = -1
 	_DbEntry = -1
+	_MainForms = Array()
 	_IsLoaded = False
 	_OpenArgs = ""
 	_OrderBy = ""
 	Set Component = Nothing
 	Set ContainerWindow = Nothing
+	Set FormsCollection = Nothing
 	Set DatabaseForm = Nothing
 End Sub		'	Constructor
 
@@ -377,7 +381,7 @@ Dim ogGroup As Object
 	If IsMissing(pvGroupName) Then Call _TraceArguments()
 	If _ErrorHandler() Then On Local Error Goto Error_Function
 	
-	Set ogGroup = _OptionGroup(pvGroupName, CTLPARENTISFORM, Component, DatabaseForm)
+	Set ogGroup = _OptionGroup(pvGroupName, CTLPARENTISFORM, Component, FormsCollection)
 	If Not IsNull(ogGroup) Then
 		ogGroup._DocEntry = _DocEntry
 		ogGroup._DbEntry = _DbEntry
@@ -482,16 +486,20 @@ Public Function Controls(Optional ByVal pvIndex As Variant) As Variant
 If _ErrorHandler() Then On Local Error Goto Error_Function
 	Utils._SetCalledSub("Form.Controls")
 
-Dim ocControl As Variant, sParentShortcut As String, iControlCount As Integer
+Dim ocControl As Variant, iControlCount As Integer
 Dim oCounter As Variant, sControls() As Variant, i As Integer, bFound As Boolean, sIndex As String
-Dim j As Integer
+Dim j As Integer, iCount As Integer, sName As String, iAddCount As Integer
+Dim oDatabaseForm As Object, iCtlCount As Integer
 
 	Set ocControl = Nothing
 	If Not IsLoaded Then Goto Trace_Error_NotOpen
-	Set ocControl = New Control
-	ocControl._ParentType = CTLPARENTISFORM
-	sParentShortcut = _Shortcut
-	If IsNull(DatabaseForm) Then iControlCount = 0 Else iControlCount = DatabaseForm.getCount()
+	'Count number of controls thru the forms collection
+	iControlCount = 0
+	iCount = FormsCollection.Count
+	For i = 0 To iCount - 1
+		If i = 0 Then Set oDatabaseForm = DatabaseForm Else Set oDatabaseForm = FormsCollection.getByIndex(i)
+		If Not IsNull(oDatabaseForm) Then iControlCount = iControlCount + oDatabaseForm.getCount()
+	Next i
 	
 	If IsMissing(pvIndex) Then					'	No argument, return Collection pseudo-object
 		Set oCounter = New Collect
@@ -507,36 +515,62 @@ Dim j As Integer
 				
 	'	Start building the ocControl object
 	'	Determine exact name
-	sControls() = DatabaseForm.getElementNames()
-	
+
+	sName = ""
 	Select Case VarType(pvIndex)
 		Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal
 			If pvIndex < 0 Or pvIndex > iControlCount - 1 Then Goto Trace_Error_Index
-			ocControl._Name = sControls(pvIndex)
+			iAddCount = 0
+			For i = 0 To iCount - 1
+				If i = 0 Then Set oDatabaseForm = DatabaseForm Else Set oDatabaseForm = FormsCollection.getByIndex(i)
+				If Not IsNull(oDatabaseForm) Then
+					iCtlCount = oDatabaseForm.getCount()
+					If pvIndex >= iAddCount And pvIndex <= iAddcount + iCtlCount - 1 Then
+						sName = oDatabaseForm.ElementNames(pvIndex - iAddCount)
+						Exit For
+					End If
+					iAddCount = iAddcount +iCtlCount
+				End If
+			Next i
 		Case vbString			'	Check control name validity (non case sensitive)
-			bFound = False
 			sIndex = UCase(Utils._Trim(pvIndex))
-			For i = 0 To iControlCount - 1
-				If UCase(sControls(i)) = sIndex Then
-					bFound = True
-					Exit For
+			bFound = False
+			For i = 0 To iCount - 1
+				If i = 0 Then Set oDatabaseForm = DatabaseForm Else Set oDatabaseForm = FormsCollection.getByIndex(i)
+				If Not IsNull(oDatabaseForm) Then
+					sControls() = oDatabaseForm.getElementNames()
+					For j = 0 To UBound(sControls)
+						If UCase(sControls(j)) = sIndex Then
+							sName = sControls(j)
+							bFound = True
+							Exit For
+						End If
+					Next j
+					If bFound Then Exit For
 				End If
 			Next i
-			If bFound Then ocControl._Name = sControls(i) Else Goto Trace_NotFound
+			If Not bFound Then Goto Trace_NotFound
 	End Select
 
-	ocControl._Shortcut = sParentShortcut & "!" & Utils._Surround(ocControl._Name)
-	Set ocControl.ControlModel = DatabaseForm.getByName(ocControl._Name)
-	ocControl._ImplementationName = ocControl.ControlModel.getImplementationName()
-	ocControl._FormComponent = Component
-	If Utils._hasUNOProperty(ocControl.ControlModel, "ClassId") Then ocControl._ClassId = ocControl.ControlModel.ClassId
-	If ocControl._ClassId > 0 And ocControl._ClassId <> acHiddenControl Then
-		Set ocControl.ControlView = Component.CurrentController.getControl(ocControl.ControlModel)
-	End If
+	'Initialize a new Control object
+	Set ocControl = New Control
+	With ocControl
+		._ParentType = CTLPARENTISFORM
+		._Name = sName
+		._Shortcut = _Shortcut & "!" & Utils._Surround(sName)
+		If IsNull(oDatabaseForm) Then ._MainForm = "" Else ._MainForm = oDatabaseForm.Name
+		Set .ControlModel = oDatabaseForm.getByName(sName)
+		._ImplementationName = .ControlModel.getImplementationName()
+		._FormComponent = Component
+		If Utils._hasUNOProperty(.ControlModel, "ClassId") Then ._ClassId = .ControlModel.ClassId
+		If ._ClassId > 0 And ._ClassId <> acHiddenControl Then
+			Set .ControlView = Component.CurrentController.getControl(.ControlModel)
+		End If
 
-	ocControl._Initialize()
-	ocControl._DocEntry = _DocEntry
-	ocControl._DbEntry = _DbEntry
+		._Initialize()
+		._DocEntry = _DocEntry
+		._DbEntry = _DbEntry
+	End With
 	Set Controls = ocControl
 	
 Exit_Function:
@@ -736,6 +770,7 @@ REM ----------------------------------------------------------------------------
 REM --- PRIVATE FUNCTIONS 								        														---
 REM -----------------------------------------------------------------------------------------------------------------------
 
+REM -----------------------------------------------------------------------------------------------------------------------
 Private Function _GetListener(ByVal psProperty As String) As String
 '	Return the X...Listener corresponding with the property in argument
 
@@ -766,7 +801,7 @@ REM ----------------------------------------------------------------------------
 Public Sub _Initialize(psName As String)
 '	Set pointers to UNO objects
 
-Dim oDoc As Object, oFormsCollection As Object, oDatabase As Object
+Dim oDoc As Object, oDatabase As Object
 	If _ErrorHandler() Then On Local Error Goto Trace_Error
 	_Name = psName
 	_Shortcut = "Forms!" & Utils._Surround(psName)
@@ -776,17 +811,14 @@ Dim oDoc As Object, oFormsCollection As Object, oDatabase As Object
 			Case DBCONNECTBASE
 				If Not IsNull(Component.CurrentController) Then		'	A form opened then closed afterwards keeps a Component attribute
 					Set ContainerWindow = Component.CurrentController.Frame.ContainerWindow
-					Set oFormsCollection = Component.getDrawPage.Forms
-					If oFormsCollection.Count = 0 Then
+					Set FormsCollection = Component.getDrawPage.Forms
+					If FormsCollection.Count = 0 Then
 						Set DatabaseForm = Nothing
-					ElseIf oFormsCollection.hasByName("MainForm") Then
-						Set DatabaseForm = oFormsCollection.getByName("MainForm")
-					ElseIf oFormsCollection.hasByName("Form") Then
-						Set DatabaseForm = oFormsCollection.getByName("Form")
-					ElseIf oFormsCollection.hasByName(_Name) Then
-						Set DatabaseForm = oFormsCollection.getByName(_Name)
 					Else
-						Goto Trace_Internal_Error
+						'Only first member of the collection can be reached with A2B
+						'Compliant with MSAccess which has 1 datasource by form, while LO might have many
+						_MainForms = FormsCollection.ElementNames()
+						Set DatabaseForm = FormsCollection.getByIndex(0)
 					End If
 				End If
 			Case DBCONNECTFORM

wizards/source/access2base/Methods.xba

@@ -200,7 +200,7 @@ REM ----------------------------------------------------------------------------
 Public Function _OptionGroup(ByVal pvGroupName As Variant _
 					, ByVal psParentType As String _
 					, poComponent As Object _
-					, poDatabaseForm As Object _
+					, poParent As Object _
 					) As Variant
 '	Return either an error or an object of type OPTIONGROUP based on its name
 
@@ -213,24 +213,48 @@ Public Function _OptionGroup(ByVal pvGroupName As Variant _
 Dim ogGroup As Variant, i As Integer, j As Integer, bFound As Boolean
 Dim vOptionButtons() As Variant, sGroupName As String
 Dim lXY() As Long, iIndex() As Integer		'	Two indexes X-Y coordinates
-Dim oView As Object
+Dim oView As Object, oDatabaseForm As Object, vControls As Variant
 
 Const cstPixels = 10							'	Tolerance on coordinates when drawed approximately
+
 	bFound = False
-	For i = 0 To poDatabaseForm.GroupCount - 1		'	Does a group with the right name exist ?
-		poDatabaseForm.getGroup(i, vOptionButtons, sGroupName)
-		If UCase(sGroupName) = UCase(Utils._Trim(pvGroupName)) Then
-			bFound = True
-			Exit For
-		End If
-	Next i
+	Select Case psParentType
+		Case CTLPARENTISFORM
+			'poParent is a forms collection, find the appropriate database form
+			For i = 0 To poParent.Count - 1
+				Set oDatabaseForm = poParent.getByIndex(i)
+				If Not IsNull(oDatabaseForm) Then
+					For j = 0 To oDatabaseForm.GroupCount - 1		'	Does a group with the right name exist ?
+						oDatabaseForm.getGroup(j, vOptionButtons, sGroupName)
+						If UCase(sGroupName) = UCase(Utils._Trim(pvGroupName)) Then
+							bFound = True
+							Exit For
+						End If
+					Next j
+					If bFound Then Exit For
+				End If
+				If bFound Then Exit For
+			Next i
+		Case CTLPARENTISSUBFORM
+			'poParent is already a database form
+			Set oDatabaseForm = poParent
+			For j = 0 To oDatabaseForm.GroupCount - 1		'	Does a group with the right name exist ?
+				oDatabaseForm.getGroup(j, vOptionButtons, sGroupName)
+				If UCase(sGroupName) = UCase(Utils._Trim(pvGroupName)) Then
+					bFound = True
+					Exit For
+				End If
+			Next j
+	End Select
 
 	If bFound Then
+
 		ogGroup = New Optiongroup
 		ogGroup._Name = sGroupName
 		ogGroup._ButtonsGroup = vOptionButtons
 		ogGroup._Count = UBound(vOptionButtons) + 1
 		ogGroup._ParentType = psParentType
+		ogGroup._MainForm = oDatabaseForm.Name
 		Set ogGroup._ParentComponent = poComponent
 
 		ReDim lXY(1, ogGroup._Count - 1)

wizards/source/access2base/OptionGroup.xba

@@ -18,6 +18,7 @@ Private	_Type					As String				'	Must be FORM
 Private	_Name					As String
 Private _ParentType				As String
 Private _ParentComponent		As Object
+Private _MainForm				As String
 Private _DocEntry				As Integer
 Private _DbEntry				As Integer
 Private _ButtonsGroup()			As Variant

wizards/source/access2base/SubForm.xba

@@ -17,6 +17,7 @@ REM ----------------------------------------------------------------------------
 Private	_Type					As String				'	Must be SUBFORM
 Private	_Shortcut				As String
 Private	_Name					As String
+Private _MainForm				As String
 Private _DocEntry				As Integer
 Private _DbEntry				As Integer
 Private _OrderBy				As String
@@ -30,6 +31,7 @@ Private Sub Class_Initialize()
 	_Type = OBJSUBFORM
 	_Shortcut = ""
 	_Name = ""
+	_MainForm = ""
 	_DocEntry = -1
 	_DbEntry = -1
 	_OrderBy = ""
@@ -409,18 +411,20 @@ Dim j As Integer
 			If bFound Then ocControl._Name = sControls(i) Else Goto Trace_NotFound
 	End Select
 
-	ocControl._Shortcut = sParentShortcut & "!" & Utils._Surround(ocControl._Name)
-	Set ocControl.ControlModel = DatabaseForm.getByName(ocControl._Name)
-	ocControl._ImplementationName = ocControl.ControlModel.getImplementationName()
-	ocControl._FormComponent = ParentComponent
-	If Utils._hasUNOProperty(ocControl.ControlModel, "ClassId") Then ocControl._ClassId = ocControl.ControlModel.ClassId
-	If ocControl._ClassId > 0 And ocControl._ClassId <> acHiddenControl Then
-		Set ocControl.ControlView = ParentComponent.CurrentController.getControl(ocControl.ControlModel)
-	End If
-
-	ocControl._Initialize()
-	ocControl._DocEntry = _DocEntry
-	ocControl._DbEntry = _DbEntry
+	With ocControl
+		._Shortcut = sParentShortcut & "!" & Utils._Surround(._Name)
+		Set .ControlModel = DatabaseForm.getByName(._Name)
+		._ImplementationName = .ControlModel.getImplementationName()
+		._FormComponent = ParentComponent
+		If Utils._hasUNOProperty(.ControlModel, "ClassId") Then ._ClassId = .ControlModel.ClassId
+		If ._ClassId > 0 And ._ClassId <> acHiddenControl Then
+			Set .ControlView = ParentComponent.CurrentController.getControl(.ControlModel)
+		End If
+
+		._Initialize()
+		._DocEntry = _DocEntry
+		._DbEntry = _DbEntry
+	End With
 	Set Controls = ocControl
 	
 Exit_Function:

wizards/source/access2base/UtilProperty.xba

@@ -25,11 +25,13 @@ REM ============================================================================
 '								PropValuesToStr rewritten and addition of StrToPropValues
 '								Bug corrected on date values
 '								Addition of support of 2-dimensional arrays
+'								Support of empty arrays to allow JSON conversions
 '**********************************************************************
 
 Option Explicit
 
 Private Const cstHEADER = "### PROPERTYVALUES ###"
+Private Const cstEMPTYARRAY = "### EMPTY ARRAY ###"
 
 REM =======================================================================================================================
 Public Function _MakePropertyValue(ByVal Optional psName As String, Optional pvValue As Variant) As com.sun.star.beans.PropertyValue
@@ -38,14 +40,26 @@ Public Function _MakePropertyValue(ByVal Optional psName As String, Optional pvV
 Dim oPropertyValue As New com.sun.star.beans.PropertyValue
 
 	If Not IsMissing(psName) Then oPropertyValue.Name = psName
-	If Not IsMissing(pvValue) Then 
-		'	Date BASIC variables give error. Change them to strings
-		If VarType(pvValue) = vbDate Then oPropertyValue.Value = Utils._CStr(pvValue, False) Else oPropertyValue.Value = pvValue
-	End If
+	If Not IsMissing(pvValue) Then oPropertyValue.Value = _CheckPropertyValue(pvValue)
 	_MakePropertyValue() = oPropertyValue
 	
 End Function	'	_MakePropertyValue V1.3.0
 
+REM =======================================================================================================================
+Public Function _CheckPropertyValue(ByRef pvValue As Variant) As Variant
+'	Date BASIC variables give error. Change them to strings
+'	Empty arrays should be replaced by cstEMPTYARRAY
+
+	If VarType(pvValue) = vbDate Then
+		_CheckPropertyValue = Utils._CStr(pvValue, False)
+	ElseIf IsArray(pvValue) Then
+		If UBound(pvValue, 1) < LBound(pvValue, 1) Then _CheckPropertyValue = cstEMPTYARRAY Else _CheckPropertyValue = pvValue
+	Else
+		_CheckPropertyValue = pvValue
+	End If
+
+End Function	'	_CheckPropertyValue
+	
 REM =======================================================================================================================
 Public Function _NumPropertyValues(ByRef pvPropertyValuesArray As Variant) As Integer
 ' Return the number of PropertyValue's in an array.
@@ -101,7 +115,9 @@ Dim iPropIndex As Integer, vProp As Variant, vValue As Variant, vMatrix As Varia
 	If iPropIndex >= 0 Then
 		vProp = pvPropertyValuesArray(iPropIndex)	' access array subscript
 		vValue = vProp.Value						' get the value from the PropertyValue
-		If IsArray(vValue) Then
+		If VarType(vValue) = vbString Then
+			If vValue = cstEMPTYARRAY Then _GetPropertyValue() = Array() Else _GetPropertyValue() = vValue
+		ElseIf IsArray(vValue) Then
 			If IsArray(vValue(0)) Then				' Array of arrays
 				vMatrix = Array()
 				ReDim vMatrix(0 To UBound(vValue), 0 To UBound(vValue(0)))
@@ -120,7 +136,7 @@ Dim iPropIndex As Integer, vProp As Variant, vValue As Variant, vMatrix As Varia
 	Else
 		If IsMissing(pvDefaultValue) Then pvDefaultValue = Null
 		_GetPropertyValue() = pvDefaultValue
-   EndIf
+	EndIf
 
 End Function	'	_GetPropertyValue V1.3.0
 
@@ -134,7 +150,7 @@ Dim iPropIndex As Integer, vProp As Variant, iNumProperties As Integer
 	If iPropIndex >= 0 Then
 	'	Found, the PropertyValue is already in the array. Just modify its value.
 		vProp = pvPropertyValuesArray(iPropIndex)	' access array subscript
-		vProp.Value = pvValue						' set the property value.
+		vProp.Value = _CheckPropertyValue(pvValue)	' set the property value.
 		pvPropertyValuesArray(iPropIndex) = vProp	' put it back into array
 	Else
 	'	Not found, the array contains no PropertyValue with this name. Append new element to array.