From 18afbfdd84b5a28eecfa36e7ef7a907c692ec01a Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Mon, 15 Jul 2019 21:00:47 +0000 Subject: [PATCH] fpspreadsheet: Excel2003/XML reader supports formulas now. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7038 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../read_write/excelxmldemo/excelxmlwrite.lpr | 2 +- .../source/common/fpspreadsheet.pas | 16 ++-- .../fpspreadsheet/source/common/fpstypes.pas | 3 +- .../fpspreadsheet/source/common/fpsutils.pas | 41 +++++++++ .../fpspreadsheet/source/common/xlsxml.pas | 84 ++++++++++++------- .../fpspreadsheet/tests/spreadtestgui.lpi | 6 +- 6 files changed, 113 insertions(+), 39 deletions(-) diff --git a/components/fpspreadsheet/examples/read_write/excelxmldemo/excelxmlwrite.lpr b/components/fpspreadsheet/examples/read_write/excelxmldemo/excelxmlwrite.lpr index 2605e4ec9..43a397564 100644 --- a/components/fpspreadsheet/examples/read_write/excelxmldemo/excelxmlwrite.lpr +++ b/components/fpspreadsheet/examples/read_write/excelxmldemo/excelxmlwrite.lpr @@ -45,7 +45,7 @@ begin MyWorkbook.SetDefaultFont('Calibri', 10); MyWorkbook.FormatSettings.CurrencyFormat := 2; MyWorkbook.FormatSettings.NegCurrFormat := 14; - MyWorkbook.Options := MyWorkbook.Options + [boCalcBeforeSaving]; + Myworkbook.Options := Myworkbook.Options + [boCalcBeforeSaving, boAutoCalc]; MyWorksheet := MyWorkbook.AddWorksheet(Str_Worksheet1); MyWorksheet.Options := MyWorksheet.Options - [soShowGridLines]; diff --git a/components/fpspreadsheet/source/common/fpspreadsheet.pas b/components/fpspreadsheet/source/common/fpspreadsheet.pas index ac238a2d3..74e96fc7c 100644 --- a/components/fpspreadsheet/source/common/fpspreadsheet.pas +++ b/components/fpspreadsheet/source/common/fpspreadsheet.pas @@ -236,9 +236,9 @@ type procedure WriteErrorValue(ACell: PCell; AValue: TsErrorValue); overload; function WriteFormula(ARow, ACol: Cardinal; AFormula: String; - ALocalized: Boolean = false): PCell; overload; + ALocalized: Boolean = false; R1C1Mode: Boolean = false): PCell; overload; procedure WriteFormula(ACell: PCell; AFormula: String; - ALocalized: Boolean = false); overload; + ALocalized: Boolean = false; R1C1Mode: Boolean = false); overload; function WriteNumber(ARow, ACol: Cardinal; ANumber: double): PCell; overload; procedure WriteNumber(ACell: PCell; ANumber: Double); overload; @@ -5838,13 +5838,16 @@ end; @param ALocalized If true, the formula is expected to have decimal and list separators of the workbook's FormatSettings. Otherwise uses dot and comma, respectively. + @param R1C1Mode If true, the formula is expected to contain cell references + in Excel's "R1C1" notation; otherwise "A1" references are + expected. @return Pointer to the cell -------------------------------------------------------------------------------} function TsWorksheet.WriteFormula(ARow, ACol: Cardinal; AFormula: String; - ALocalized: Boolean = false): PCell; + ALocalized: Boolean = false; R1C1Mode: Boolean = false): PCell; begin Result := GetCell(ARow, ACol); - WriteFormula(Result, AFormula, ALocalized); + WriteFormula(Result, AFormula, ALocalized, R1C1Mode); end; {@@ ---------------------------------------------------------------------------- @@ -5859,7 +5862,7 @@ end; uses dot and comma, respectively. -------------------------------------------------------------------------------} procedure TsWorksheet.WriteFormula(ACell: PCell; AFormula: String; - ALocalized: Boolean = false); + ALocalized: Boolean = false; R1C1Mode: Boolean = false); var parser: TsExpressionParser = nil; formula: PsFormula; @@ -5886,6 +5889,9 @@ begin try if ALocalized then parser.LocalizedExpression[Workbook.FormatSettings] := AFormula + else + if R1C1Mode then + parser.R1C1Expression[ACell] := AFormula else parser.Expression := AFormula; AFormula := parser.Expression; diff --git a/components/fpspreadsheet/source/common/fpstypes.pas b/components/fpspreadsheet/source/common/fpstypes.pas index 2e53a722b..b8a96e6db 100644 --- a/components/fpspreadsheet/source/common/fpstypes.pas +++ b/components/fpspreadsheet/source/common/fpstypes.pas @@ -592,8 +592,7 @@ type TsCalcState = (csNotCalculated, csCalculating, csCalculated); {@@ Cell flag } - TsCellFlag = ({cfCalculating, cfCalculated, }cfHasComment, cfHyperlink, cfMerged, - cfHasFormula, cf3dFormula); + TsCellFlag = (cfHasComment, cfHyperlink, cfMerged, cfHasFormula, cf3dFormula); {@@ Set of cell flags } TsCellFlags = set of TsCellFlag; diff --git a/components/fpspreadsheet/source/common/fpsutils.pas b/components/fpspreadsheet/source/common/fpsutils.pas index ca3bb78ba..069ea0f1f 100644 --- a/components/fpspreadsheet/source/common/fpsutils.pas +++ b/components/fpspreadsheet/source/common/fpsutils.pas @@ -102,6 +102,9 @@ function ParseCellString_R1C1(const AStr: String; ABaseRow, ABaseCol: Cardinal; out ACellRow, ACellCol: Cardinal; out AFlags: TsRelFlags): Boolean; overload; function ParseCellString_R1C1(const AStr: string; ABaseRow, ABaseCol: Cardinal; out ACellRow, ACellCol: Cardinal): Boolean; overload; +function ParseCellRangeString_R1C1(const AStr: String; ABaseRow, ABaseCol: Cardinal; + out ASheet1, ASheet2: String; out ARow1, ACol1, ARow2, ACol2: Cardinal; + out AFlags: TsRelFlags): Boolean; overload; function GetCellString_R1C1(ARow, ACol: Cardinal; AFlags: TsRelFlags = [rfRelRow, rfRelCol]; ARefRow: Cardinal = Cardinal(-1); ARefCol: Cardinal = Cardinal(-1)): String; overload; @@ -813,6 +816,44 @@ begin ACellRow, ACellCol, flags); end; +{@@ ---------------------------------------------------------------------------- + Parses a 3D cell and sheet range string in Excel R1C1 dialect. Returns the + names of the limiting sheets and the indexes of the limiting borders. + The function result is false if the provided string is not valid. +-------------------------------------------------------------------------------} +function ParseCellRangeString_R1C1(const AStr: String; ABaseRow, ABaseCol: Cardinal; + out ASheet1, ASheet2: String; out ARow1, ACol1, ARow2, ACol2: Cardinal; + out AFlags: TsRelFlags): Boolean; +var + s1, s2: string; + p: Integer; +begin + p := pos('!', AStr); + if p = 0 then begin + ASheet1 := ''; + ASheet2 := ''; + s2 := AStr; + end else begin + s1 := Copy(AStr, 1, p-1); + s2 := Copy(AStr, p+1, MaxInt); + p := pos(':', s1); + if p = 0 then + ASheet1 := UnquoteStr(s1) + else begin + ASheet1 := UnquoteStr(copy(s1, 1, p-1)); + ASheet2 := UnquoteStr(copy(s1, p+1, MaxInt)); + end; + end; + + p := pos(':', s2); + if p = 0 then begin + ARow2 := Cardinal(-1); + ACol2 := Cardinal(-1); + Result := ParseCellString_R1C1(s2, ABAseRow, ABaseCol, ARow1, ACol1, AFlags); + end else + Result := ParseCellRangeString_R1C1(s2, ABAseRow, ABaseCol, ARow1, ACol1, ARow2, ACol2, AFlags); +end; + {@@ ---------------------------------------------------------------------------- Parses a cell string, like 'A1' into zero-based column and row numbers diff --git a/components/fpspreadsheet/source/common/xlsxml.pas b/components/fpspreadsheet/source/common/xlsxml.pas index ff134b081..dc19fb6e2 100644 --- a/components/fpspreadsheet/source/common/xlsxml.pas +++ b/components/fpspreadsheet/source/common/xlsxml.pas @@ -124,7 +124,8 @@ implementation uses StrUtils, DateUtils, Math, - fpsStrings, fpsClasses, fpspreadsheet, fpsUtils, fpsNumFormat, fpsHTMLUtils; + fpsStrings, fpsClasses, fpspreadsheet, fpsUtils, fpsNumFormat, fpsHTMLUtils, + fpsExprParser; const FMT_OFFSET = 61; @@ -402,6 +403,7 @@ end; procedure TsSpreadExcelXMLReader.ReadCell(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ARow, ACol: Integer); var + book: TsWorkbook; sheet: TsWorksheet absolute AWorksheet; nodeName: string; s, st, sv: String; @@ -419,13 +421,14 @@ begin raise Exception.Create('[ReadCell] Only "Cell" nodes expected.'); cell := sheet.GetCell(ARow, ACol); + book := TsWorkbook(FWorkbook); s := GetAttrValue(ANode, 'ss:StyleID'); if s <> '' then begin idx := FCellFormatList.FindIndexOfName(s); if idx <> -1 then begin fmt := FCellFormatList.Items[idx]^; - cell^.FormatIndex := TsWorkbook(FWorkbook).AddCellFormat(fmt); + cell^.FormatIndex := book.AddCellFormat(fmt); end; end; @@ -437,6 +440,23 @@ begin if (mergedCols > 0) or (mergedRows > 0) then sheet.MergeCells(ARow, ACol, ARow + mergedRows, ACol + mergedCols); + // Formula + s := GetAttrValue(ANode, 'ss:Formula'); + if s <> '' then begin + try + sheet.WriteFormula(cell, s, false, true); + except + on E:EExprParser do begin + FWorkbook.AddErrorMsg(E.Message); + if (boAbortReadOnFormulaError in FWorkbook.Options) then raise; + end; + on E:ECalcEngine do begin + FWorkbook.AddErrorMsg(E.Message); + if (boAbortReadOnFormulaError in FWorkbook.Options) then raise; + end; + end; + end; + // Hyperlink s := GetAttrValue(ANode, 'ss:HRef'); if s <> '' then begin @@ -448,34 +468,40 @@ begin node := ANode.FirstChild; if node = nil then sheet.WriteBlank(cell) - else - while node <> nil do begin - nodeName := node.NodeName; - if (nodeName = 'Data') or (nodeName = 'ss:Data') then begin - sv := node.TextContent; - st := GetAttrValue(node, 'ss:Type'); - case st of - 'String': - sheet.WriteText(cell, sv); - 'Number': - sheet.WriteNumber(cell, StrToFloat(sv, FPointSeparatorSettings)); - 'DateTime': - sheet.WriteDateTime(cell, ExtractDateTime(sv)); - 'Boolean': - if sv = '1' then - sheet.WriteBoolValue(cell, true) - else if sv = '0' then - sheet.WriteBoolValue(cell, false); - 'Error': - if TryStrToErrorValue(sv, err) then - sheet.WriteErrorValue(cell, err); - end; - end - else - if (nodeName = 'Comment') then - ReadComment(node, AWorksheet, cell); - node := node.NextSibling; + else begin + book.LockFormulas; // Protect formulas from being deleted by the WriteXXXX calls + try + while node <> nil do begin + nodeName := node.NodeName; + if (nodeName = 'Data') or (nodeName = 'ss:Data') then begin + sv := node.TextContent; + st := GetAttrValue(node, 'ss:Type'); + case st of + 'String': + sheet.WriteText(cell, sv); + 'Number': + sheet.WriteNumber(cell, StrToFloat(sv, FPointSeparatorSettings)); + 'DateTime': + sheet.WriteDateTime(cell, ExtractDateTime(sv)); + 'Boolean': + if sv = '1' then + sheet.WriteBoolValue(cell, true) + else if sv = '0' then + sheet.WriteBoolValue(cell, false); + 'Error': + if TryStrToErrorValue(sv, err) then + sheet.WriteErrorValue(cell, err); + end; + end + else + if (nodeName = 'Comment') then + ReadComment(node, AWorksheet, cell); + node := node.NextSibling; + end; + finally + book.UnlockFormulas; end; + end; end; {@@ ---------------------------------------------------------------------------- diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpi b/components/fpspreadsheet/tests/spreadtestgui.lpi index a18bc55e4..51cf94d25 100644 --- a/components/fpspreadsheet/tests/spreadtestgui.lpi +++ b/components/fpspreadsheet/tests/spreadtestgui.lpi @@ -1,11 +1,13 @@ - + + + + - <ResourceType Value="res"/> </General>