From fb8faab20bce6c2240807f955849eb07765915f2 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Thu, 23 Oct 2014 09:07:20 +0000 Subject: [PATCH] fpspreadsheet: Fix compilation error introduced yesterday. Fix multi-key sorting which now passes all tests. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3679 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/other/demo_sorting.lpi | 1 - components/fpspreadsheet/fpsexprparser.pas | 4 +- components/fpspreadsheet/fpsfunc.pas | 12 ++- components/fpspreadsheet/fpspreadsheet.pas | 81 +++++++++++++++++-- .../fpspreadsheet/tests/sortingtests.pas | 20 ++--- .../fpspreadsheet/tests/spreadtestgui.lpi | 5 +- 6 files changed, 90 insertions(+), 33 deletions(-) diff --git a/components/fpspreadsheet/examples/other/demo_sorting.lpi b/components/fpspreadsheet/examples/other/demo_sorting.lpi index 7376abc10..62cc1b40b 100644 --- a/components/fpspreadsheet/examples/other/demo_sorting.lpi +++ b/components/fpspreadsheet/examples/other/demo_sorting.lpi @@ -45,7 +45,6 @@ - diff --git a/components/fpspreadsheet/fpsexprparser.pas b/components/fpspreadsheet/fpsexprparser.pas index 2e5e8cddc..f961a82d3 100644 --- a/components/fpspreadsheet/fpsexprparser.pas +++ b/components/fpspreadsheet/fpsexprparser.pas @@ -833,7 +833,7 @@ const implementation uses - typinfo, math, lazutf8, dateutils, fpsutils; //, fpsfunc; + typinfo, math, lazutf8, dateutils, fpsutils, fpsfunc; const cNull = #0; @@ -4258,7 +4258,7 @@ initialization ExprFormatSettings.DecimalSeparator := '.'; ExprFormatSettings.ListSeparator := ','; -// RegisterStdBuiltins(BuiltinIdentifiers); + RegisterStdBuiltins(BuiltinIdentifiers); finalization FreeBuiltins; diff --git a/components/fpspreadsheet/fpsfunc.pas b/components/fpspreadsheet/fpsfunc.pas index da74ddbe3..e5189e6e0 100644 --- a/components/fpspreadsheet/fpsfunc.pas +++ b/components/fpspreadsheet/fpsfunc.pas @@ -9,15 +9,15 @@ unit fpsfunc; interface uses - Classes, SysUtils, fpspreadsheet, fpsexprparser; + Classes, SysUtils, fpspreadsheet; -procedure RegisterStdBuiltins(AManager : TsBuiltInExpressionManager); +procedure RegisterStdBuiltins(AManager: TComponent); //TsBuiltInExpressionManager); implementation uses - Math, lazutf8, StrUtils, DateUtils, xlsconst, fpsUtils; + Math, lazutf8, StrUtils, DateUtils, xlsconst, fpsUtils, fpsexprparser; {------------------------------------------------------------------------------} @@ -1529,11 +1529,11 @@ end; {------------------------------------------------------------------------------} {@@ Registers the standard built-in functions. Called automatically. } -procedure RegisterStdBuiltins(AManager : TsBuiltInExpressionManager); +procedure RegisterStdBuiltins(AManager : TComponent); var cat: TsBuiltInExprCategory; begin - with AManager do + with AManager as TsBuiltInExpressionManager do begin // Math functions cat := bcMath; @@ -1891,7 +1891,5 @@ end; *) -initialization - RegisterStdBuiltins(BuiltinIdentifiers); end. diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 38db9d5b2..5c92cfd32 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -542,7 +542,10 @@ type procedure RemoveAndFreeCell(ARow, ACol: Cardinal); // Sorting - function DoCompareCells(ACell1, ACell2: PCell; ASortOrder: TsSortOrder): Integer; + function DoCompareCells(ARow1, ACol1, ARow2, ACol2: Cardinal; + ASortOrder: TsSortOrder): Integer; + function DoInternalCompareCells(ACell1, ACell2: PCell; + ASortOrder: TsSortOrder): Integer; procedure DoExchangeColRow(AIsColumn: Boolean; AIndex, WithIndex: Cardinal; AFromIndex, AToIndex: Cardinal); @@ -3198,7 +3201,50 @@ begin end; {@@ ---------------------------------------------------------------------------- - Compare function for sorting of rows and columns + Compare function for sorting of rows and columns called directly by Sort() + The compare algorithm starts with the first key parameters. If cells are + found to be "equal" the next parameter is set is used until a difference is + found, or all parameters are used. + + @param ARow1 Row index of the first cell to be compared + @param ACol1 Column index of the first cell to be compared + @param ARow2 Row index of the second cell to be compared + @parem ACol2 Column index of the second cell to be compared + @return -1 if the first cell is "smaller", i.e. is sorted in front of the + second one + +1 if the first cell is "larger", i.e. is behind the second one + 0 if both cells are equal +------------------------------------------------------------------------------- } +function TsWorksheet.DoCompareCells(ARow1, ACol1, ARow2, ACol2: Cardinal; + ASortOrder: TsSortOrder): Integer; +var + cell1, cell2: PCell; // Pointers to the cells to be compared + key: Integer; +begin + cell1 := FindCell(ARow1, ACol1); + cell2 := FindCell(ARow2, ACol2); + Result := DoInternalCompareCells(cell1, cell2, ASortOrder); + if Result = 0 then begin + key := 1; + while (Result = 0) and (key <= High(FSortParams.Keys)) do + begin + if FSortParams.SortByCols then + begin + cell1 := FindCell(ARow1, FSortParams.Keys[key].ColRowIndex); + cell2 := FindCell(ARow2, FSortParams.Keys[key].ColRowIndex); + end else + begin + cell1 := FindCell(FSortParams.Keys[key].ColRowIndex, ACol1); + cell2 := FindCell(FSortParams.Keys[key].ColRowIndex, ACol2); + end; + Result := DoInternalCompareCells(cell1, cell2, ASortOrder); + inc(key); + end; + end; +end; + +{@@ ---------------------------------------------------------------------------- + Compare function for sorting of rows and columns. Called by DoCompareCells. @param ACell1 Pointer to the first cell of the comparison @param ACell2 Pointer to the second cell of the comparison @@ -3209,14 +3255,14 @@ end; Date/time and boolean cells are sorted like number cells according to their number value - Label cells are sorted like UTF8 strings. + Label cells are sorted as UTF8 strings. 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; +function TsWorksheet.DoInternalCompareCells(ACell1, ACell2: PCell; ASortOrder: TsSortOrder): Integer; // Sort priority in Excel: // numbers < alpha < blank (ascending) @@ -3335,14 +3381,31 @@ procedure TsWorksheet.Sort(const ASortParams: TsSortParams; var I,J,K: Integer; P: Integer; + index: Integer; + order: TsSortOrder; + { cell1, cell2: PCell; compareResult: Integer; + } begin + index := ASortParams.Keys[0].ColRowIndex; // less typing... + order := ASortParams.Keys[0].Order; repeat I := L; J := R; P := (L + R) div 2; repeat + if ASortParams.SortByCols then + begin + while DoCompareCells(P, index, I, index, order) > 0 do inc(I); + while DoCompareCells(P, index, J, index, order) < 0 do dec(J); + end else + begin + while DoCompareCells(index, P, index, I, order) > 0 do inc(I); + while DoCompareCells(index, P, index, J, order) < 0 do dec(J); + end; + + { original code from "grids.pas": if ColSorting then begin @@ -3352,7 +3415,7 @@ procedure TsWorksheet.Sort(const ASortParams: TsSortParams; while DoCompareCells(P, index, I, index)>0 do I:=I+1; while DoCompareCells(P, index, J, index)<0 do J:=J-1; end; } - + { if ASortParams.SortByCols then begin (* @@ -3528,7 +3591,7 @@ procedure TsWorksheet.Sort(const ASortParams: TsSortParams; end; end; *) - end; + end; } if I <= J then begin @@ -3536,15 +3599,21 @@ procedure TsWorksheet.Sort(const ASortParams: TsSortParams; begin if ASortParams.SortByCols then begin + if DoCompareCells(I, index, J, index, order) <> 0 then + { cell1 := FindCell(I, ASortParams.Keys[0].ColRowIndex); cell2 := FIndCell(J, ASortParams.Keys[0].ColRowIndex); if DoCompareCells(cell1, cell2, ASortParams.Keys[0].Order) <> 0 then + } DoExchangeColRow(not ASortParams.SortByCols, J,I, AColFrom, AColTo); end else begin + if DoCompareCells(index, I, index, J, order) <> 0 then + { cell1 := FindCell(ASortParams.Keys[0].ColRowIndex, I); cell2 := FIndCell(ASortParams.Keys[0].ColRowIndex, J); if DoCompareCells(cell1, cell2, ASortParams.Keys[0].Order) <> 0 then + } DoExchangeColRow(not ASortParams.SortByCols, J,I, ARowFrom, ARowTo); end; end; diff --git a/components/fpspreadsheet/tests/sortingtests.pas b/components/fpspreadsheet/tests/sortingtests.pas index c0b5219b2..9b769aa99 100644 --- a/components/fpspreadsheet/tests/sortingtests.pas +++ b/components/fpspreadsheet/tests/sortingtests.pas @@ -295,14 +295,14 @@ begin // We will sort primarily according to column A, and seconarily according // to B. The construction allows us to determine if the sorting is correct. for i:=0 to iLast do - MyWorksheet.WriteUTF8Text(i, col, char(ord('A')+round(SollSortNumbers[i div 2]))); + MyWorksheet.WriteUTF8Text(i, col, char(ord('A')+round(SollSortNumbers[i]) div 2)); end else begin // The same with the rows... for i:=0 to iLast do - MyWorksheet.WriteNumber(row+1, i+1, SollSortNumbers[i]); + MyWorksheet.WriteNumber(row+1, i, SollSortNumbers[i]); for i:=0 to iLast do - MyWorksheet.WriteUTF8Text(row, i, char(ord('A')+round(SollSortNumbers[i div 2]))); + MyWorksheet.WriteUTF8Text(row, i, char(ord('A')+round(SollSortNumbers[i]) div 2)); end; MyWorkBook.WriteToFile(TempFile, AFormat, true); @@ -325,18 +325,12 @@ begin fail('Error in test code. Failed to get named worksheet'); // ... and sort it. - 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); + if ASortByCols then + MyWorksheet.Sort(sortParams, 0, 0, iLast, 1) + else + MyWorksheet.Sort(sortParams, 0, 0, 1, iLast); // for debugging, to see the sorted data MyWorkbook.WriteToFile('sorted.xls', AFormat, true); 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 @@ -