Access2Base - new ApplyFilter and SetOrderBy actions

Those actions are meaningful when applied on Table and Query datasheets.
Forms and subforms (1 level) supported as well.

Change-Id: Ic104559d84ff94f1e7e9bed3db1a13a286953314

wizards/source/access2base/Application.xba

@@ -70,6 +70,7 @@ Global Const ERRQUERYDEFDELETED		=	1549
 Global Const ERRTABLEDEFDELETED		=	1550
 Global Const ERRTABLECREATION		=	1551
 Global Const ERRFIELDCREATION		=	1552
+Global Const ERRSUBFORMNOTFOUND		=	1553
 
 REM -----------------------------------------------------------------------------------------------------------------------
 Global Const DBCONNECTBASE			=	1			'	Connection from Base document (OpenConnection)
@@ -1185,9 +1186,11 @@ Public Function _CurrentDb(ByVal Optional piDocEntry As Integer, ByVal Optional
 REM Without arguments same as CurrentDb() except that it generates an error if database not connected (internal use)
 REM With 2 arguments return the corresponding entry in Root
 
+Dim oCurrentDb As Object
 	If IsEmpty(_A2B_) Then GoTo Trace_Error
-	If IsMissing(piDocEntry)	Then Set _CurrentDb = Application.CurrentDb() _
-								Else Set _CurrentDb = _A2B_._CurrentDb(piDocEntry, piDbEntry)
+	If IsMissing(piDocEntry)	Then Set oCurrentDb = Application.CurrentDb() _
+								Else Set oCurrentDb = _A2B_._CurrentDb(piDocEntry, piDbEntry)
+	If IsNull(oCurrentDb) Then Goto Trace_Error Else Set _CurrentDb = oCurrentDb
 
 Exit_Function:
 	Exit Function	

wizards/source/access2base/Database.xba

@@ -545,7 +545,7 @@ Const cstNull = -1
 	If IsMissing(pvOption) Then
 		pvOption = cstNull
 	Else
-		If Not Utils._CheckArgument(pvOption, 2, Utils._AddNumeric(), dbSQLPassThrough) Then Goto Exit_Function
+		If Not Utils._CheckArgument(pvOption, 2, Utils._AddNumeric(), Array(dbSQLPassThrough, cstNull)) Then Goto Exit_Function
 	End If
 	If _DbConnect <> DBCONNECTBASE And _DbConnect <> DBCONNECTFORM Then Goto Error_NotApplicable
 

wizards/source/access2base/DoCmd.xba

@@ -36,6 +36,66 @@ End Type
 REM VBA allows call to actions with missing arguments e.g. OpenForm("aaa",,"[field]=2")
 REM in StarBasic IsMissing requires Variant parameters
 
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function ApplyFilter( _
+					ByVal Optional pvFilter As Variant _
+					, ByVal Optional pvSQL As Variant _
+					, ByVal Optional pvControlName As Variant _
+					) As Boolean
+'	Set filter on open table, query, form or subform (if pvControlName present)
+
+	If _ErrorHandler() Then On Local Error Goto Error_Function
+Const cstThisSub = "ApplyFilter"
+	Utils._SetCalledSub(cstThisSub)
+	ApplyFilter = False
+	
+	If IsMissing(pvFilter) And IsMissing(pvSQL) Then Call _TraceArguments()
+	If IsMissing(pvFilter) Then pvFilter = ""
+	If Not Utils._CheckArgument(pvFilter, 1, vbString) Then Goto Exit_Function
+	If IsMissing(pvSQL) Then pvSQL = ""
+	If Not Utils._CheckArgument(pvSQL, 1, vbString) Then Goto Exit_Function
+	If IsMissing(pvControlName) Then pvControlName = ""
+	If Not Utils._CheckArgument(pvControlName, 1, vbString) Then Goto Exit_Function
+
+Dim sFilter As String, oWindow As Object, oDatabase As Object, oTarget As Object
+	Set oDatabase = Application._CurrentDb()
+	If oDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable
+
+	If pvSQL <> "" _
+			Then sFilter = oDatabase._ReplaceSquareBrackets(pvSQL) _
+			Else sFilter = oDatabase._ReplaceSquareBrackets(pvFilter)
+
+	Set oWindow = _SelectWindow()
+	With oWindow
+		Select Case .WindowType
+			Case acForm
+				Set oTarget = _DatabaseForm(._Name, pvControlName)
+			Case acQuery, acTable
+				If pvControlName <> "" Then Goto Exit_Function
+				Set oTarget = oWindow.Frame.Controller.FormOperations.Cursor
+			Case Else		'	Ignore action
+				Goto Exit_Function
+		End Select
+	End With
+
+	With oTarget
+		.Filter = sFilter
+		.ApplyFilter = True
+		.reload()
+	End With
+	ApplyFilter = True
+
+Exit_Function:
+	Utils._ResetCalledSub(cstThisSub)
+	Exit Function		
+Error_NotApplicable:
+	TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0, 1, cstThisSub)
+	Goto Exit_Function
+Error_Function:
+	TraceError(TRACEABORT, Err, cstThisSub, Erl)
+	GoTo Exit_Function
+End Function		'	ApplyFilter	V1.2.0
+
 REM -----------------------------------------------------------------------------------------------------------------------
 Public Function mClose(Optional ByVal pvObjectType As Variant _
 					, Optional ByVal pvObjectName As Variant _
@@ -1767,6 +1827,59 @@ Error_Function:
 	GoTo Exit_Function
 End Function		'	SetHiddenAttribute	V1.1.0
 
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function SetOrderBy( _
+					ByVal Optional pvOrder As Variant _
+					, ByVal Optional pvControlName As Variant _
+					) As Boolean
+'	Sort ann open table, query, form or subform (if pvControlName present)
+
+	If _ErrorHandler() Then On Local Error Goto Error_Function
+Const cstThisSub = "SetOrderBy"
+	Utils._SetCalledSub(cstThisSub)
+	SetOrderBy = False
+	
+	If IsMissing(pvOrder) Then pvOrder = ""
+	If Not Utils._CheckArgument(pvOrder, 1, vbString) Then Goto Exit_Function
+	If IsMissing(pvControlName) Then pvControlName = ""
+	If Not Utils._CheckArgument(pvControlName, 1, vbString) Then Goto Exit_Function
+
+Dim sOrder As String, oWindow As Object, oDatabase As Object, oTarget As Object
+	Set oDatabase = Application._CurrentDb()
+	If oDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable
+
+	sOrder = oDatabase._ReplaceSquareBrackets(pvOrder)
+
+	Set oWindow = _SelectWindow()
+	With oWindow
+		Select Case .WindowType
+			Case acForm
+				Set oTarget = _DatabaseForm(._Name, pvControlName)
+			Case acQuery, acTable
+				If pvControlName <> "" Then Goto Exit_Function
+				Set oTarget = oWindow.Frame.Controller.FormOperations.Cursor
+			Case Else		'	Ignore action
+				Goto Exit_Function
+		End Select
+	End With
+
+	With oTarget
+		.Order = sOrder
+		.reload()
+	End With
+	SetOrderBy = True
+
+Exit_Function:
+	Utils._ResetCalledSub(cstThisSub)
+	Exit Function		
+Error_NotApplicable:
+	TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0, 1, cstThisSub)
+	Goto Exit_Function
+Error_Function:
+	TraceError(TRACEABORT, Err, cstThisSub, Erl)
+	GoTo Exit_Function
+End Function		'	SetOrderBy	V1.2.0
+
 REM -----------------------------------------------------------------------------------------------------------------------
 Public Function ShowAllrecords() As Boolean
 '	Removes any existing filter that exists on the current table, query or form
