pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Fix shared formula issues with absolute cell references

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3527 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-09-05 15:41:44 +00:00
parent ac149b750d
commit ab50c08bd2
7 changed files with 225 additions and 59 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
components/fpspreadsheet/fpsexprparser.pas
View File

@ -3786,7 +3786,7 @@ begin
if rfRelCol in FFlags then
Result := FCol - FParser.ActiveCell^.SharedFormulaBase^.Col + FParser.ActiveCell^.Col
else
Result := FParser.ActiveCell^.SharedFormulaBase^.Col;
Result := FCol; //FParser.ActiveCell^.SharedFormulaBase^.Col;
end
else
// Normal mode
@ -3824,7 +3824,7 @@ begin
if rfRelRow in FFlags then
Result := FRow - FParser.ActiveCell^.SharedFormulaBase^.Row + FParser.ActiveCell^.Row
else
Result := FParser.ActiveCell^.SharedFormulaBase^.Row;
Result := FRow; //FParser.ActiveCell^.SharedFormulaBase^.Row;
end
else
Result := FRow;

88
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -623,6 +623,11 @@ type
function WriteRPNFormula(ARow, ACol: Cardinal; AFormula: TsRPNFormula): PCell; overload;
procedure WriteRPNFormula(ACell: PCell; AFormula: TsRPNFormula); overload;
procedure WriteSharedFormula(ARow1, ACol1, ARow2, ACol2: Cardinal;
const AFormula: String); overload;
procedure WriteSharedFormula(ACellRange: String;
const AFormula: String); overload;
function WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring): PCell; overload;
procedure WriteUTF8Text(ACell: PCell; AText: ansistring); overload;
@ -702,8 +707,7 @@ type
procedure CalcFormula(ACell: PCell);
procedure CalcFormulas;
function ConvertRPNFormulaToStringFormula(const AFormula: TsRPNFormula): String;
function UseSharedFormula(ARow, ACol: Cardinal; ASharedFormulaBase: PCell): PCell; overload;
procedure UseSharedFormula(ACellRangeStr: String; ASharedFormulaBase: PCell); overload;
function UseSharedFormula(ARow, ACol: Cardinal; ASharedFormulaBase: PCell): PCell;
{ Data manipulation methods - For Cells }
procedure CopyCell(AFromRow, AFromCol, AToRow, AToCol: Cardinal; AFromWorksheet: TsWorksheet);
@ -2866,37 +2870,10 @@ begin
if HasFormula(Result) and
((ASharedFormulaBase.Row <> ARow) and (ASharedFormulaBase.Col <> ACol))
then
raise Exception.CreateFmt('Cell %s uses a shared formula, but contains an own formula.',
raise Exception.CreateFmt('[TsWorksheet.UseSharedFormula] Cell %s uses a shared formula, but contains an own formula.',
[GetCellString(ARow, ACol)]);
end;
{@@
Uses the formula defined in cell "ASharedFormulaBase" as a shared formula in
all cells of the given cell range.
@param ACellRangeStr Range of cells which will use the shared formula.
The range is given as a string in Excel notation,
such as A1:B5, or A1
@param ASharedFormulaBase Cell containing the formula to be shared
}
procedure TsWorksheet.UseSharedFormula(ACellRangeStr: String; ASharedFormulaBase: PCell);
var
r, c, r1, c1, r2, c2: Cardinal;
ok: Boolean;
begin
if pos(':', ACellRangeStr) = 0 then
begin
ok := ParseCellString(ACellRangeStr, r1, c1);
r2 := r1;
c2 := c1;
end else
ok := ParseCellRangeString(ACellRangeStr, r1, c1, r2, c2);
if ok then
for r := r1 to r2 do
for c := c1 to c2 do
UseSharedFormula(r, c, ASharedFormulaBase);
end;
{@@
Writes UTF-8 encoded text to a cell.
@ -3798,6 +3775,57 @@ begin
ChangedCell(ACell^.Row, ACell^.Col);
end;
{@@
Writes a formula to a cell and shares it with other cells.
@param ARow1, ACol1 Row and column index of the top left corner of
the range sharing the formula. The cell in this
cell stores the formula.
@param ARow2, ACol2 Row and column of the bottom right corner of the
range sharing the formula.
@param AFormula Formula in Excel notation
}
procedure TsWorksheet.WriteSharedFormula(ARow1, ACol1, ARow2, ACol2: Cardinal;
const AFormula: String);
var
cell: PCell;
r, c: Cardinal;
begin
if (ARow1 > ARow2) or (ACol1 > ACol2) then
raise Exception.Create('[TsWorksheet.WriteSharedFormula] Rows/cols not ordered correctly: ARow1 <= ARow2, ACol1 <= ACol2.');
if (ARow1 = ARow2) and (ACol1 = ACol2) then
raise Exception.Create('[TsWorksheet.WriteSharedFormula] A shared formula range must contain at least two cells.');
// The cell at the top/left corner of the cell range is the "SharedFormulaBase".
// It is the only cell which stores the formula.
cell := WriteFormula(ARow1, ACol1, AFormula);
for r := ARow1 to ARow2 do
for c := ACol1 to ACol2 do
UseSharedFormula(r, c, cell);
end;
{@@
Writes a formula to a cell and shares it with other cells.
@param ACellRangeStr Range of cells which will use the shared formula.
The range is given as a string in Excel notation,
such as A1:B5, or A1
@param AFormula Formula (in Excel notation) to be shared. The cell
addresses are relative to the top/left cell of the
range.
}
procedure TsWorksheet.WriteSharedFormula(ACellRange: String;
const AFormula: String);
var
r1,r2, c1,c2: Cardinal;
begin
if ParseCellRangeString(ACellRange, r1, c1, r2, c2) then
WriteSharedFormula(r1, c1, r2, c2, AFormula)
else
raise Exception.Create('[TsWorksheet.WriteSharedFormula] No valid cell range string.');
end;
{@@
Adds font specification to the formatting of a cell. Looks in the workbook's
FontList and creates an new entry if the font is not used so far. Returns the

143
components/fpspreadsheet/tests/formulatests.pas
View File

@ -33,12 +33,12 @@ type
// Test formula strings
procedure TestWriteReadFormulaStrings(AFormat: TsSpreadsheetFormat;
UseRPNFormula: Boolean);
procedure Test_Write_Read_SharedFormulaStrings(AFormat: TsSpreadsheetFormat);
// Test calculation of rpn formulas
procedure TestCalcFormulas(AFormat: TsSpreadsheetformat; UseRPNFormula: Boolean);
published
// Writes out numbers & reads back.
// If previous read tests are ok, this effectively tests writing.
// Writes out formulas & reads them back.
{ BIFF2 Tests }
procedure Test_Write_Read_FormulaStrings_BIFF2;
{ BIFF5 Tests }
@ -50,6 +50,18 @@ type
{ ODS Tests }
procedure Test_Write_Read_FormulaStrings_ODS;
// Writes out shared formulas & reads them back.
{ BIFF2 Tests }
procedure Test_Write_Read_SharedFormulaStrings_BIFF2;
{ BIFF2 Tests }
procedure Test_Write_Read_SharedFormulaStrings_BIFF5;
{ BIFF8 Tests }
procedure Test_Write_Read_SharedFormulaStrings_BIFF8;
{ OOXML Tests }
procedure Test_Write_Read_SharedFormulaStrings_OOXML;
{ ODS Tests }
procedure Test_Write_Read_SharedFormulaStrings_ODS;
// Writes out and calculates rpn formulas, read back
{ BIFF2 Tests }
procedure Test_Write_Read_CalcRPNFormula_BIFF2;
@ -197,6 +209,133 @@ begin
end;
{ Test writing and reading (i.e. reconstruction) of shared formula strings }
procedure TSpreadWriteReadFormulaTests.Test_Write_Read_SharedFormulaStrings(
AFormat: TsSpreadsheetFormat);
const
SHEET = 'SharedFormulaSheet';
var
MyWorksheet: TsWorksheet;
MyWorkbook: TsWorkbook;
cell: PCell;
row, col: Cardinal;
TempFile: String;
actual, expected: String;
sollValues: array[1..4, 0..5] of string;
begin
TempFile := GetTempFileName;
// Create test workbook
MyWorkbook := TsWorkbook.Create;
try
MyWorkbook.Options := MyWorkbook.Options + [boCalcBeforeSaving];
MyWorkSheet:= MyWorkBook.AddWorksheet(SHEET);
// Write out test values
MyWorksheet.WriteNumber(0, 0, 1.0); // A1
MyWorksheet.WriteNumber(0, 1, 2.0);
MyWorksheet.WriteNumber(0, 2, 3.0);
MyWorksheet.WriteNumber(0, 3, 4.0);
MyWorksheet.WriteNumber(0, 4, 5.0); // E1
// Write out all test formulas
// sollValues contains the expected formula as seen from each cell in the
// shared formula block.
MyWorksheet.WriteSharedFormula('A2:E2', 'A1');
sollValues[1, 0] := 'A1';
sollValues[1, 1] := 'B1';
sollValues[1, 2] := 'C1';
sollValues[1, 3] := 'D1';
sollValues[1, 4] := 'E1';
MyWorksheet.WriteSharedFormula('A3:E3', '$A1');
sollValues[2, 0] := '$A1';
sollValues[2, 1] := '$A1';
sollValues[2, 2] := '$A1';
sollValues[2, 3] := '$A1';
sollValues[2, 4] := '$A1';
MyWorksheet.WriteSharedFormula('A4:E4', 'A$1');
sollValues[3, 0] := 'A$1';
sollValues[3, 1] := 'B$1';
sollValues[3, 2] := 'C$1';
sollValues[3, 3] := 'D$1';
sollValues[3, 4] := 'E$1';
MyWorksheet.WriteSharedFormula('A5:E5', '$A$1');
sollValues[4, 0] := '$A$1';
sollValues[4, 1] := '$A$1';
sollValues[4, 2] := '$A$1';
sollValues[4, 3] := '$A$1';
sollValues[4, 4] := '$A$1';
MyWorksheet.WriteSharedFormula('A6:E6', 'SIN(A1)');
MyWorksheet.WriteSharedFormula('A7:E7', 'SIN($A1)');
MyWorksheet.WriteSharedFormula('A8:E8', 'SIN(A$1)');
MyWorksheet.WriteSharedFormula('A9:E9', 'SIN($A$1)');
MyWorkBook.WriteToFile(TempFile, AFormat, true);
finally
MyWorkbook.Free;
end;
// Open the spreadsheet
MyWorkbook := TsWorkbook.Create;
try
MyWorkbook.Options := MyWorkbook.Options + [boReadFormulas, boAutoCalc];
MyWorkbook.ReadFromFile(TempFile, AFormat);
if AFormat = sfExcel2 then
MyWorksheet := MyWorkbook.GetFirstWorksheet
else
MyWorksheet := GetWorksheetByName(MyWorkBook, SHEET);
if MyWorksheet=nil then
fail('Error in test code. Failed to get named worksheet');
for row := 1 to 8 do begin
for col := 0 to MyWorksheet.GetLastColIndex do begin
cell := Myworksheet.FindCell(row, col);
if HasFormula(cell) then begin
actual := MyWorksheet.ReadFormulaAsString(cell);
if row <= 4 then
expected := SollValues[row, col]
else
expected := 'SIN(' + SollValues[row-4, col] + ')';
CheckEquals(expected, actual, 'Test read formula mismatch, cell '+CellNotation(MyWorkSheet,Row,Col));
end else
fail('No formula found in cell ' + CellNotation(MyWorksheet, Row, Col));
end;
end;
finally
MyWorkbook.Free;
DeleteFile(TempFile);
end;
end;
procedure TSpreadWriteReadFormulaTests.Test_Write_Read_SharedFormulaStrings_BIFF2;
begin
Test_Write_Read_SharedFormulaStrings(sfExcel2);
end;
procedure TSpreadWriteReadFormulaTests.Test_Write_Read_SharedFormulaStrings_BIFF5;
begin
Test_Write_Read_SharedFormulaStrings(sfExcel5);
end;
procedure TSpreadWriteReadFormulaTests.Test_Write_Read_SharedFormulaStrings_BIFF8;
begin
Test_Write_Read_SharedFormulaStrings(sfExcel8);
end;
procedure TSpreadWriteReadFormulaTests.Test_Write_Read_SharedFormulaStrings_OOXML;
begin
Test_Write_Read_SharedFormulaStrings(sfOOXML);
end;
procedure TSpreadWriteReadFormulaTests.Test_Write_Read_SharedFormulaStrings_ODS;
begin
Test_Write_Read_SharedFormulaStrings(sfOpenDocument);
end;
{ Test calculation of formulas }
procedure TSpreadWriteReadFormulaTests.TestCalcFormulas(AFormat: TsSpreadsheetFormat;

7
components/fpspreadsheet/tests/spreadtestgui.lpi
View File

@ -48,26 +48,23 @@
<Unit1>
<Filename Value="datetests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="datetests"/>
</Unit1>
<Unit2>
<Filename Value="stringtests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="stringtests"/>
</Unit2>
<Unit3>
<Filename Value="numberstests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="numberstests"/>
</Unit3>
<Unit4>
<Filename Value="manualtests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="manualtests"/>
</Unit4>
<Unit5>
<Filename Value="testsutility.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="testsutility"/>
</Unit5>
<Unit6>
<Filename Value="internaltests.pas"/>
@ -77,7 +74,6 @@
<Unit7>
<Filename Value="formattests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="formattests"/>
</Unit7>
<Unit8>
<Filename Value="colortests.pas"/>
@ -99,6 +95,7 @@
<Unit12>
<Filename Value="rpnformulaunit.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="rpnFormulaUnit"/>
</Unit12>
<Unit13>
<Filename Value="formulatests.pas"/>

5
components/fpspreadsheet/xlsbiff8.pas
View File

@ -130,7 +130,6 @@ type
AFlags: TsRelFlags): Word; override;
function WriteRPNCellRangeAddress(AStream: TStream; ARow1, ACol1, ARow2, ACol2: Cardinal;
AFlags: TsRelFlags): Word; override;
// procedure WriteSharedFormulaRange(AStream: TStream; const ARange: TRect); override;
function WriteString_8bitLen(AStream: TStream; AString: String): Integer; override;
procedure WriteStringRecord(AStream: TStream; AString: string); override;
procedure WriteStyle(AStream: TStream);
@ -801,7 +800,7 @@ end;
function TsSpreadBIFF8Writer.WriteRPNCellOffset(AStream: TStream;
ARowOffset, AColOffset: Integer; AFlags: TsRelFlags): Word;
var
c: word;
c: Word;
r: SmallInt;
begin
// row address
@ -809,7 +808,7 @@ begin
AStream.WriteWord(WordToLE(Word(r)));
// Encoded column address
c := word(SmallInt(AColOffset)) and MASK_EXCEL_COL_BITS_BIFF8;
c := word(AColOffset) and MASK_EXCEL_COL_BITS_BIFF8;
if (rfRelRow in AFlags) then c := c or MASK_EXCEL_RELATIVE_ROW_BIFF8;
if (rfRelCol in AFlags) then c := c or MASK_EXCEL_RELATIVE_COL_BIFF8;
AStream.WriteWord(WordToLE(c));

28
components/fpspreadsheet/xlscommon.pas
View File

@ -1403,7 +1403,13 @@ var
begin
// 2 bytes for row
r := WordLEToN(AStream.ReadWord);
dr := SmallInt(r and $3FFF);
// Check sign bit
if r and $2000 = 0 then
dr := SmallInt(r and $3FFF)
else
dr := SmallInt($C000 or (r and $3FFF));
// dr := SmallInt(r and $3FFF);
ARowOffset := dr;
// 1 byte for column
@ -1547,10 +1553,10 @@ begin
// For compatibility with other formats, convert offsets back to regular indexes.
if (rfRelRow in flags)
then r := ACell^.Row + dr
else r := ACell^.SharedFormulaBase^.Row + dr;
else r := dr; //ACell^.SharedFormulaBase^.Row + dr;
if (rfRelCol in flags)
then c := ACell^.Col + dc
else c := ACell^.SharedFormulaBase^.Col + dc;
else c := dc; //ACell^.SharedFormulaBase^.Col + dc;
case token of
INT_EXCEL_TOKEN_TREFN_V: rpnItem := RPNCellValue(r, c, flags, rpnItem);
INT_EXCEL_TOKEN_TREFN_R: rpnItem := RPNCellRef(r, c, flags, rpnItem);
@ -1645,7 +1651,10 @@ begin
end
else begin
formula := CreateRPNFormula(rpnItem, true); // true --> we have to flip the order of items!
ACell^.FormulaValue := FWorksheet.ConvertRPNFormulaToStringFormula(formula);
if (ACell^.SharedFormulaBase = nil) or (ACell = ACell^.SharedFormulaBase) then
ACell^.FormulaValue := FWorksheet.ConvertRPNFormulaToStringFormula(formula)
else
ACell^.FormulaValue := '';
Result := true;
end;
end;
@ -2554,10 +2563,10 @@ begin
begin
if rfRelRow in AFormula[i].RelFlags
then dr := integer(AFormula[i].Row) - ACell^.Row
else dr := integer(AFormula[i].Row) - ACell^.SharedFormulaBase^.Row;
else dr := integer(AFormula[i].Row);
if rfRelCol in AFormula[i].RelFlags
then dc := integer(AFormula[i].Col) - ACell^.Col
else dc := integer(AFormula[i].Col) - ACell^.SharedFormulaBase^.Col;
else dc := integer(AFormula[i].Col);
n := WriteRPNCellOffset(AStream, dr, dc, AFormula[i].RelFlags);
inc(RPNLength, n);
end;
@ -2802,7 +2811,8 @@ end;
token fekCellOffset
Valid for BIFF5-BIFF8. No shared formulas before BIFF2. But since a worksheet
containing shared formulas can be written the BIFF2 writer needs to duplicate
the formulas in each cell. In BIFF2 WriteSharedFormula must not do anything. }
the formulas in each cell (with adjusted cell references). In BIFF2
WriteSharedFormula must not do anything. }
procedure TsSpreadBIFFWriter.WriteSharedFormula(AStream: TStream; ACell: PCell);
var
r, c, r1, r2, c1, c2: Cardinal;
@ -2858,9 +2868,7 @@ begin
// Create an RPN formula from the shared formula base's string formula
// and adjust relative references
formula := FWorksheet.BuildRPNFormula(ACell^.SharedFormulaBase);
{ for i:=0 to Length(formula)-1 do
FixRelativeReferences(ACell, formula[i]);
}
// Writes the rpn token array
WriteRPNTokenArray(AStream, ACell, formula, true, RPNLength);

9
components/fpspreadsheet/xlsxooxml.pas
View File

@ -654,16 +654,11 @@ begin
if s = 'shared' then
begin
s := GetAttrValue(datanode, 'ref');
if (s <>'') then
begin
AWorksheet.WriteFormula(cell, formulaStr);
// cell^.FormulaValue := formulaStr;
FWorksheet.UseSharedFormula(s, cell);
end;
if (s <> '') then
AWorksheet.WriteSharedFormula(s, formulaStr);
end
else
AWorksheet.WriteFormula(cell, formulaStr);
// cell^.FormulaValue := formulaStr;
end;
datanode := datanode.NextSibling;
end;