From 5d496d9cf4911be38b771998c7e573204ee13f64 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Tue, 2 Sep 2014 09:25:54 +0000 Subject: [PATCH] fpspreadsheet: Fix formula issues with ods (written error values still different between fps and ods). git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3512 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/fpspreadsheet/fpsexprparser.pas | 31 ++- components/fpspreadsheet/fpsopendocument.pas | 255 +++++++++--------- components/fpspreadsheet/fpspreadsheet.pas | 17 ++ components/fpspreadsheet/fpsutils.pas | 2 + .../fpspreadsheet/tests/formulatests.pas | 16 +- 5 files changed, 188 insertions(+), 133 deletions(-) diff --git a/components/fpspreadsheet/fpsexprparser.pas b/components/fpspreadsheet/fpsexprparser.pas index 4244822a4..9b7afa542 100644 --- a/components/fpspreadsheet/fpsexprparser.pas +++ b/components/fpspreadsheet/fpsexprparser.pas @@ -715,6 +715,7 @@ type procedure CheckResultType(const Res: TsExpressionResult; AType: TsResultType); inline; function CurrentToken: String; + function CurrentOrEOFToken: String; function GetToken: TsTokenType; function Level1: TsExprNode; function Level2: TsExprNode; @@ -1067,8 +1068,8 @@ begin 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!) + C := NextPos; + 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 @@ -1312,6 +1313,14 @@ begin Result := FScanner.Token; end; +function TsExpressionParser.CurrentOrEOFToken: String; +begin + if (FScanner.TokenType = ttEOF) or (FScanner.Token = '') then + Result := 'end of formula' + else + Result := FScanner.Token; +end; + function TsExpressionParser.Evaluate: TsExpressionResult; begin EvaluateExpression(Result); @@ -1559,6 +1568,7 @@ function TsExpressionParser.Level6: TsExprNode; var tt: TsTokenType; Right: TsExprNode; + currToken: String; begin {$ifdef debugexpr} Writeln('Level 6 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr} if (TokenType = ttLeft) then @@ -1566,8 +1576,11 @@ begin GetToken; Result := TsParenthesisExprNode.Create(self, Level1); try - if (TokenType <> ttRight) then - ParserError(Format(SErrBracketExpected, [SCanner.Pos, CurrentToken])); + if (TokenType <> ttRight) then begin + currToken := CurrentToken; + if TokenType = ttEOF then currToken := 'end of formula'; + ParserError(Format(SErrBracketExpected, [SCanner.Pos, currToken])); + end; GetToken; except Result.Free; @@ -1675,10 +1688,10 @@ begin begin GetToken; if (TokenType <> ttLeft) then - ParserError(Format(SErrLeftBracketExpected, [Scanner.Pos, CurrentToken])); + ParserError(Format(SErrLeftBracketExpected, [Scanner.Pos, CurrentOrEOFToken])); GetToken; if (TokenType <> ttRight) then - ParserError(Format(SErrBracketExpected, [Scanner.Pos, CurrentToken])); + ParserError(Format(SErrBracketExpected, [Scanner.Pos, CurrentOrEOFToken])); SetLength(Args, 0); end; end @@ -1691,7 +1704,7 @@ begin begin GetToken; if (TokenType <> ttLeft) then - ParserError(Format(SErrLeftBracketExpected, [Scanner.Pos, CurrentToken])); + ParserError(Format(SErrLeftBracketExpected, [Scanner.Pos, CurrentOrEofToken])); SetLength(Args, abs(lCount)); AI := 0; try @@ -1710,11 +1723,11 @@ begin begin if (TokenType <> ttListSep) then if (AI < abs(lCount)) then - ParserError(Format(SErrCommaExpected, [Scanner.Pos, CurrentToken])) + ParserError(Format(SErrCommaExpected, [Scanner.Pos, CurrentOrEofToken])) end; until (AI = lCount) or (((lCount < 0) or optional) and (TokenType = ttRight)); if TokenType <> ttRight then - ParserError(Format(SErrBracketExpected, [Scanner.Pos, CurrentToken])); + ParserError(Format(SErrBracketExpected, [Scanner.Pos, CurrentOrEofToken])); if AI < abs(lCount) then SetLength(Args, AI); except diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index 8a1e7b716..9d00327b6 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -1082,6 +1082,29 @@ begin FColumnStyleList.Add(colStyle); end; +procedure TsSpreadOpenDocReader.ReadDateTime(ARow: Word; ACol: Word; + ACellNode : TDOMNode); +var + dt: TDateTime; + styleName: String; + cell: PCell; +begin + if FIsVirtualMode then begin + InitCell(ARow, ACol, FVirtualCell); + cell := @FVirtualCell; + end else + cell := FWorksheet.GetCell(ARow, ACol); + + styleName := GetAttrValue(ACellNode, 'table:style-name'); + ApplyStyleToCell(cell, stylename); + + dt := ExtractDateTimeFromNode(ACellNode, cell^.NumberFormat, cell^.NumberFormatStr); + FWorkSheet.WriteDateTime(cell, dt, cell^.NumberFormat, cell^.NumberFormatStr); + + if FIsVirtualMode then + Workbook.OnReadCellData(Workbook, ARow, ACol, cell); +end; + procedure TsSpreadOpenDocReader.ReadDateMode(SpreadSheetNode: TDOMNode); var CalcSettingsNode, NullDateNode: TDOMNode; @@ -1160,6 +1183,96 @@ begin end; end; +procedure TsSpreadOpenDocReader.ReadFormula(ARow: Word; ACol : Word; ACellNode : TDOMNode); +var + cell: PCell; + formula: String; + stylename: String; + floatValue: Double; + valueType: String; + valueStr: String; + node: TDOMNode; + parser: TsSpreadsheetParser; + p: Integer; +begin + // Create cell and apply format + if FIsVirtualMode then + begin + InitCell(ARow, ACol, FVirtualCell); + cell := @FVirtualCell; + end else + cell := FWorksheet.GetCell(ARow, ACol); + + styleName := GetAttrValue(ACellNode, 'table:style-name'); + ApplyStyleToCell(cell, stylename); + + 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.LocalizedExpression[FPointSeparatorSettings] := 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 + valueType := GetAttrValue(ACellNode, 'office:value-type'); + valueStr := GetAttrValue(ACellNode, 'office:value'); + if (valueType = 'float') then begin + if UpperCase(valueStr) = '1.#INF' then + FWorksheet.WriteNumber(cell, 1.0/0.0) + else begin + floatValue := StrToFloat(valueStr, FPointSeparatorSettings); + FWorksheet.WriteNumber(cell, floatValue); + end; + if IsDateTimeFormat(cell^.NumberFormat) then begin + cell^.ContentType := cctDateTime; + // No datemode correction for intervals and for time-only values + if (cell^.NumberFormat = nfTimeInterval) or (cell^.NumberValue < 1) then + cell^.DateTimeValue := cell^.NumberValue + else + case FDateMode of + dm1899: cell^.DateTimeValue := cell^.NumberValue + DATEMODE_1899_BASE; + dm1900: cell^.DateTimeValue := cell^.NumberValue + DATEMODE_1900_BASE; + dm1904: cell^.DateTimeValue := cell^.NumberValue + DATEMODE_1904_BASE; + end; + end; + end else + // Date/time value + if (valueType = 'date') or (valueType = 'time') then begin + floatValue := ExtractDateTimeFromNode(ACellNode, cell^.NumberFormat, cell^.NumberFormatStr); + FWorkSheet.WriteDateTime(cell, floatValue); + end else + // text + if (valueType = 'string') then begin + node := ACellNode.FindNode('text:p'); + if (node <> nil) and (node.FirstChild <> nil) then begin + valueStr := node.FirstChild.Nodevalue; + FWorksheet.WriteUTF8Text(cell, valueStr); + end; + end else + // Text + FWorksheet.WriteUTF8Text(cell, valueStr); + + if FIsVirtualMode then + Workbook.OnReadCellData(Workbook, ARow, ACol, cell); +end; + procedure TsSpreadOpenDocReader.ReadFromFile(AFileName: string; AData: TsWorkbook); var Doc : TXMLDocument; @@ -1249,96 +1362,6 @@ begin end; end; -procedure TsSpreadOpenDocReader.ReadFormula(ARow: Word; ACol : Word; ACellNode : TDOMNode); -var - cell: PCell; - formula: String; - stylename: String; - floatValue: Double; - valueType: String; - valueStr: String; - node: TDOMNode; - parser: TsSpreadsheetParser; - p: Integer; -begin - // Create cell and apply format - if FIsVirtualMode then - begin - InitCell(ARow, ACol, FVirtualCell); - cell := @FVirtualCell; - end else - cell := FWorksheet.GetCell(ARow, ACol); - - styleName := GetAttrValue(ACellNode, 'table:style-name'); - ApplyStyleToCell(cell, stylename); - - 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 - valueType := GetAttrValue(ACellNode, 'office:value-type'); - valueStr := GetAttrValue(ACellNode, 'office:value'); - if (valueType = 'float') then begin - if UpperCase(valueStr) = '1.#INF' then - FWorksheet.WriteNumber(cell, 1.0/0.0) - else begin - floatValue := StrToFloat(valueStr, FPointSeparatorSettings); - FWorksheet.WriteNumber(cell, floatValue); - end; - if IsDateTimeFormat(cell^.NumberFormat) then begin - cell^.ContentType := cctDateTime; - // No datemode correction for intervals and for time-only values - if (cell^.NumberFormat = nfTimeInterval) or (cell^.NumberValue < 1) then - cell^.DateTimeValue := cell^.NumberValue - else - case FDateMode of - dm1899: cell^.DateTimeValue := cell^.NumberValue + DATEMODE_1899_BASE; - dm1900: cell^.DateTimeValue := cell^.NumberValue + DATEMODE_1900_BASE; - dm1904: cell^.DateTimeValue := cell^.NumberValue + DATEMODE_1904_BASE; - end; - end; - end else - // Date/time value - if (valueType = 'date') or (valueType = 'time') then begin - floatValue := ExtractDateTimeFromNode(ACellNode, cell^.NumberFormat, cell^.NumberFormatStr); - FWorkSheet.WriteDateTime(cell, floatValue); - end else - // text - if (valueType = 'string') then begin - node := ACellNode.FindNode('text:p'); - if (node <> nil) and (node.FirstChild <> nil) then begin - valueStr := node.FirstChild.Nodevalue; - FWorksheet.WriteUTF8Text(cell, valueStr); - end; - end else - // Text - FWorksheet.WriteUTF8Text(cell, valueStr); - - if FIsVirtualMode then - Workbook.OnReadCellData(Workbook, ARow, ACol, cell); -end; - procedure TsSpreadOpenDocReader.ReadLabel(ARow: Word; ACol: Word; ACellNode: TDOMNode); var cellText: String; @@ -1424,29 +1447,6 @@ begin Workbook.OnReadCellData(Workbook, ARow, ACol, cell); end; -procedure TsSpreadOpenDocReader.ReadDateTime(ARow: Word; ACol: Word; - ACellNode : TDOMNode); -var - dt: TDateTime; - styleName: String; - cell: PCell; -begin - if FIsVirtualMode then begin - InitCell(ARow, ACol, FVirtualCell); - cell := @FVirtualCell; - end else - cell := FWorksheet.GetCell(ARow, ACol); - - styleName := GetAttrValue(ACellNode, 'table:style-name'); - ApplyStyleToCell(cell, stylename); - - dt := ExtractDateTimeFromNode(ACellNode, cell^.NumberFormat, cell^.NumberFormatStr); - FWorkSheet.WriteDateTime(cell, dt, cell^.NumberFormat, cell^.NumberFormatStr); - - if FIsVirtualMode then - Workbook.OnReadCellData(Workbook, ARow, ACol, cell); -end; - procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode); procedure ReadStyleMap(ANode: TDOMNode; var ANumFormat: TsNumberFormat; @@ -3627,27 +3627,36 @@ begin cctNumber: begin valuetype := 'float'; - value := FormatFloat('%g', ACell^.NumberValue, FPointSeparatorSettings); + value := 'office:value="' + Format('%g', [ACell^.NumberValue], FPointSeparatorSettings) + '"'; end; cctDateTime: + if trunc(ACell^.DateTimeValue) = 0 then begin - valuetype := 'float'; - value := FormatFloat('%g', ACell^.DateTimeValue, FPointSeparatorSettings); + valuetype := 'time'; + value := 'office:time-value="' + FormatDateTime(ISO8601FormatTimeOnly, ACell^.DateTimeValue) + '"'; + end + else + begin + valuetype := 'date'; + if frac(ACell^.DateTimeValue) = 0.0 then + value := 'office:date-value="' + FormatDateTime(ISO8601FormatDateOnly, ACell^.DateTimeValue) + '"' + else + value := 'office:date-value="' + FormatDateTime(ISO8601FormatExtended, ACell^.DateTimeValue) + '"'; end; cctUTF8String: begin valuetype := 'string'; - value := ACell^.UTF8StringValue; + value := 'office:string-value="' + ACell^.UTF8StringValue +'"'; end; cctBool: begin valuetype := 'boolean'; - value := BoolToStr(ACell^.BoolValue, 'true', 'false'); + value := 'office:boolean-value="' + BoolToStr(ACell^.BoolValue, 'true', 'false') + '"'; end; cctError: begin valuetype := 'error'; - value := GetErrorValueStr(ACell^.ErrorValue); + value := 'office:value="' + GetErrorValueStr(ACell^.ErrorValue) + '"'; end; end; @@ -3658,11 +3667,11 @@ begin data type. Seems to work... } if ACell^.CalcState=csCalculated then AppendToStream(AStream, Format( - '' + - '%s'+ + '' + + // '%s'+ '', [ - formula, valuetype, value, lStyle, - value + formula, valuetype, value, lStyle + //value ])) else AppendToStream(AStream, Format( diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 11dd116a3..8900e6db2 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -2490,9 +2490,19 @@ function TsWorksheet.ReadAsUTF8Text(ACell: PCell): ansistring; Result := ''; if not IsNaN(Value) then begin + if (ANumberFormat = nfGeneral) then + begin + if frac(Value) = 0 then // date only + ANumberFormatStr := Workbook.FormatSettings.ShortDateFormat + else if trunc(Value) = 0 then // time only + ANumberFormatStr := Workbook.FormatSettings.LongTimeFormat + else + ANumberFormatStr := 'cc' + end else if ANumberFormatStr = '' then ANumberFormatStr := BuildDateTimeFormatString(ANumberFormat, Workbook.FormatSettings, ANumberFormatStr); + // Saw strange cases in ods where date/time formats contained pos/neg/zero parts. // Split to be on the safe side. SplitFormatString(ANumberFormatStr, fmtp, fmtn, fmt0); @@ -3307,6 +3317,13 @@ begin // To make sure it gets saved correctly, set a date format (instead of General). // The user can choose another date format if he wants to + if AFormat = nfGeneral then begin + if trunc(AValue) = 0 then // time only + AFormat := nfLongTime + else if frac(AValue) = 0.0 then // date only + AFormat := nfShortDate; + end; + if AFormatStr = '' then AFormatStr := BuildDateTimeFormatString(AFormat, Workbook.FormatSettings, AFormatStr) else diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index 5613b2ba8..397658b14 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/components/fpspreadsheet/fpsutils.pas @@ -41,6 +41,8 @@ const ISO8601Format='yyyymmdd"T"hhmmss'; {@@ Extended ISO 8601 date/time format, used in e.g. ODF/opendocument } ISO8601FormatExtended='yyyy"-"mm"-"dd"T"hh":"mm":"ss'; + {@@ ISO 8601 date-only format, used in ODF/opendocument } + ISO8601FormatDateOnly='yyyy"-"mm"-"dd'; {@@ ISO 8601 time-only format, used in ODF/opendocument } ISO8601FormatTimeOnly='"PT"hh"H"nn"M"ss"S"'; {@@ ISO 8601 time-only format, with hours overflow } diff --git a/components/fpspreadsheet/tests/formulatests.pas b/components/fpspreadsheet/tests/formulatests.pas index f0b130e20..d065ad8d0 100644 --- a/components/fpspreadsheet/tests/formulatests.pas +++ b/components/fpspreadsheet/tests/formulatests.pas @@ -59,6 +59,8 @@ type procedure Test_Write_Read_CalcRPNFormula_BIFF8; { OOXML Tests } procedure Test_Write_Read_CalcRPNFormula_OOXML; + { ODSL Tests } + procedure Test_Write_Read_CalcRPNFormula_ODS; // Writes out and calculates string formulas, read back { BIFF2 Tests } @@ -69,6 +71,8 @@ type procedure Test_Write_Read_CalcStringFormula_BIFF8; { OOXML Tests } procedure Test_Write_Read_CalcStringFormula_OOXML; + { ODS Tests } + procedure Test_Write_Read_CalcStringFormula_ODS; end; implementation @@ -189,7 +193,7 @@ end; procedure TSpreadWriteReadFormulaTests.Test_Write_Read_FormulaStrings_ODS; begin - //TestWriteReadFormulaStrings(sfOpenDocument, true); + TestWriteReadFormulaStrings(sfOpenDocument, true); end; @@ -357,6 +361,11 @@ begin TestCalcFormulas(sfOOXML, true); end; +procedure TSpreadWriteReadFormulaTests.Test_Write_Read_CalcRPNFormula_ODS; +begin + TestCalcFormulas(sfOpenDocument, true); +end; + procedure TSpreadWriteReadFormulaTests.Test_Write_Read_CalcStringFormula_BIFF2; begin TestCalcFormulas(sfExcel2, false); @@ -377,6 +386,11 @@ begin TestCalcFormulas(sfOOXML, false); end; +procedure TSpreadWriteReadFormulaTests.Test_Write_Read_CalcStringFormula_ODS; +begin + TestCalcFormulas(sfOpenDocument, false); +end; + initialization // Register so these tests are included in a full run