ScriptForge - (SF_Calc) sort ranges on more than 3 keys

The Calc.SortRange() method sorts
the given range on any number of columns/rows.
The sorting order may vary by column/row.

The sorting algorithm allows for maximum 3 keys.

When the number of sort keys is > 3 then the range
is sorted several times, by groups of 3 keys,
starting from the last key.

In this context the algorithm used by Calc
to sort ranges is presumed STABLE,
i.e. it maintains the relative order of records
with equal keys.

Change-Id: If7f4920f7ab8f8ffb71edf648ed9accc8eb62dce
Reviewed-on: https://gerrit.libreoffice.org/c/core/+/145681
Tested-by: Jean-Pierre Ledure <jp@ledure.be>
Reviewed-by: Jean-Pierre Ledure <jp@ledure.be>
Tested-by: Jenkins

1 files changed, 62 insertions, 35 deletions

diff --git a/wizards/source/sfdocuments/SF_Calc.xba b/wizards/source/sfdocuments/SF_Calc.xba
index 391321f361d8..f2c9fc34e2f2 100644
--- a/wizards/source/sfdocuments/SF_Calc.xba
+++ b/wizards/source/sfdocuments/SF_Calc.xba
@@ -1084,7 +1084,7 @@ Const cstSubArgs = "SourceRange, DestinationRange"
 	If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 	sCopy = ""
 
-Check:
+Check:string
 	If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
 		If Not _IsStillAlive(True) Then GoTo Finally
 		If Not ScriptForge.SF_Utils._Validate(SourceRange, "SourceRange", Array(V_STRING, ScriptForge.V_OBJECT), , , CALCREFERENCE) Then GoTo Finally
@@ -3305,7 +3305,11 @@ Public Function SortRange(Optional ByVal Range As Variant _
 								, Optional ByVal CaseSensitive As Variant _
 								, Optional ByVal SortColumns As Variant _
 								) As Variant
