fpspreadsheet: Fix shared formula issues with absolute cell references

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3527 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/fpsexprparser.pas

@@ -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;

components/fpspreadsheet/fpspreadsheet.pas

@@ -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;
+    function UseSharedFormula(ARow, ACol: Cardinal; ASharedFormulaBase: PCell): PCell;
-    procedure UseSharedFormula(ACellRangeStr: String; ASharedFormulaBase: PCell); overload;
 
     { 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

components/fpspreadsheet/tests/formulatests.pas

@@ -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.
+    // Writes out formulas & reads them back.
-    // If previous read tests are ok, this effectively tests writing.
     { 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;

components/fpspreadsheet/tests/spreadtestgui.lpi

@@ -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"/>

components/fpspreadsheet/xlsbiff8.pas

@@ -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));

components/fpspreadsheet/xlscommon.pas

@@ -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);
 

components/fpspreadsheet/xlsxooxml.pas

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