fpspreadsheet: Fix formulas in ExcelXMLWriter. Fix excelxmlwrite demo.

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

components/fpspreadsheet/examples/read_write/excelxmldemo/excelxmlwrite.lpr

@@ -36,7 +36,7 @@ begin
 
   // Create the spreadsheet
   MyWorkbook := TsWorkbook.Create;
-  MyWorkbook.SetDefaultFont('Calibri', 9);
+  MyWorkbook.SetDefaultFont('Calibri', 10);
   MyWorkbook.FormatSettings.CurrencyFormat := 2;
   MyWorkbook.FormatSettings.NegCurrFormat := 14;
   MyWorkbook.Options := MyWorkbook.Options + [boCalcBeforeSaving];
@@ -138,19 +138,7 @@ begin
   MyWorksheet.WriteText(8, 3, 'Colors...');
   MyWorksheet.WriteFont(8, 3, 'Courier New', 12, [fssUnderline], scBlue);
   MyWorksheet.WriteBackgroundColor(8, 3, scYellow);
-//  MyWorksheet.WriteComment(8, 3, 'This is font "Courier New", Size 12.');
+  MyWorksheet.WriteComment(8, 3, 'This is font "Courier New", Size 12.');
-
-                                         {}
-    {
-  // Uncomment this to test large XLS files
-  for i := 50 to 1000 do
-  begin
-//    MyWorksheet.WriteUTF8Text(i, 0, ParamStr(0));
-//    MyWorksheet.WriteUTF8Text(i, 1, ParamStr(0));
-//    MyWorksheet.WriteUTF8Text(i, 2, ParamStr(0));
-    MyWorksheet.WriteUTF8Text(i, 3, ParamStr(0));
-  end;
-     }
 
   // Write the string formula E1 = A1 + B1 ...
   MyWorksheet.WriteFormula(0, 4, 'A1+B1');

components/fpspreadsheet/fpsexprparser.pas

@@ -80,8 +80,6 @@ type
   TsExpressionParser = class;
   TsBuiltInExpressionManager = class;
 
-  TsFormulaDialect = (fdExcel, fdOpenDocument);
-
   TsResultType = (rtEmpty, rtBoolean, rtInteger, rtFloat, rtDateTime, rtString,
     rtCell, rtCellRange, rtHyperlink, rtError, rtMissingArg, rtAny);
   TsResultTypes = set of TsResultType;
@@ -1222,7 +1220,7 @@ end;
 constructor TsExpressionParser.Create(AWorksheet: TsWorksheet);
 begin
   inherited Create;
-  FDialect := fdExcel;
+  FDialect := fdExcelA1;
   FWorksheet := AWorksheet;
   FIdentifiers := TsExprIdentifierDefs.Create(TsExprIdentifierDef);
   FIdentifiers.FParser := Self;
@@ -3555,9 +3553,16 @@ end;
 
 function TsCellExprNode.AsString: string;
 begin
+  case FParser.Dialect of
+    fdExcelA1      : Result := GetCellString(GetRow, GetCol, FFlags);
+    fdExcelR1C1    : Result := GetCellString_R1C1(GetRow, GetCol, FFlags, FParser.FSourceCell^.Row, FParser.FSourceCell^.Col);
+    fdOpenDocument : Result := '[.' + GetCellString(GetRow, GetCol, FFlags) + ']';
+  end;
+  {
   Result := GetCellString(GetRow, GetCol, FFlags);
   if FParser.Dialect = fdOpenDocument then
     Result := '[.' + Result + ']';
+  }
 end;
 
 procedure TsCellExprNode.Check;

components/fpspreadsheet/fpsopendocument.pas

@@ -1955,12 +1955,12 @@ begin
       p := pos('=', formula);
       Delete(formula, 1, p);
     end;
-    // ... convert to Excel dialect used by fps by defailt
+    // ... convert to Excel "A1" dialect used by fps by defailt
     parser := TsSpreadsheetParser.Create(FWorksheet);
     try
       parser.Dialect := fdOpenDocument;
       parser.LocalizedExpression[FPointSeparatorSettings] := formula;
-      parser.Dialect := fdExcel;
+      parser.Dialect := fdExcelA1;
       formula := parser.Expression;
     finally
       parser.Free;

