paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fpspreadsheet: Fix sorting with multiple key columns or rows (issue #31886, patch by alex256).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6571 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2018-08-06 15:07:40 +00:00
parent d71884f3e2
commit 19e20fbdf7
1 changed files with 21 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
components/fpspreadsheet/source/common/fpspreadsheet.pas
View File

@ -120,8 +120,7 @@ type
procedure RemoveAndFreeCell(ARow, ACol: Cardinal); procedure RemoveAndFreeCell(ARow, ACol: Cardinal);
// Sorting // Sorting
function DoCompareCells(ARow1, ACol1, ARow2, ACol2: Cardinal; function DoCompareCells(AColRow1, AColRow2: Cardinal): Integer;
ASortOptions: TsSortOptions): Integer;
function DoInternalCompareCells(ACell1, ACell2: PCell; function DoInternalCompareCells(ACell1, ACell2: PCell;
ASortOptions: TsSortOptions): Integer; ASortOptions: TsSortOptions): Integer;
procedure DoExchangeColRow(AIsColumn: Boolean; AIndex, WithIndex: Cardinal; procedure DoExchangeColRow(AIsColumn: Boolean; AIndex, WithIndex: Cardinal;
@ -4194,31 +4193,26 @@ end;
+1 if the first cell is "larger", i.e. is behind the second one +1 if the first cell is "larger", i.e. is behind the second one
0 if both cells are equal 0 if both cells are equal
------------------------------------------------------------------------------- } ------------------------------------------------------------------------------- }
function TsWorksheet.DoCompareCells(ARow1, ACol1, ARow2, ACol2: Cardinal; function TsWorksheet.DoCompareCells(AColRow1, AColRow2: Cardinal): Integer;
ASortOptions: TsSortOptions): Integer;
var var
cell1, cell2: PCell; // Pointers to the cells to be compared cell1, cell2: PCell; // Pointers to the cells to be compared
key: Integer; key: Integer;
begin begin
cell1 := FindCell(ARow1, ACol1); Result := 0;
cell2 := FindCell(ARow2, ACol2); key := 0;
Result := DoInternalCompareCells(cell1, cell2, ASortOptions); while (Result = 0) and (key <= High(FSortParams.Keys)) do
if Result = 0 then begin begin
key := 1; if FSortParams.SortByCols then
while (Result = 0) and (key <= High(FSortParams.Keys)) do
begin begin
if FSortParams.SortByCols then cell1 := FindCell(AColRow1, FSortParams.Keys[key].ColRowIndex);
begin cell2 := FindCell(AColRow2, FSortParams.Keys[key].ColRowIndex);
cell1 := FindCell(ARow1, FSortParams.Keys[key].ColRowIndex); end else
cell2 := FindCell(ARow2, FSortParams.Keys[key].ColRowIndex); begin
end else cell1 := FindCell(FSortParams.Keys[key].ColRowIndex, AColRow1);
begin cell2 := FindCell(FSortParams.Keys[key].ColRowIndex, AColRow2);
cell1 := FindCell(FSortParams.Keys[key].ColRowIndex, ACol1);
cell2 := FindCell(FSortParams.Keys[key].ColRowIndex, ACol2);
end;
Result := DoInternalCompareCells(cell1, cell2, ASortOptions);
inc(key);
end; end;
Result := DoInternalCompareCells(cell1, cell2, FSortParams.Keys[key].Options);
inc(key);
end; end;
end; end;
@ -4366,11 +4360,7 @@ procedure TsWorksheet.Sort(const ASortParams: TsSortParams;
var var
I,J: Integer; I,J: Integer;
P: Integer; P: Integer;
index: Integer;
options: TsSortOptions;
begin begin
index := ASortParams.Keys[0].ColRowIndex; // less typing...
options := ASortParams.Keys[0].Options;
repeat repeat
I := L; I := L;
J := R; J := R;
@ -4378,12 +4368,12 @@ procedure TsWorksheet.Sort(const ASortParams: TsSortParams;
repeat repeat
if ASortParams.SortByCols then if ASortParams.SortByCols then
begin begin
while DoCompareCells(P, index, I, index, options) > 0 do inc(I); while DoCompareCells(P, I) > 0 do inc(I);
while DoCompareCells(P, index, J, index, options) < 0 do dec(J); while DoCompareCells(P, J) < 0 do dec(J);
end else end else
begin begin
while DoCompareCells(index, P, index, I, options) > 0 do inc(I); while DoCompareCells(P, I) > 0 do inc(I);
while DoCompareCells(index, P, index, J, options) < 0 do dec(J); while DoCompareCells(P, J) < 0 do dec(J);
end; end;
if I <= J then if I <= J then
@ -4392,11 +4382,11 @@ procedure TsWorksheet.Sort(const ASortParams: TsSortParams;
begin begin
if ASortParams.SortByCols then if ASortParams.SortByCols then
begin begin
if DoCompareCells(I, index, J, index, options) <> 0 then if DoCompareCells(I, J) <> 0 then
DoExchangeColRow(not ASortParams.SortByCols, J,I, AColFrom, AColTo); DoExchangeColRow(not ASortParams.SortByCols, J,I, AColFrom, AColTo);
end else end else
begin begin
if DoCompareCells(index, I, index, J, options) <> 0 then if DoCompareCells(I, J) <> 0 then
DoExchangeColRow(not ASortParams.SortByCols, J,I, ARowFrom, ARowTo); DoExchangeColRow(not ASortParams.SortByCols, J,I, ARowFrom, ARowTo);
end; end;
end; end;