@@ -1824,6 +1937,50 @@ Dim bFound As Boolean
 	
 End Function		'	_CheckColumnType	V0.9.1
 
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _DatabaseForm(psForm As String, psControl As String)
+'Return DatabaseForm element of Form object (based on psForm which is known as a real form name)
+'or of SubForm object (based on psControl which is checked for being a subform)
+
+Dim oForm As Object, oControl As Object, sControls() As String, iControlCount As Integer
+Dim bFound As Boolean, i As Integer, sName As String
+
+	Set oForm = Application.Forms(psForm)
+	If psControl <> "" Then				'	Search subform
+		With oForm.DatabaseForm
+			iControlCount = .getCount()
+			bFound = False
+			If iControlCount > 0 Then
+				sControls() = .getElementNames()
+				sName = UCase(Utils._Trim(psControl))
+				For i = 0 To iControlCount - 1
+					If UCase(sControls(i)) = sName Then
+						bFound = True
+						Exit For
+					End If
+				Next i
+			End If
+		End With
+		If bFound Then sName = sControls(i) Else Goto Trace_NotFound
+		Set oControl = oForm.Controls(sName)
+		If oControl._SubType <> CTLSUBFORM Then Goto Trace_SubFormNotFound
+		Set _DatabaseForm = oControl.Form.DatabaseForm
+	Else
+		Set _DatabaseForm = oForm.DatabaseForm
+	End If
+
+Exit_Function:
+	Exit Function		
+Trace_NotFound:
+	TraceError(TRACEFATAL, ERRCONTROLNOTFOUND, Utils._CalledSub(), 0, , Array(psControl, psForm))
+	Goto Exit_Function
+Trace_SubFormNotFound:
+	TraceError(TRACEFATAL, ERRSUBFORMNOTFOUND, Utils._CalledSub(), 0, , Array(psControl, psForm))
+	Goto Exit_Function
+End Function		'	_DatabaseForm	V1.2.0
+
+
+
 REM -----------------------------------------------------------------------------------------------------------------------
 Private Function _getTempDirectoryURL()	As String
 '	Return the tempry directory defined in the OO Options (Paths)