components/fpspreadsheet/fpspreadsheet.pas

@@ -375,6 +375,7 @@ type
     function BuildRPNFormula(ACell: PCell; ADestCell: PCell = nil): TsRPNFormula;
     procedure CalcFormula(ACell: PCell);
     procedure CalcFormulas;
+    function ConvertFormulaDialect(ACell: PCell; ADialect: TsFormulaDialect): String;
     function ConvertRPNFormulaToStringFormula(const AFormula: TsRPNFormula): String;
     function GetCalcState(ACell: PCell): TsCalcState;
     procedure SetCalcState(ACell: PCell; AValue: TsCalcState);
@@ -2675,6 +2676,26 @@ begin
     Result := False;
 end;
 
+function TsWorksheet.ConvertFormulaDialect(ACell: PCell;
+  ADialect: TsFormulaDialect): String;
+var
+  parser: TsSpreadsheetParser;
+begin
+  if ACell^.Formulavalue <> '' then
+  begin
+    parser := TsSpreadsheetParser.Create(self);
+    try
+      parser.Expression := ACell^.FormulaValue;
+      parser.Dialect := ADialect;
+      parser.PrepareCopyMode(ACell, ACell);
+      Result := parser.Expression;
+    finally
+      parser.Free;
+    end;
+  end else
+    Result := '';
+end;
+
 {@@ ----------------------------------------------------------------------------
   Converts an RPN formula (as read from an xls biff file, for example) to a
   string formula.

components/fpspreadsheet/fpstypes.pas

@@ -143,6 +143,9 @@ type
       Simplifies the task of format writers which need RPN }
   TsRPNFormula = array of TsFormulaElement;
 
+  {@@ Formula dialect }
+  TsFormulaDialect = (fdExcelA1, fdExcelR1C1, fdOpenDocument);
+
   {@@ Describes the <b>type of content</b> in a cell of a TsWorksheet }
   TCellContentType = (cctEmpty, cctFormula, cctNumber, cctUTF8String,
     cctDateTime, cctBool, cctError);

components/fpspreadsheet/fpsutils.pas

@@ -80,6 +80,9 @@ function GetColString(AColIndex: Integer): String;
 
 function GetCellString(ARow,ACol: Cardinal;
   AFlags: TsRelFlags = [rfRelRow, rfRelCol]): String;
+function GetCellString_R1C1(ARow, ACol: Cardinal; AFlags: TsRelFlags = [rfRelRow, rfRelCol];
+  ARefRow: Cardinal = Cardinal(-1); ARefCol: Cardinal = Cardinal(-1)): String;
+
 function GetCellRangeString(ARow1, ACol1, ARow2, ACol2: Cardinal;
   AFlags: TsRelFlags = rfAllRel; Compact: Boolean = false): String; overload;
 function GetCellRangeString(ARange: TsCellRange;
@@ -717,6 +720,46 @@ begin
   ]);
 end;
 