-'''	Sort the given range on maximum 3 columns/rows. The sorting order may vary by column/row
+'''	Sort the given range on any number of columns/rows. The sorting order may vary by column/row
+'''	If the number of sort keys is > 3 then the range is sorted several times, by groups of 3 keys,
+'''	starting from the last key. In this context the algorithm used by Calc to sort ranges
+'''	is presumed STABLE, i.e. it maintains the relative order of records with equal keys.
+'''	
 '''	Args:
 '''		Range: the range to sort as a string
 '''		SortKeys: a scalar (if 1 column/row) or an array of column/row numbers starting from 1
@@ -3329,13 +3333,19 @@ Public Function SortRange(Optional ByVal Range As Variant _
 Dim sSort As String					'	Return value
 Dim oRangeAddress As _Address		'	Parsed range
 Dim oRange As Object				'	com.sun.star.table.XCellRange
+Dim oSortRange As Object			'	The area to sort as an _Address object
 Dim oDestRange As Object			'	Destination as a range
 Dim oDestAddress As Object			'	com.sun.star.table.CellRangeAddress
 Dim oDestCell As Object				'	com.sun.star.table.CellAddress
 Dim vSortDescriptor As Variant		'	Array of com.sun.star.beans.PropertyValue
 Dim vSortFields As Variant			'	Array of com.sun.star.table.TableSortField
 Dim sOrder As String				'	Item in SortOrder
-Dim i As Long
+Dim lSort As Long					'	Counter for sub-sorts
+Dim lKeys As Long					'	UBound of SortKeys
+Dim lKey As Long					'	Actual index in SortKeys
+Dim i As Long, j As Long
+Const cstMaxKeys = 3				'	Maximum number of keys allowed in a single sorting step
+
 Const cstThisSub = "SFDocuments.Calc.SortRange"
 Const cstSubArgs = "Range, SortKeys, [TargetRange=""""], [SortOrder=""ASC""], [DestinationCell=""""], [ContainsHeader=False], [CaseSensitive=False], [SortColumns=False]"
 
@@ -3368,47 +3378,64 @@ Check:
 		If Not ScriptForge.SF_Utils._Validate(SortColumns, "SortColumns", ScriptForge.V_BOOLEAN) Then GoTo Finally
 	End If
 	Set oRangeAddress = _ParseAddress(Range)
-	If Len(DestinationCell) > 0 Then Set oDestRange = _ParseAddress(DestinationCell)
+	If Len(DestinationCell) > 0 Then Set oDestRange = _ParseAddress(DestinationCell) Else Set oDestRange = Nothing
 
 Try:
-	'	Initialize the sort descriptor
+	'	Initialize a generic sort descriptor
 	Set oRange = oRangeAddress.XCellRange
-	vSortDescriptor = oRange.createSortDescriptor
+	vSortDescriptor = oRange.createSortDescriptor	'	Makes a generic sort descriptor for ranges
 	vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "IsSortColumns", SortColumns)
 	vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "ContainsHeader", ContainsHeader)
 	vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "BindFormatsToContent", True)
-	If Len(DestinationCell) = 0 Then
-		vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "CopyOutputData", False)
-	Else
-		Set oDestAddress = oDestRange.XCellRange.RangeAddress
-		Set oDestCell = New com.sun.star.table.CellAddress
-		With oDestAddress
-			oDestCell.Sheet = .Sheet
-			oDestCell.Column = .StartColumn
-			oDestCell.Row = .StartRow
-		End With
-		vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "CopyOutputData", True)
-		vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "OutputPosition", oDestCell)
-	End If
 	vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "IsUserListEnabled", False)
 
-	'	Define the sorting keys
-	vSortFields = Array()
-	ReDim vSortFields(0 To UBound(SortKeys))
-	For i = 0 To UBound(SortKeys)
-		vSortFields(i) = New com.sun.star.table.TableSortField
-		If i > UBound(SortOrder) Then sOrder = "" Else sOrder = SortOrder(i)
-		If Len(sOrder) = 0 Then sOrder = "ASC"
-		With vSortFields(i)
-			.Field = SortKeys(i) - 1
-			.IsAscending = ( UCase(sOrder) = "ASC" )
-			.IsCaseSensitive = CaseSensitive
-		End With
-	Next i
+	'	Sort by keys group
+	'	If keys = (1, 2, 3, 4, 5) then groups = (4, 5), (1, 2, 3)
+	lKeys = UBound(SortKeys)
+	lSort = Int(lKeys / cstMaxKeys)
+	Set oSortRange = oRangeAddress
+
+	For j = lSort To 0 Step -1		'	Sort first on last sort keys
+
+		'	The 1st sort must consider the destination area. Next sorts are done on the destination area
+		If Len(DestinationCell) = 0 Or j < lSort Then
+			vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "CopyOutputData", False)
+			vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "OutputPosition", Nothing)
+		Else
+			Set oDestAddress = oDestRange.XCellRange.RangeAddress
+			Set oDestCell = New com.sun.star.table.CellAddress
+			With oDestAddress
+				oDestCell.Sheet = .Sheet
+				oDestCell.Column = .StartColumn
+				oDestCell.Row = .StartRow
+			End With
+			vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "CopyOutputData", True)
+			vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "OutputPosition", oDestCell)
+		End If
+
+		'	Define the sorting keys
+		vSortFields = DimArray(lKeys Mod cstMaxKeys)
+		For i = 0 To UBound(vSortFields)
+			vSortFields(i) = New com.sun.star.table.TableSortField
+			lKey = j * cstMaxKeys + i
+			If lKey > UBound(SortOrder) Then sOrder = "" Else sOrder = SortOrder(lKey)
+			If Len(sOrder) = 0 Then sOrder = "ASC"
+			With vSortFields(i)
+				.Field = SortKeys(lKey) - 1
+				.IsAscending = ( UCase(sOrder) = "ASC" )
+				.IsCaseSensitive = CaseSensitive
+			End With
+		Next i
+		lKeys = lKeys - UBound(vSortFields) - 1
+
+		'	Associate the keys and the descriptor, and sort
+		vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "SortFields", vSortFields)
+		oSortRange.XCellRange.sort(vSortDescriptor)
+
+		'	Next loop, if any, is done on the destination area
+		If Len(DestinationCell) > 0 And j = lSort And lSort > 0 Then Set oSortRange = _Offset(oDestRange, 0, 0, oRangeAddress.Height, oRangeAddress.Width)
 
-	'	Associate the keys and the descriptor, and sort
-	vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "SortFields", vSortFields)
-	oRange.sort(vSortDescriptor)
+	Next j
 
 	'	Compute the changed area
 	If Len(DestinationCell) = 0 Then