wizards/source/access2base/L10N.xba

@@ -76,6 +76,7 @@ Dim sLocal As String
 				Case "ERR" & ERRTABLEDEFDELETED		:	sLocal = "Pre-existing table '%0' has been deleted"
 				Case "ERR" & ERRTABLECREATION		:	sLocal = "Table '%0' could not be created"
 				Case "ERR" & ERRFIELDCREATION		:	sLocal = "Field '%0' could not be created"
+				Case "ERR" & ERRSUBFORMNOTFOUND		:	sLocal = "Subform '%0' not found in parent form '%1'"
 				'----------------------------------------------------------------------------------------------------------------------
 				Case "OBJECT"						:	sLocal = "Object"
 				Case "TABLE"						:	sLocal = "Table"
@@ -144,7 +145,7 @@ Dim sLocal As String
 				Case "ERR" & ERRINDEXVALUE			:	sLocal = "Indice invalide ou dimension erronée du tableau pour la propriété '%0'"
 				Case "ERR" & ERRCOLLECTION			:	sLocal = "Indice de tableau invalide"
 				Case "ERR" & ERRPROPERTYNOTARRAY	:	sLocal = "L'argument n°%0 doit être un tableau"
-				Case "ERR" & ERRCONTROLNOTFOUND		:	sLocal = "Contrôle '%0' non trouvé dans le parent (formulaire ou contrôle de table) '%1'"
+				Case "ERR" & ERRCONTROLNOTFOUND		:	sLocal = "Contrôle '%0' non trouvé dans le parent (formulaire, contrôle de table ou dialogue) '%1'"
 				Case "ERR" & ERRNOACTIVEFORM		:	sLocal = "Pas de formulaire ou de contrôle actif"
 				Case "ERR" & ERRDATABASEFORM		:	sLocal = "Le formulaire '%0' n'a pas de données sous-jacentes"
 				Case "ERR" & ERRFOCUSINGRID			:	sLocal = "Contrôle '%0' non trouvé dans le contrôle de table '%1'"
@@ -181,6 +182,7 @@ Dim sLocal As String
 				Case "ERR" & ERRTABLEDEFDELETED		:	sLocal = "La table existante '%0' a été supprimée"
 				Case "ERR" & ERRTABLECREATION		:	sLocal = "La table '%0' n'a pas pu être créée"
 				Case "ERR" & ERRFIELDCREATION		:	sLocal = "Le champ '%0' n'a pas pu être créé"
+				Case "ERR" & ERRSUBFORMNOTFOUND		:	sLocal = "Sous-formulaire '%0' non trouvé dans le formulaire parent '%1'"
 				'----------------------------------------------------------------------------------------------------------------------
 				Case "OBJECT"						:	sLocal = "Objet"
 				Case "TABLE"						:	sLocal = "Table"

wizards/source/access2base/Root_.xba

@@ -183,14 +183,6 @@ Const cstBase = "com.sun.star.comp.dba.ODatabaseDocument"
 		With CurrentDoc(0)
 			If Not .Active Then GoTo Trace_Error
 			If IsNull(.Document) Then GoTo Trace_Error
-			If Not  Utils._hasUNOProperty(ThisComponent, "URL") Then Goto Trace_Error
-			If Utils._ImplementationName(ThisComponent) <> cstBase Or .Document.URL <> ThisComponent.URL Then	'	Give the parent a try
-				If Not  Utils._hasUNOProperty(ThisComponent, "Parent") Then Goto Trace_Error
-				If IsNull(ThisComponent.Parent) Then Goto Trace_Error
-				If Utils._ImplementationName(ThisComponent.Parent) <> cstBase Then Goto Trace_Error
-				If Not  Utils._hasUNOProperty(ThisComponent.Parent, "URL") Then Goto Trace_Error
-				If .Document.URL <> ThisComponent.Parent.URL Then Goto Trace_Error
-			End If
 		End With
 		CurrentDocIndex = 0
 	End If

wizards/source/access2base/acConstants.xba

@@ -8,7 +8,7 @@ REM ============================================================================
 Option Explicit
 
 REM Access2Base -----------------------------------------------------
-Global Const Access2Base_Version = "1.1.0h"
+Global Const Access2Base_Version = "1.2.0"
 
 REM AcCloseSave
 REM -----------------------------------------------------------------