+{@@ ----------------------------------------------------------------------------
+  Calculates a cell address string in R1C1 notation from zero-based column and
+  row indexes and the relative address state flags.
+
+  @param   ARow        Zero-based row index
+  @param   ACol        Zero-based column index
+  @param   AFlags      An optional set containing an entry for column and row
+                       if these addresses are relative. By default, relative
+                       addresses are assumed.
+  @param   @ARefRow    Zero-based row index of the reference cell in case of
+                       relative address.
+  @param   @ARefCol    Zero-based column index of the reference cell in case of
+                       relative address.
+  @return  Excel type of cell address in R1C1 notation.
+-------------------------------------------------------------------------------}
+function GetCellString_R1C1(ARow, ACol: Cardinal; AFlags: TsRelFlags = [rfRelRow, rfRelCol];
+  ARefRow: Cardinal = Cardinal(-1); ARefCol: Cardinal = Cardinal(-1)): String;
+var
+  delta: LongInt;
+begin
+  if rfRelRow in AFlags then
+  begin
+    delta := LongInt(ARow) - LongInt(ARefRow);
+    if delta = 0 then
+      Result := 'R' else
+      Result := 'R[' + IntToStr(delta) + ']';
+  end else
+    Result := 'R' + IntToStr(ARow+1);
+
+  if rfRelCol in AFlags then
+  begin
+    delta := LongInt(ACol) - LongInt(ARefCol);
+    if delta = 0 then
+      Result := Result + 'C' else
+      Result := Result + 'C[' + IntToStr(delta) + ']';
+  end else
+    Result := Result + 'C' + IntToStr(ACol+1);
+end;
+
+
 {@@ ----------------------------------------------------------------------------
   Calculates a cell range address string from zero-based column and row indexes
   and the relative address state flags.

components/fpspreadsheet/xlsxml.pas

@@ -1,15 +1,15 @@
-{@@ ----------------------------------------------------------------------------
+{-------------------------------------------------------------------------------
 Unit     : xlsxml
 
-  implements a reader and writer for the SpreadsheetXML format.
+Implements a reader and writer for the SpreadsheetXML format.
 This document was introduced by Microsoft for Excel XP and 2003.
 
 REFERENCE: https://msdn.microsoft.com/en-us/library/aa140066%28v=office.15%29.aspx
 
 AUTHOR   : Werner Pamler
 
-  LICENSE  : See the file COPYING.modifiedLGPL.txt, included in the Lazarus
+LICENSE  : For details about the license, see the file
-             distribution, for details about the license.
+           COPYING.modifiedLGPL.txt included in the Lazarus distribution.
 -------------------------------------------------------------------------------}
 
 unit xlsxml;
@@ -34,6 +34,7 @@ type
     FDateMode: TDateMode;
     FPointSeparatorSettings: TFormatSettings;
     function GetCommentStr(ACell: PCell): String;
+    function GetFormulaStr(ACell: PCell): String;
     function GetHyperlinkStr(ACell: PCell): String;
     function GetIndexStr(AIndex: Integer): String;
     function GetMergeStr(ACell: PCell): String;
@@ -180,6 +181,16 @@ begin
   //  Result := '<Comment><ss:Data xmlns="http://www.w3.org/TR/REC-html40">'+comment^.Text+'</ss:Data></Comment>':
 end;
 
+function TsSpreadExcelXMLWriter.GetFormulaStr(ACell: PCell): String;
+begin
+  if HasFormula(ACell) then
+  begin
+    Result := UTF8TextToXMLText(FWorksheet.ConvertFormulaDialect(ACell, fdExcelR1C1));
+    Result := ' ss:Formula="=' + Result + '"';
+  end else
+    Result := '';
+end;
+
 function TsSpreadExcelXMLWriter.GetHyperlinkStr(ACell: PCell): String;
 var
   hyperlink: PsHyperlink;
@@ -230,20 +241,7 @@ end;
 
 procedure TsSpreadExcelXMLWriter.WriteBool(AStream: TStream;
   const ARow, ACol: Cardinal; const AValue: boolean; ACell: PCell);
-var
-  valueStr: String;
-  formulaStr: String;
-  cctStr: String;
 begin
-  valueStr := StrUtils.IfThen(AValue, '1', '0');
-  cctStr := 'Boolean';
-  formulaStr := '';
-  if HasFormula(ACell) then
-  begin
-    formulaStr := Format(' ss:Formula="=%s"', [ACell^.FormulaValue]);
-    cctStr := GetCellContentTypeStr(ACell);
-  end;
-
   AppendToStream(AStream, Format(CELL_INDENT +
     '<Cell%s%s%s%s%s>' +         // colIndex, style, formula, hyperlink, merge
       '<Data ss:Type="%s">' +    // data type
@@ -251,9 +249,9 @@ begin
       '</Data>' +
       '%s' +                     // Comment <Comment>...</Comment>
     '</Cell>' + LF, [
-    GetIndexStr(ACol+1), GetStyleStr(ACell), formulaStr, GetHyperlinkStr(ACell), GetMergeStr(ACell),
+    GetIndexStr(ACol+1), GetStyleStr(ACell), GetFormulaStr(ACell), GetHyperlinkStr(ACell), GetMergeStr(ACell),
-    cctStr,
+    StrUtils.IfThen(HasFormula(ACell), GetCellContentTypeStr(ACell), 'Boolean'),
-    valueStr,
+    StrUtils.IfThen(AValue, '1', '0'),
     GetCommentStr(ACell)
   ]));
 end;
@@ -268,8 +266,12 @@ begin
   c1 := 0;
   r2 := AWorksheet.GetLastRowIndex;
   c2 := AWorksheet.GetLastColIndex;
-  AppendToStream(AStream, TABLE_INDENT +
+  AppendToStream(AStream, TABLE_INDENT + Format(
-    '<Table>' + LF);
+    '<Table ss:ExpandedColumnCount="%d" ss:ExpandedRowCount="%d" ' +
+      'x:FullColumns="1" x:FullRows="1">' + LF, [
+      AWorksheet.GetLastColIndex + 1, AWorksheet.GetLastRowIndex + 1
+    ]));
+
   for c := c1 to c2 do
     AppendToStream(AStream, COL_INDENT +
       '<Column ss:Width="80" />' + LF);
@@ -321,8 +323,6 @@ procedure TsSpreadExcelXMLWriter.WriteDateTime(AStream: TStream;
   const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell);
 var
   valueStr: String;
-  formulaStr: String;
-  cctStr: String;
   ExcelDate: TDateTime;
   nfp: TsNumFormatParams;
   fmt: PsCellFormat;
@@ -341,14 +341,6 @@ begin
   end;
   valueStr := FormatDateTime('yyyy-mm-dd"T"hh:nn:ss.zzz', ExcelDate);
 
-  cctStr := 'DateTime';
-  formulaStr := '';
-  if HasFormula(ACell) then
-  begin
-    formulaStr := Format(' ss:Formula="=%s"', [ACell^.FormulaValue]);
-    cctStr := GetCellContentTypeStr(ACell);
-  end;
-
   AppendToStream(AStream, Format(CELL_INDENT +
     '<Cell%s%s%s%s%s>' + LF + VALUE_INDENT + // colIndex, style, formula, hyperlink, merge
       '<Data ss:Type="%s">' +                // data type
@@ -356,8 +348,8 @@ begin
       '</Data>' + LF + CELL_INDENT +
       '%s' +                                 // Comment <Comment>...</Comment>
     '</Cell>' + LF, [
-    GetIndexStr(ACol+1), GetStyleStr(ACell), formulaStr, GetHyperlinkStr(ACell), GetMergeStr(ACell),
+    GetIndexStr(ACol+1), GetStyleStr(ACell), GetFormulaStr(ACell), GetHyperlinkStr(ACell), GetMergeStr(ACell),
-    cctStr,
+    StrUtils.IfThen(HasFormula(ACell), GetCellContentTypeStr(ACell), 'DateTime'),
     valueStr,
     GetCommentStr(ACell)
   ]));
@@ -365,21 +357,7 @@ end;
 
 procedure TsSpreadExcelXMLWriter.WriteError(AStream: TStream;
   const ARow, ACol: Cardinal; const AValue: TsErrorValue; ACell: PCell);
-var
-  valueStr: String;
-  cctStr: String;
-  formulaStr: String;
 begin
-  valueStr := GetErrorValueStr(AValue);
-
-  formulaStr := '';
-  cctStr := 'Error';
-  if HasFormula(ACell) then
-  begin
-    cctStr := GetCellContentTypeStr(ACell);
-    formulaStr := Format(' ss:Formula="=%s"', [ACell^.FormulaValue]);
-  end;
-
   AppendToStream(AStream, Format(CELL_INDENT +
     '<Cell%s%s%s%s%s>' + LF + VALUE_INDENT + // colIndex, style, formula, hyperlink, merge
       '<Data ss:Type="%s">' +                // data type
@@ -387,9 +365,9 @@ begin
       '</Data>' + LF + CELL_INDENT +
       '%s' +                                 // Comment <Comment>...</Comment>
     '</Cell>' + LF, [
-    GetIndexStr(ACol+1), GetStyleStr(ACell), formulaStr, GetHyperlinkStr(ACell), GetMergeStr(ACell),
+    GetIndexStr(ACol+1), GetStyleStr(ACell), GetFormulaStr(ACell), GetHyperlinkStr(ACell), GetMergeStr(ACell),
-    cctStr,
+    StrUtils.IfThen(HasFormula(ACell), GetCellContentTypeStr(ACell), 'Error'),
-    valueStr,
+    GetErrorValueStr(AValue),
     GetCommentStr(ACell)
   ]));
 end;
@@ -415,7 +393,6 @@ procedure TsSpreadExcelXMLWriter.WriteLabel(AStream: TStream; const ARow,
 var
   valueStr: String;
   cctStr: String;
-  formulaStr: String;
   xmlnsStr: String;
   dataTagStr: String;
 begin
@@ -445,10 +422,8 @@ begin
 
   cctStr := 'String';
   if HasFormula(ACell) then
-  begin
+    cctStr := GetCellContentTypeStr(ACell) else
-    cctStr := GetCellContentTypeStr(ACell);
+    cctStr := 'String';
-    formulaStr := Format(' ss:Formula="=%s"', [ACell^.FormulaValue]);
-  end;
 
   AppendToStream(AStream, Format(CELL_INDENT +
     '<Cell%s%s%s%s%s>' + LF + VALUE_INDENT + // colIndex, style, formula, hyperlink, merge
@@ -457,7 +432,7 @@ begin
       '</%sData>' + LF + CELL_INDENT +       // "ss:"
       '%s' +                                 // Comment
     '</Cell>' + LF, [
-    GetIndexStr(ACol+1), GetStyleStr(ACell), formulaStr, GetHyperlinkStr(ACell), GetMergeStr(ACell),
+    GetIndexStr(ACol+1), GetStyleStr(ACell), GetFormulaStr(ACell), GetHyperlinkStr(ACell), GetMergeStr(ACell),
     dataTagStr, cctStr, xmlnsStr,
     valueStr,
     dataTagStr,
@@ -467,17 +442,7 @@ end;
 
 procedure TsSpreadExcelXMLWriter.WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
   const AValue: double; ACell: PCell);
-var
-  formulaStr: String;
-  cctStr: String;
 begin
-  cctStr := 'Number';
-  if HasFormula(ACell) then
-  begin
-    cctStr := GetCellContentTypeStr(ACell);
-    formulaStr := Format(' ss:Formula="=%s"', [ACell^.FormulaValue]);
-  end;
-
   AppendToStream(AStream, Format(CELL_INDENT +
     '<Cell%s%s%s%s%s>' + LF + VALUE_INDENT +  // colIndex, style, formula, hyperlink, merge
       '<Data ss:Type="%s">' +                 // data type
@@ -485,11 +450,11 @@ begin
       '</Data>' + LF + CELL_INDENT +
       '%s' +                                  // Comment <Comment>...</Comment>
     '</Cell>' + LF, [
-    GetIndexStr(ACol+1), GetStyleStr(ACell), formulaStr, GetHyperlinkStr(ACell), GetMergeStr(ACell),
+    GetIndexStr(ACol+1), GetStyleStr(ACell), GetFormulaStr(ACell), GetHyperlinkStr(ACell), GetMergeStr(ACell),
-    cctStr,
+    StrUtils.IfThen(HasFormula(ACell), GetCellContentTypeStr(ACell), 'Number'),
     AValue,
-    GetCommentStr(ACell)
+    GetCommentStr(ACell)], FPointSeparatorSettings)
-  ]));
+  );
 end;
 
 procedure TsSpreadExcelXMLWriter.WriteStyle(AStream: TStream; AIndex: Integer);
@@ -596,7 +561,7 @@ begin
     begin
       nfp := FWorkbook.GetNumberFormat(fmt^.NumberFormatIndex);
       AppendToStream(AStream, Format(INDENT3 +
-        '<NumberFormat ss:Format="%s"/>' + LF, [nfp.NumFormatStr]));
+        '<NumberFormat ss:Format="%s"/>' + LF, [UTF8TextToXMLText(nfp.NumFormatStr)]));
     end;
 
     // Background
@@ -608,7 +573,7 @@ begin
         s := s + 'ss:PatternColor="' + ColorToHTMLColorStr(fill.FgColor) + '" ';
       s := s + 'ss:Pattern="' + FILL_NAMES[fill.Style] + '"';
       AppendToStream(AStream, INDENT3 +
-        '<Interior ' + s + '/>')
+        '<Interior ' + s + '/>' + LF)
     end;
 
     // Borders