diff --git a/components/fpspreadsheet/fpsexprparser.pas b/components/fpspreadsheet/fpsexprparser.pas index faa2ef926..4244822a4 100644 --- a/components/fpspreadsheet/fpsexprparser.pas +++ b/components/fpspreadsheet/fpsexprparser.pas @@ -33,6 +33,9 @@ - add boolean constants "TRUE" and "FALSE". - add property RPNFormula to interface the parser to RPN formulas of xls files. - accept funtions with zero parameters + - generalize scanner and parser to allow localized decimal and list separators + - add to spreadsheet format to parser to take account of formula "dialect" + (see OpenDocument using [] around cell addresses) ******************************************************************************} @@ -87,6 +90,8 @@ type TsExpressionParser = class; TsBuiltInExpressionManager = class; + TsFormulaDialect = (fdExcel, fdOpenDocument); + TsResultType = (rtEmpty, rtBoolean, rtInteger, rtFloat, rtDateTime, rtString, rtCell, rtCellRange, rtError, rtAny); TsResultTypes = set of TsResultType; @@ -651,6 +656,7 @@ type function DoIdentifier: TsTokenType; function DoNumber: TsTokenType; function DoDelimiter: TsTokenType; + function DoSquareBracket: TsTokenType; function DoString: TsTokenType; function NextPos: Char; // inline; procedure SkipWhiteSpace; // inline; @@ -681,6 +687,7 @@ type FHashList: TFPHashObjectlist; FDirty: Boolean; FWorksheet: TsWorksheet; + FDialect: TsFormulaDialect; procedure CheckEOF; procedure CheckNodes(var ALeft, ARight: TsExprNode); function ConvertNode(Todo: TsExprNode; ToType: TsResultType): TsExprNode; @@ -743,6 +750,7 @@ type property Identifiers: TsExprIdentifierDefs read FIdentifiers write SetIdentifiers; property BuiltIns: TsBuiltInExprCategories read FBuiltIns write SetBuiltIns; property Worksheet: TsWorksheet read FWorksheet; + property Dialect: TsFormulaDialect read FDialect write FDialect; end; TsSpreadsheetParser = class(TsExpressionParser) @@ -855,6 +863,8 @@ resourcestring SErrCommaExpected = 'Expected comma (,) at position %d, but got %s'; SErrInvalidNumberChar = 'Unexpected character in number : %s'; SErrInvalidNumber = 'Invalid numerical value : %s'; + SErrInvalidCell = 'No valid cell address specification : %s'; + SErrInvalidCellRange = 'No valid cell range specification : %s'; SErrNoOperand = 'No operand for unary operation %s'; SErrNoLeftOperand = 'No left operand for binary operation %s'; SErrNoRightOperand = 'No left operand for binary operation %s'; @@ -1039,6 +1049,40 @@ begin Result := ttNumber; end; +{ Scans until closing square bracket is reached. In OpenDocument, this is + a cell or cell range identifier. } +function TsExpressionScanner.DoSquareBracket: TsTokenType; +var + C: Char; + p: Integer; + r1,c1,r2,c2: Cardinal; + flags: TsRelFlags; +begin + FToken := ''; + C := NextPos; + while (C <> ']') do + begin + if C = cNull then + ScanError(SErrUnexpectedEndOfExpression); + FToken := FToken + C; + C := NextPos; + end; + FToken := Copy(FToken, 2, Length(FToken) - 2); // Delete "[" and "]" + p := system.pos('.', FToken); // Delete up tp "." (--> to be considered later!) + if p <> 0 then Delete(FToken, 1, p); + if system.pos(':', FToken) > 0 then + begin + if ParseCellRangeString(FToken, r1, c1, r2, c2, flags) then + Result := ttCellRange + else + ScanError(Format(SErrInvalidCellRange, [FToken])); + end else + if ParseCellString(FToken, r1, c1, flags) then + Result := ttCell + else + ScanError(Format(SErrInvalidCell, [FToken])); +end; + function TsExpressionScanner.DoString: TsTokenType; function TerminatingChar(C: Char): boolean; @@ -1055,7 +1099,7 @@ begin C := NextPos; while not TerminatingChar(C) do begin - FToken := FToken+C; + FToken := FToken + C; if C = cDoubleQuote then NextPos; C := NextPos; @@ -1082,7 +1126,9 @@ begin FToken := ''; SkipWhiteSpace; C := FChar^; - if c = cNull then + if (FParser.Dialect = fdOpenDocument) and (C = '[') then + Result := DoSquareBracket + else if C = cNull then Result := ttEOF else if IsDelim(C) then Result := DoDelimiter @@ -1156,6 +1202,7 @@ end; constructor TsExpressionParser.Create(AWorksheet: TsWorksheet); begin inherited Create; + FDialect := fdExcel; FWorksheet := AWorksheet; FIdentifiers := TsExprIdentifierDefs.Create(TsExprIdentifierDef); FIdentifiers.FParser := Self; @@ -3723,6 +3770,8 @@ end; function TsCellExprNode.AsString: string; begin Result := GetCellString(FRow, FCol, FFlags); + if FParser.Dialect = fdOpenDocument then + Result := '[.' + Result + ']'; end; procedure TsCellExprNode.GetNodeValue(var Result: TsExpressionResult); diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index a01541409..8a1e7b716 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -193,7 +193,7 @@ type implementation uses - StrUtils, Variants, fpsStreams; + StrUtils, Variants, fpsStreams, fpsExprParser; const { OpenDocument general XML constants } @@ -685,6 +685,7 @@ begin inherited Create(AWorkbook); FPointSeparatorSettings := DefaultFormatSettings; FPointSeparatorSettings.DecimalSeparator := '.'; + FPointSeparatorSettings.ListSeparator := ';'; // for formulas FCellStyleList := TFPList.Create; FColumnStyleList := TFPList.Create; @@ -1257,10 +1258,12 @@ var valueType: String; valueStr: String; node: TDOMNode; + parser: TsSpreadsheetParser; + p: Integer; begin - // Create cell and apply format - if FIsVirtualMode then begin + if FIsVirtualMode then + begin InitCell(ARow, ACol, FVirtualCell); cell := @FVirtualCell; end else @@ -1269,10 +1272,28 @@ begin styleName := GetAttrValue(ACellNode, 'table:style-name'); ApplyStyleToCell(cell, stylename); - // Read formula, store in the cell's FormulaValue.FormulaStr - formula := GetAttrValue(ACellNode, 'table:formula'); - if formula <> '' then Delete(formula, 1, 3); // delete "of:" - cell^.FormulaValue := formula; + if (boReadFormulas in FWorkbook.Options) then begin + // Read formula, trim it, ... + formula := GetAttrValue(ACellNode, 'table:formula'); + if formula <> '' then + begin + // formulas written by Spread begin with 'of:=', our's with '=' --> remove that + p := pos('=', formula); + Delete(formula, 1, p); + end; + // ... convert to Excel dialect used by fps by defailt + parser := TsSpreadsheetParser.Create(FWorksheet); + try + parser.Dialect := fdOpenDocument; + parser.Expression := formula; + parser.Dialect := fdExcel; + formula := parser.Expression; + finally + parser.Free; + end; + // ... and store in cell's FormulaValue field. + cell^.FormulaValue := formula; + end; // Read formula results // ... number value @@ -2685,6 +2706,8 @@ end; procedure TsSpreadOpenDocWriter.WriteWorksheet(AStream: TStream; CurSheet: TsWorksheet); begin + FWorksheet := CurSheet; + // Header AppendToStream(AStream, ''); @@ -3069,6 +3092,7 @@ begin FPointSeparatorSettings := SysUtils.DefaultFormatSettings; FPointSeparatorSettings.DecimalSeparator:='.'; + FPointSeparatorSettings.ListSeparator := ';'; // for formulas // http://en.wikipedia.org/wiki/List_of_spreadsheet_software#Specifications FLimitations.MaxColCount := 1024; @@ -3576,6 +3600,10 @@ procedure TsSpreadOpenDocWriter.WriteFormula(AStream: TStream; const ARow, var lStyle: String = ''; lIndex: Integer; + parser: TsExpressionParser; + formula: String; + valuetype: String; + value: string; begin Unused(AStream, ARow, ACol); @@ -3585,15 +3613,65 @@ begin end else lStyle := ''; + // Convert string formula to the format needed by ods: semicolon list separators! + parser := TsSpreadsheetParser.Create(FWorksheet); + try + parser.Dialect := fdOpenDocument; + parser.Expression := ACell^.FormulaValue; + formula := Parser.LocalizedExpression[FPointSeparatorSettings]; + finally + parser.Free; + end; + + case ACell^.ContentType of + cctNumber: + begin + valuetype := 'float'; + value := FormatFloat('%g', ACell^.NumberValue, FPointSeparatorSettings); + end; + cctDateTime: + begin + valuetype := 'float'; + value := FormatFloat('%g', ACell^.DateTimeValue, FPointSeparatorSettings); + end; + cctUTF8String: + begin + valuetype := 'string'; + value := ACell^.UTF8StringValue; + end; + cctBool: + begin + valuetype := 'boolean'; + value := BoolToStr(ACell^.BoolValue, 'true', 'false'); + end; + cctError: + begin + valuetype := 'error'; + value := GetErrorValueStr(ACell^.ErrorValue); + end; + end; + + { Fix special xml characters } + formula := UTF8TextToXMLText(formula); + { We are writing a very rudimentary formula here without result and result data type. Seems to work... } - AppendToStream(AStream, Format( - '' + - '', [ - ACell^.FormulaValue, lStyle - ])); + if ACell^.CalcState=csCalculated then + AppendToStream(AStream, Format( + '' + + '%s'+ + '', [ + formula, valuetype, value, lStyle, + value + ])) + else + AppendToStream(AStream, Format( + '', [ + formula, lStyle + ])); end; + { Writes a cell with text content diff --git a/components/fpspreadsheet/tests/formulatests.pas b/components/fpspreadsheet/tests/formulatests.pas index 0e13ca03e..0beb83e57 100644 --- a/components/fpspreadsheet/tests/formulatests.pas +++ b/components/fpspreadsheet/tests/formulatests.pas @@ -47,6 +47,8 @@ type procedure Test_Write_Read_FormulaStrings_BIFF8; { OOXML Tests } procedure Test_Write_Read_FormulaStrings_OOXML; + { ODS Tests } + procedure Test_Write_Read_FormulaStrings_ODS; // Writes out and calculates rpn formulas, read back { BIFF2 Tests } @@ -185,6 +187,11 @@ begin TestWriteReadFormulaStrings(sfOOXML, true); end; +procedure TSpreadWriteReadFormulaTests.Test_Write_Read_FormulaStrings_ODS; +begin + TestWriteReadFormulaStrings(sfOpenDocument, true); +end; + { Test calculation of formulas } diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpi b/components/fpspreadsheet/tests/spreadtestgui.lpi index 251664efc..f32a86606 100644 --- a/components/fpspreadsheet/tests/spreadtestgui.lpi +++ b/components/fpspreadsheet/tests/spreadtestgui.lpi @@ -48,10 +48,12 @@ + + @@ -61,7 +63,6 @@ - @@ -71,6 +72,7 @@ + @@ -80,6 +82,7 @@ + @@ -96,7 +99,6 @@ - @@ -110,10 +112,12 @@ + +