fpspreadsheet: Fix speed loss introduced by merging of cells (-> speed-up of some unit tests)

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3600 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-09-23 22:24:35 +00:00
parent 1ed35f0eb1
commit cb05f8873a
3 changed files with 34 additions and 19 deletions

View File

@ -2941,8 +2941,8 @@ var
r,c, r1,c1, r2,c2: Cardinal;
cell: PCell;
begin
for r := 0 to GetLastOccupiedRowIndex do
for c := 0 to GetlastOccupiedColIndex do
for r := GetFirstRowIndex to GetLastOccupiedRowIndex do
for c := GetFirstColIndex to GetlastOccupiedColIndex do
begin
cell := FindCell(r, c);
if FindSharedFormulaRange(cell, r1, c1, r2, c2) and (r1 = r2) and (c1 = c2) then
@ -2964,9 +2964,9 @@ var
begin
n := 0;
SetLength(AList, n);
for r := 0 to GetLastOccupiedRowIndex do
for r := GetFirstRowIndex to GetLastOccupiedRowIndex do
begin
c := 0;
c := GetFirstColIndex;
while (c <= GetLastOccupiedColIndex) do
begin
cell := FindCell(r, c);
@ -4891,7 +4891,7 @@ var
row: PRow;
begin
Result := 0;
for r := 0 to GetLastRowIndex do begin
for r := GetFirstRowIndex to GetLastRowIndex do begin
cell := FindCell(r, ACol);
if cell <> nil then
inc(Result)
@ -4979,13 +4979,14 @@ var
r, c, rr, cc: Cardinal;
r1, c1, r2, c2: Cardinal;
cell, nextcell, basecell: PCell;
lastCol, lastRow: Cardinal;
firstRow, lastCol, lastRow: Cardinal;
begin
lastCol := GetLastColIndex;
lastRow := GetLastOccupiedRowIndex;
firstRow := GetFirstRowIndex;
// Loop along the column to be deleted and fix merged cells and shared formulas
for r := 0 to lastRow do
for r := firstRow to lastRow do
begin
cell := FindCell(r, ACol);
@ -5027,7 +5028,7 @@ begin
end;
// Delete cells
for r := lastRow downto 0 do
for r := lastRow downto firstRow do
RemoveCell(r, ACol);
// Update column index of cell records
@ -5066,10 +5067,15 @@ var
i: Integer;
r, c, rr, cc: Cardinal;
r1, c1, r2, c2: Cardinal;
firstCol, lastCol, lastRow: Cardinal;
cell, nextcell, basecell: PCell;
begin
firstCol := GetFirstColIndex;
lastCol := GetLastOccupiedColIndex;
lastRow := GetLastOccupiedRowIndex;
// Loop along the row to be deleted and fix merged cells and shared formulas
for c := 0 to GetLastOccupiedColIndex do
for c := firstCol to lastCol do
begin
cell := FindCell(ARow, c);
@ -5098,8 +5104,8 @@ begin
// Write adapted formula to the cell below.
WriteFormula(nextcell, basecell^.FormulaValue); //ReadFormulaAsString(nextcell));
// Have all cells sharing the formula use the new formula base
for rr := ARow+1 to GetLastOccupiedRowIndex do
for cc := c to GetLastOccupiedColIndex do
for rr := ARow+1 to lastRow do
for cc := c to lastCol do
begin
cell := FindCell(rr, cc);
if (cell <> nil) and (cell^.SharedFormulaBase = basecell) then
@ -5111,7 +5117,7 @@ begin
end;
// Delete cells
for c := GetLastColIndex downto 0 do
for c := lastCol downto 0 do
RemoveCell(ARow, c);
// Update row index of cell reocrds
@ -5152,7 +5158,7 @@ var
i: Integer;
r, c, cc: Cardinal;
r1, c1, r2, c2: Cardinal;
rLast, cLast: Cardinal;
rFirst, rLast, cLast: Cardinal;
cell, nextcell, gapcell, oldbase, newbase: PCell;
begin
// Handling of shared formula references is too complicated for me...
@ -5185,11 +5191,12 @@ begin
// with dummy cells and set their MergeBase correctly.
if ACol > 0 then
begin
rFirst := GetFirstRowIndex;
rLast := GetLastOccupiedRowIndex;
cLast := GetlastOccupiedColIndex;
c := ACol - 1;
// Seek along the column immediately to the left of the inserted column
for r := 0 to rLast do
for r := rFirst to rLast do
begin
cell := FindCell(r, c);
if not Assigned(cell) then
@ -5298,7 +5305,7 @@ begin
begin
r := ARow - 1;
// Seek along the row immediately above the inserted row
for c := 0 to GetLastOccupiedColIndex do
for c := GetFirstColIndex to GetLastOccupiedColIndex do
begin
cell := FindCell(r, c);
if not Assigned(cell) then

View File

@ -1505,6 +1505,7 @@ var
MyWorksheet: TsWorksheet;
MyWorkbook: TsWorkbook;
row, col: Integer;
lastCol, lastRow: Cardinal;
r1,c1,r2,c2: Cardinal;
MyCell: PCell;
TempFile: string; //write xls/xml to this file and read back from it
@ -1609,10 +1610,14 @@ begin
if MyWorksheet=nil then
fail('Error in test code. Failed to get named worksheet');
for row := 0 to MyWorksheet.GetLastRowIndex do begin
lastRow := MyWorksheet.GetLastOccupiedRowIndex;
lastCol := MyWorksheet.GetLastOccupiedColIndex;
for row := 0 to lastRow do
begin
expected := L[row];
actual := '';
for col := 0 to MyWorksheet.GetLastColIndex do
for col := 0 to lastcol do
begin
MyCell := MyWorksheet.FindCell(row, col);

View File

@ -48,7 +48,6 @@
<Unit1>
<Filename Value="datetests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="datetests"/>
</Unit1>
<Unit2>
<Filename Value="stringtests.pas"/>
@ -57,6 +56,7 @@
<Unit3>
<Filename Value="numberstests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="numberstests"/>
</Unit3>
<Unit4>
<Filename Value="manualtests.pas"/>
@ -71,11 +71,11 @@
<Unit6>
<Filename Value="internaltests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="internaltests"/>
</Unit6>
<Unit7>
<Filename Value="formattests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="formattests"/>
</Unit7>
<Unit8>
<Filename Value="colortests.pas"/>
@ -96,6 +96,7 @@
<Unit12>
<Filename Value="rpnformulaunit.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="rpnFormulaUnit"/>
</Unit12>
<Unit13>
<Filename Value="formulatests.pas"/>
@ -105,10 +106,12 @@
<Unit14>
<Filename Value="emptycelltests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="emptycelltests"/>
</Unit14>
<Unit15>
<Filename Value="errortests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="errortests"/>
</Unit15>
<Unit16>
<Filename Value="virtualmodetests.pas"/>