diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas
index 4676e2170..93d3bb8bd 100755
--- a/components/fpspreadsheet/fpspreadsheet.pas
+++ b/components/fpspreadsheet/fpspreadsheet.pas
@@ -445,6 +445,9 @@ type
{@@ Sort order }
TsSortOrder = (ssoAscending, ssoDescending);
+ {@@ Sort priority }
+ TsSortPriority = (spNumAlpha, spAlphaNum); // NumAlph = "number < alpha"
+
{@@ Sort key: sorted column or row index and sort direction }
TsSortKey = record
ColRowIndex: Integer;
@@ -456,9 +459,11 @@ type
{@@ Complete set of sorting parameters
@param SortByCols If true sorting is top-down, otherwise left-right
+ @param Priority Determines whether numbers are before or after text.
@param SortKeys Array of sorting indexes and sorting directions }
TsSortParams = record
SortByCols: Boolean;
+ Priority: TsSortPriority;
Keys: TsSortKeys;
end;
@@ -508,6 +513,7 @@ type
FLastColIndex: Cardinal;
FDefaultColWidth: Single; // in "characters". Excel uses the width of char "0" in 1st font
FDefaultRowHeight: Single; // in "character heights", i.e. line count
+ FSortParams: TsSortParams; // Parameters of the current sorting operation
FOnChangeCell: TsCellEvent;
FOnChangeFont: TsCellEvent;
FOnCompareCells: TsCellCompareEvent;
@@ -3205,14 +3211,16 @@ end;
to their number value
Label cells are sorted like UTF8 strings.
- In case of different cell content types used in the comparison:
- Empty cells are "smallest", Label cells are next, Numeric cells
- are "largest"
+ In case of mixed cell content types the order is determined by
+ the parameter Priority of the SortParams.
+ Empty cells are always at the end (in both ascending and descending
+ order)
-------------------------------------------------------------------------------}
function TsWorksheet.DoCompareCells(ACell1, ACell2: PCell;
ASortOrder: TsSortOrder): Integer;
// Sort priority in Excel:
-// blank < alpha < number, dates are sorted according to their number value
+// numbers < alpha < blank (ascending)
+// alpha < numbers < blank (descending)
var
number1, number2: Double;
begin
@@ -3224,25 +3232,32 @@ begin
if (ACell1 = nil) and (ACell2 = nil) then
Result := 0
else
- if (ACell1 = nil) then
- Result := -1
- else
- if (ACell2 = nil) then
- Result := +1
- else
+ if (ACell1 = nil) or (ACell2 = nil) then
+ begin
+ Result := +1; // Empty cells go to the end
+ exit; // Avoid SortOrder to bring the empty cell to the top!
+ end else
if (ACell1^.ContentType = cctEmpty) and (ACell2^.ContentType = cctEmpty) then
Result := 0
- else if (ACell1^.ContentType = cctEmpty) then
- Result := -1
- else if (ACell2^.ContentType = cctEmpty) then
- Result := +1
- else if (ACell1^.ContentType = cctUTF8String) and (ACell2^.ContentType = cctUTF8String) then
+ else if (ACell1^.ContentType = cctEmpty) or (ACell2^.ContentType = cctEmpty) then
+ begin
+ Result := +1; // Empty cells go to the end
+ exit; // Avoid SortOrder to bring the empty cell back to the top
+ end else
+ if (ACell1^.ContentType = cctUTF8String) and (ACell2^.ContentType = cctUTF8String) then
Result := CompareText(ACell1^.UTF8StringValue, ACell2^.UTF8StringValue)
- else if (ACell1^.ContentType = cctUTF8String) and (ACell2^.ContentType <> cctUTF8String) then
- Result := -1
+ else
+ if (ACell1^.ContentType = cctUTF8String) and (ACell2^.ContentType <> cctUTF8String) then
+ case FSortParams.Priority of
+ spNumAlpha: Result := +1; // numbers before text
+ spAlphaNum: Result := -1; // text before numbers
+ end
else
if (ACell1^.ContentType <> cctUTF8String) and (ACell2^.ContentType = cctUTF8String) then
- Result := +1
+ case FSortParams.Priority of
+ spNumAlpha: Result := -1;
+ spAlphaNum: Result := +1;
+ end
else
begin
ReadNumericValue(ACell1, number1);
@@ -3422,6 +3437,7 @@ procedure TsWorksheet.Sort(const ASortParams: TsSortParams;
end;
begin
+ FSortParams := ASortParams;
if ASortParams.SortByCols then
QuickSort(ARowFrom, ARowTo)
else
diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas
index 75f44c4f9..10316162b 100644
--- a/components/fpspreadsheet/fpsutils.pas
+++ b/components/fpspreadsheet/fpsutils.pas
@@ -151,6 +151,9 @@ function HighContrastColor(AColorValue: TsColorValue): TsColor;
function AnalyzeCompareStr(AString: String; out ACompareOp: TsCompareOperation): String;
+function InitSortParams(ASortByCols: Boolean = true; ANumSortKeys: Integer = 1;
+ ASortPriority: TsSortPriority = spNumAlpha): TsSortParams;
+
procedure AppendToStream(AStream: TStream; const AString: String); inline; overload;
procedure AppendToStream(AStream: TStream; const AString1, AString2: String); inline; overload;
procedure AppendToStream(AStream: TStream; const AString1, AString2, AString3: String); inline; overload;
@@ -2360,6 +2363,37 @@ begin
RemoveChars(0, coEqual);
end;
+{@@ ----------------------------------------------------------------------------
+ Initializes a Sortparams record. This record sets paramaters used when cells
+ are sorted.
+
+ @param ASortByCols If true sorting occurs along columns, i.e. the
+ ColRowIndex of the sorting keys refer to column indexes.
+ If False, sorting occurs along rows, and the
+ ColRowIndexes refer to row indexes
+ Default: true
+ @param ANumSortKeys Determines how many columns or rows are used as sorting
+ keys. (Default: 1)
+ @param ASortPriority Determines the order or text and numeric data in
+ mixed content type cell ranges.
+ Default: spNumAlpha, i.e. numbers before text (in
+ ascending sort)
+ @return The initializaed TsSortParams record
+-------------------------------------------------------------------------------}
+function InitSortParams(ASortByCols: Boolean = true; ANumSortKeys: Integer = 1;
+ ASortPriority: TsSortPriority = spNumAlpha): TsSortParams;
+var
+ i: Integer;
+begin
+ Result.SortByCols := ASortByCols;
+ Result.Priority := spNumAlpha; // numbers before text, like in Excel
+ SetLength(Result.Keys, ANumSortKeys);
+ for i:=0 to High(Result.Keys) do begin
+ Result.Keys[i].ColRowIndex := 0;
+ Result.Keys[i].Order := ssoAscending;
+ end;
+end;
+
procedure AppendToStream(AStream: TStream; const AString: string);
begin
if Length(AString) > 0 then
diff --git a/components/fpspreadsheet/tests/sortingtests.pas b/components/fpspreadsheet/tests/sortingtests.pas
index 80363a611..e634649b9 100644
--- a/components/fpspreadsheet/tests/sortingtests.pas
+++ b/components/fpspreadsheet/tests/sortingtests.pas
@@ -24,35 +24,47 @@ type
{ TSpreadSortingTests }
TSpreadSortingTests = class(TTestCase)
private
+
protected
// Set up expected values:
procedure SetUp; override;
procedure TearDown; override;
- procedure Test_Sorting(
+
+ procedure Test_Sorting_1( // one column or row
ASortByCols: Boolean;
AMode: Integer // AMode = 0: number, 1: strings, 2: mixed
);
+ procedure Test_Sorting_2( // two columns/rows, primary keys equal
+ ASortByCols: Boolean
+ );
published
- procedure Test_SortingByCols_Numbers;
- procedure Test_SortingByCols_Strings;
- procedure Test_SortingByCols_Mixed;
- {
- procedure Test_SortingByRows_Numbers;
- procedure Test_SortingByRows_Strings;
- procedure Test_SortingByRows_Mixed;
- }
+ procedure Test_SortingByCols1_Numbers;
+ procedure Test_SortingByCols1_Strings;
+ procedure Test_SortingByCols1_NumbersStrings;
+
+ procedure Test_SortingByRows1_Numbers;
+ procedure Test_SortingByRows1_Strings;
+ procedure Test_SortingByRows1_NumbersStrings;
+
+ procedure Test_SortingByCols2;
+ procedure Test_SortingByRows2;
+
end;
implementation
+uses
+ fpsutils;
+
const
SortingTestSheet = 'Sorting';
procedure InitUnsortedData;
-// When sorted the value is equal to the index
+// The logics of the detection requires equal count of numbers and strings.
begin
- SollSortNumbers[0] := 9; // Equal count of numbers and strings needed
+ // When sorted the value is equal to the index
+ SollSortNumbers[0] := 9;
SollSortNumbers[1] := 8;
SollSortNumbers[2] := 5;
SollSortNumbers[3] := 2;
@@ -63,6 +75,7 @@ begin
SollSortNumbers[8] := 4;
SollSortNumbers[9] := 0;
+ // When sorted the value is equal to 'A' + index
SollSortStrings[0] := 'C';
SollSortStrings[1] := 'G';
SollSortStrings[2] := 'F';
@@ -89,14 +102,14 @@ begin
inherited TearDown;
end;
-procedure TSpreadSortingTests.Test_Sorting(ASortByCols: Boolean;
+procedure TSpreadSortingTests.Test_Sorting_1(ASortByCols: Boolean;
AMode: Integer);
const
AFormat = sfExcel8;
var
MyWorksheet: TsWorksheet;
MyWorkbook: TsWorkbook;
- i, row, col: Integer;
+ i, ilast, n, row, col: Integer;
MyCell: PCell;
TempFile: string; //write xls/xml to this file and read back from it
L: TStringList;
@@ -110,6 +123,8 @@ var
expectedString: String;
begin
+ sortParams := InitSortParams(ASortByCols, 1);
+
TempFile := GetTempFileName;
MyWorkbook := TsWorkbook.Create;
@@ -118,14 +133,7 @@ begin
col := 0;
row := 0;
- SetLength(sortParams.Keys, 1);
- sortparams.Keys[0].ColRowIndex := 0;
if ASortByCols then begin
- sortParams.SortByCols := true;
- r1 := 0;
- r2 := High(SollSortNumbers);
- c1 := 0;
- c2 := 0;
case AMode of
0: for i :=0 to High(SollSortNumbers) do
MyWorksheet.WriteNumber(i, col, SollSortNumbers[i]);
@@ -140,11 +148,6 @@ begin
end
end
else begin
- sortParams.SortByCols := false;
- r1 := 0;
- r2 := 0;
- c1 := 0;
- c2 := High(SollSortNumbers);
case AMode of
0: for i := 0 to High(SollSortNumbers) do
MyWorksheet.WriteNumber(row, i, SollSortNumbers[i]);
@@ -168,6 +171,7 @@ begin
begin
MyWorkbook := TsWorkbook.Create;
try
+ // Read spreadsheet file...
MyWorkbook.ReadFromFile(TempFile, AFormat);
if AFormat = sfExcel2 then
MyWorksheet := MyWorkbook.GetFirstWorksheet
@@ -176,82 +180,68 @@ begin
if MyWorksheet = nil then
fail('Error in test code. Failed to get named worksheet');
+ // ... and sort it.
+ case AMode of
+ 0: iLast:= High(SollSortNumbers);
+ 1: iLast := High(SollSortStrings);
+ 2: iLast := Length(SollSortNumbers) + Length(SollSortStrings) - 1;
+ end;
+ r1 := 0;
+ r2 := 0;
+ c1 := 0;
+ c2 := 0;
+ if ASortByCols then
+ r2 := iLast
+ else
+ c2 := iLast;
sortParams.Keys[0].Order := sortDir;
MyWorksheet.Sort(sortParams, r1,c1, r2, c2);
- if ASortByCols then
+ // for debugging, to see the sorted data
+ // MyWorkbook.WriteToFile('sorted.xls', AFormat, true);
+
+ row := 0;
+ col := 0;
+ for i:=0 to iLast do
+ begin
+ if ASortByCols then
+ case sortDir of
+ ssoAscending : row := i;
+ ssoDescending: row := iLast - i;
+ end
+ else
+ case sortDir of
+ ssoAscending : col := i;
+ ssoDescending: col := iLast - i;
+ end;
case AMode of
- 0: for i:=0 to MyWorksheet.GetLastColIndex do
- begin
- actualNumber := MyWorksheet.ReadAsNumber(i, col);
- if sortDir = ssoAscending then expectedNumber := i
- else expectedNumber := High(SollSortNumbers)-i;
- CheckEquals(actualnumber, expectedNumber,
- 'Sorted number cells mismatch, cell '+CellNotation(MyWorksheet, i, col));
+ 0: begin
+ actualNumber := MyWorksheet.ReadAsNumber(row, col);
+ expectedNumber := i;
+ CheckEquals(expectednumber, actualnumber,
+ 'Sorted cell number mismatch, cell '+CellNotation(MyWorksheet, row, col));
end;
- 1: for i:=0 to Myworksheet.GetLastColIndex do
- begin
- actualString := MyWorksheet.ReadAsUTF8Text(i, col);
- if sortDir = ssoAscending then expectedString := char(ord('A') + i)
- else expectedString := char(ord('A') + High(SollSortStrings)-i);
- CheckEquals(actualString, expectedString,
- 'Sorted string cells mismatch, cell '+CellNotation(MyWorksheet, i, col));
+ 1: begin
+ actualString := MyWorksheet.ReadAsUTF8Text(row, col);
+ expectedString := char(ord('A') + i);
+ CheckEquals(expectedstring, actualstring,
+ 'Sorted cell string mismatch, cell '+CellNotation(MyWorksheet, row, col));
end;
- 2: begin (* to be done...
- for i:=0 to High(SollNumbers) do
- begin
- actualNumber := MyWorkbook.ReadAsNumber(i*2, col);
- if sortdir =ssoAscending then
- expectedNumber := i
- CheckEquals(actualnumber, expectedNumber,
- 'Sorted number cells mismatch, cell '+CellNotation(MyWorksheet, i*2, col));
+ 2: begin // with increasing i, we see first the numbers, then the strings
+ if i <= High(SollSortNumbers) then begin
+ actualnumber := MyWorksheet.ReadAsNumber(row, col);
+ expectedNumber := i;
+ CheckEquals(expectednumber, actualnumber,
+ 'Sorted cell number mismatch, cell '+CellNotation(MyWorksheet, row, col));
+ end else begin
+ actualstring := MyWorksheet.ReadAsUTF8Text(row, col);
+ expectedstring := char(ord('A') + i - Length(SollSortNumbers));
+ CheckEquals(expectedstring, actualstring,
+ 'Sorted cell string mismatch, cell '+CellNotation(MyWorksheet, row, col));
end;
- for i:=0 to High(SollStrings) do
- begin
- actualString := MyWorkbook.ReadAsUTF8String(i*2+1, col);
- expectedString := SollStrings[i];
- CheckEquals(actualString, expectedString,
- 'Sorted string cells mismatch, cell '+CellNotation(MyWorksheet, i*2+1, col));
- end;
- *)
end;
- end // case
- else
- case AMode of
- 0: for i:=0 to MyWorksheet.GetLastColIndex do
- begin
- actualNumber := MyWorksheet.ReadAsNumber(row, i);
- if sortDir = ssoAscending then expectedNumber := i
- else expectedNumber := High(SollSortNumbers)-i;
- CheckEquals(actualnumber, expectedNumber,
- 'Sorted number cells mismatch, cell '+CellNotation(MyWorksheet, row, i));
- end;
- 1: for i:=0 to MyWorksheet.GetLastColIndex do
- begin
- actualString := MyWorksheet.ReadAsUTF8Text(row, i);
- if sortDir = ssoAscending then expectedString := char(ord('A')+i)
- else expectedString := char(ord('A') + High(SollSortStrings)-i);
- CheckEquals(actualString, expectedString,
- 'Sorted string cells mismatch, cell '+CellNotation(MyWorksheet, row, i));
- end;
- 2: begin{
- for i:=0 to High(SollNumbers) do
- begin
- actualNumber := MyWorkbook.ReadAsNumber(row, i*2);
- expectedNumber := SollNumbers[i];
- CheckEquals(actualnumber, expectedNumber,
- 'Sorted number cells mismatch, cell '+CellNotation(MyWorksheet, row, i*2));
- end;
- for i:=0 to High(SollStrings) do
- begin
- actualString := MyWorkbook.ReadAsUTF8String(row, i*2+1);
- expectedString := SollStrings[i];
- CheckEquals(actualString, expectedString,
- 'Sorted string cells mismatch, cell '+CellNotation(MyWorksheet, row, i*2+1));
- end;
- }
- end;
- end; // case
+ end;
+ end;
finally
MyWorkbook.Free;
@@ -261,20 +251,166 @@ begin
DeleteFile(TempFile);
end;
+procedure TSpreadSortingTests.Test_Sorting_2(ASortByCols: Boolean);
+const
+ AFormat = sfExcel8;
+var
+ MyWorksheet: TsWorksheet;
+ MyWorkbook: TsWorkbook;
+ i, ilast, n, row, col: Integer;
+ MyCell: PCell;
+ TempFile: string; //write xls/xml to this file and read back from it
+ L: TStringList;
+ s: String;
+ sortParams: TsSortParams;
+ sortDir: TsSortOrder;
+ r1,r2,c1,c2: Cardinal;
+ actualNumber: Double;
+ actualString: String;
+ expectedNumber: Double;
+ expectedString: String;
-procedure TSpreadSortingTests.Test_SortingByCols_Numbers;
begin
- Test_Sorting(true, 0);
+ sortParams := InitSortParams(ASortByCols, 2);
+ sortParams.Keys[0].ColRowIndex := 0;
+ sortParams.Keys[1].ColRowIndex := 1;
+
+ TempFile := GetTempFileName;
+
+ MyWorkbook := TsWorkbook.Create;
+ try
+ MyWorkSheet:= MyWorkBook.AddWorksheet(SortingTestSheet);
+
+ col := 0;
+ row := 0;
+ if ASortByCols then
+ begin
+ // Always 2 numbers in the first column are equal
+ for i:=0 to High(SollSortNumbers) do
+ MyWorksheet.WriteNumber(i, col, SollSortNumbers[(i mod 2)*2]);
+ // All strings in the second column are distinct
+ for i:=0 to High(SollSortStrings) do
+ MyWorksheet.WriteUTF8Text(i, col+1, SollSortStrings[i]);
+ end else
+ begin
+ for i:=0 to High(SollSortNumbers) do
+ MyWorksheet.WriteNumber(row, i, SollSortNumbers[(i mod 2)*2]);
+ for i:=0 to High(SollSortStrings) do
+ MyWorksheet.WriteUTF8Text(row+1, i, SollSortStrings[i]);
+ end;
+
+ MyWorkBook.WriteToFile(TempFile, AFormat, true);
+ finally
+ MyWorkbook.Free;
+ end;
+
+ // Test ascending and descending sort orders
+ for sortDir in TsSortOrder do
+ begin
+ MyWorkbook := TsWorkbook.Create;
+ try
+ // Read spreadsheet file...
+ MyWorkbook.ReadFromFile(TempFile, AFormat);
+ if AFormat = sfExcel2 then
+ MyWorksheet := MyWorkbook.GetFirstWorksheet
+ else
+ MyWorksheet := GetWorksheetByName(MyWorkBook, SortingTestSheet);
+ if MyWorksheet = nil then
+ fail('Error in test code. Failed to get named worksheet');
+
+ // ... and sort it.
+ iLast := High(SollSortNumbers); //must be the same as for SollSortStrings
+ r1 := 0; c1 := 0;
+ if ASortByCols then begin
+ c2 := 1;
+ r2 := iLast;
+ end else
+ begin
+ c2 := iLast;
+ r2 := 1;
+ end;
+ sortParams.Keys[0].Order := sortDir;
+ sortParams.Keys[1].Order := sortDir;
+ MyWorksheet.Sort(sortParams, r1,c1, r2, c2);
+
+ // for debugging, to see the sorted data
+ MyWorkbook.WriteToFile('sorted.xls', AFormat, true);
+
+ for i:=0 to iLast do
+ begin
+ row := 0;
+ col := 0;
+ if ASortByCols then
+ case sortDir of
+ ssoAscending : row := i;
+ ssoDescending: row := iLast - i;
+ end
+ else
+ case sortDir of
+ ssoAscending : col := i;
+ ssoDescending: col := iLast - i;
+ end;
+ actualNumber := MyWorksheet.ReadAsNumber(row, col);
+ expectedNumber := (i mod 2) * 2;
+ CheckEquals(expectednumber, actualnumber,
+ 'Sorted cell number mismatch, cell '+CellNotation(MyWorksheet, row, col));
+
+ if ASortByCols then
+ inc(col)
+ else
+ inc(row);
+ actualString := MyWorksheet.ReadAsUTF8Text(row, col);
+ expectedString := char(ord('A') + i);
+ CheckEquals(expectedstring, actualstring,
+ 'Sorted cell string mismatch, cell '+CellNotation(MyWorksheet, row, col));
+ end;
+ finally
+ MyWorkbook.Free;
+ end;
+ end; // for sortDir
+
+ DeleteFile(TempFile);
end;
-procedure TSpreadSortingTests.Test_SortingByCols_Strings;
+
+procedure TSpreadSortingTests.Test_SortingByCols1_Numbers;
begin
- Test_Sorting(true, 1);
+ Test_Sorting_1(true, 0);
end;
-procedure TSpreadSortingTests.Test_SortingByCols_Mixed;
+procedure TSpreadSortingTests.Test_SortingByCols1_Strings;
begin
- //Test_Sorting(true, 2);
+ Test_Sorting_1(true, 1);
+end;
+
+procedure TSpreadSortingTests.Test_SortingByCols1_NumbersStrings;
+begin
+ Test_Sorting_1(true, 2);
+end;
+
+procedure TSpreadSortingTests.Test_SortingByRows1_Numbers;
+begin
+ Test_Sorting_1(false, 0);
+end;
+
+procedure TSpreadSortingTests.Test_SortingByRows1_Strings;
+begin
+ Test_Sorting_1(false, 1);
+end;
+
+procedure TSpreadSortingTests.Test_SortingByRows1_NumbersStrings;
+begin
+ Test_Sorting_1(false, 2);
+end;
+
+procedure TSpreadSortingTests.Test_SortingByCols2;
+begin
+ Test_Sorting_2(true);
+end;
+
+procedure TSpreadSortingTests.Test_SortingByRows2;
+begin
+ Test_Sorting_2(false);
end;
initialization
diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpi b/components/fpspreadsheet/tests/spreadtestgui.lpi
index fe7e6b7c0..fc62e2c66 100644
--- a/components/fpspreadsheet/tests/spreadtestgui.lpi
+++ b/components/fpspreadsheet/tests/spreadtestgui.lpi
@@ -48,6 +48,7 @@
+
@@ -75,7 +76,6 @@
-
@@ -84,7 +84,6 @@
-
@@ -97,7 +96,6 @@
-
@@ -107,7 +105,6 @@
-