From 68d15c38a9ad25c1d4d1c07f65d1795c39e3cfc1 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Tue, 4 Aug 2015 17:01:40 +0000 Subject: [PATCH] fpspreadsheet: Reading/writing of error values for xlsx and ods (initial implementation was incomplete). git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4248 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/fpspreadsheet/fpsexprparser.pas | 6 +- components/fpspreadsheet/fpsopendocument.pas | 257 ++++++++++++++++--- components/fpspreadsheet/fpsutils.pas | 28 ++ components/fpspreadsheet/xlsxooxml.pas | 16 +- 4 files changed, 261 insertions(+), 46 deletions(-) diff --git a/components/fpspreadsheet/fpsexprparser.pas b/components/fpspreadsheet/fpsexprparser.pas index 9ae435f51..f0aa96cb7 100644 --- a/components/fpspreadsheet/fpsexprparser.pas +++ b/components/fpspreadsheet/fpsexprparser.pas @@ -1005,7 +1005,9 @@ var C: Char; begin C := CurrentChar; - while (not IsWordDelim(C)) and (C <> cNull) do + while (C in ['A', 'D', 'E', 'F', 'I', 'L', 'M', 'N', 'O', 'R', 'U', 'V', '0', '!', '?', '/', '#']) do +// while (C in ['D','I','V','/','0', 'N', 'U', 'L', 'V', 'A', 'E', 'R', 'F', 'M', '!', '?']) do +// while ((not IsWordDelim(C) or (C in ['/', '0', '!', '?'])) and (C <> cNull) do begin FToken := FToken + C; C := NextPos; @@ -2630,6 +2632,8 @@ begin err := errIllegalRef else if AVAlue = '#NAME?' then err := errWrongName + else if AValue = '#NUM!' then + err := errOverflow else if AValue = '#N/A' then err := errArgError else if AValue = '#FORMULA?' then diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index 4683403ca..b700c1712 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -91,23 +91,18 @@ type FHeaderFooterFontList: TObjectList; FActiveSheet: String; FDateMode: TDateMode; - // Applies internally stored column widths to current worksheet procedure ApplyColWidths; - // Applies a style to a cell function ApplyStyleToCell(ACell: PCell; AStyleName: String): Boolean; - // Extracts a boolean value from the xml node function ExtractBoolFromNode(ANode: TDOMNode): Boolean; - // Extracts the date/time value from the xml node function ExtractDateTimeFromNode(ANode: TDOMNode; ANumFormat: TsNumberFormat; const AFormatStr: String): TDateTime; - // Searches a column style by its column index or its name in the StyleList + function ExtractErrorFromNode(ANode: TDOMNode; out AErrorValue: TsErrorValue): Boolean; function FindColumnByCol(AColIndex: Integer): Integer; function FindColStyleByName(AStyleName: String): integer; function FindNumFormatByName(ANumFmtName: String): Integer; function FindRowStyleByName(AStyleName: String): Integer; procedure ReadColumns(ATableNode: TDOMNode); procedure ReadColumnStyle(AStyleNode: TDOMNode); - // Figures out the base year for times in this file (dates are unambiguous) procedure ReadDateMode(SpreadSheetNode: TDOMNode); function ReadFont(ANode: TDOMnode; APreferredIndex: Integer = -1): Integer; procedure ReadHeaderFooterFont(ANode: TDOMNode; var AFontName: String; @@ -131,6 +126,7 @@ type procedure ReadBoolean(ARow, ACol: Cardinal; ACellNode: TDOMNode); procedure ReadComment(ARow, ACol: Cardinal; ACellNode: TDOMNode); procedure ReadDateTime(ARow, ACol: Cardinal; ACellNode: TDOMNode); + procedure ReadError(ARow, ACol: Cardinal; ACellNode: TDOMNode); procedure ReadFormula(ARow, ACol: Cardinal; ACellNode: TDOMNode); reintroduce; procedure ReadLabel(ARow, ACol: Cardinal; ACellNode: TDOMNode); reintroduce; procedure ReadNumber(ARow, ACol: Cardinal; ACellNode: TDOMNode); reintroduce; @@ -1105,6 +1101,46 @@ begin end; end; +function TsSpreadOpenDocReader.ExtractErrorFromNode(ANode: TDOMNode; + out AErrorValue: TsErrorValue): Boolean; +var + s: String; +begin + s := GetAttrValue(ANode, 'table:formula'); + if s = '' then + begin + AErrorValue := errOK; + Result := true; + exit; + end; + if pos('of:', s) = 1 then Delete(s, 1, 3); + Delete(s, 1, 1); // Delete '=' + if s = '' then + begin + AErrorValue := errOK; + Result := true; + exit; + end; + + Result := TryStrToErrorValue(s, AErrorValue); + if not Result then + begin + s := ANode.NodeName; + ANode:= ANode.FirstChild; + while Assigned(ANode) do + begin + s := ANode.NodeName; + if s = 'text:p' then + begin + s := GetNodeValue(ANode); + Result := TryStrToErrorValue(s, AErrorValue); + exit; + end; + ANode := ANode.NextSibling; + end; + end; +end; + function TsSpreadOpenDocReader.FindColumnByCol(AColIndex: Integer): Integer; begin for Result := 0 to FColumnList.Count-1 do @@ -1637,6 +1673,31 @@ begin Workbook.OnReadCellData(Workbook, ARow, ACol, cell); end; +procedure TsSpreadOpenDocReader.ReadError(ARow, ACol: Cardinal; + ACellNode: TDOMNode); +var + styleName: String; + cell: PCell; + errValue: TsErrorValue; +begin + if FIsVirtualMode then + begin + InitCell(ARow, ACol, FVirtualCell); + cell := @FVirtualCell; + end else + cell := FWorksheet.AddCell(ARow, ACol); + + if ExtractErrorFromNode(ACellNode, errValue) then + FWorkSheet.WriteErrorValue(cell, errValue) else + FWorksheet.WriteUTF8Text(cell, 'ERROR'); + + styleName := GetAttrValue(ACellNode, 'table:style-name'); + ApplyStyleToCell(cell, stylename); + + if FIsVirtualMode then + Workbook.OnReadCellData(Workbook, ARow, ACol, cell); +end; + procedure TsSpreadOpenDocReader.ReadDateMode(SpreadSheetNode: TDOMNode); var CalcSettingsNode, NullDateNode: TDOMNode; @@ -1747,7 +1808,8 @@ var stylename: String; floatValue: Double; boolValue: Boolean; - valueType: String; + errorValue: TsErrorValue; + valueType, calcExtValueType: String; valueStr: String; node: TDOMNode; parser: TsSpreadsheetParser; @@ -1760,7 +1822,7 @@ begin InitCell(ARow, ACol, FVirtualCell); cell := @FVirtualCell; end else - cell := FWorksheet.AddCell(ARow, ACol); + cell := FWorksheet.GetCell(ARow, ACol); // Don't use AddCell here styleName := GetAttrValue(ACellNode, 'table:style-name'); ApplyStyleToCell(cell, stylename); @@ -1794,6 +1856,7 @@ begin // Read formula results valueType := GetAttrValue(ACellNode, 'office:value-type'); valueStr := GetAttrValue(ACellNode, 'office:value'); + calcExtValueType := GetAttrValue(ACellNode, 'calcext:value-type'); // ODS wants a 0 in the NumberValue field in case of an error. If there is // no error, this value will be corrected below. cell^.NumberValue := 0.0; @@ -1828,7 +1891,7 @@ begin FWorkSheet.WriteDateTime(cell, floatValue); end else // (c) text - if (valueType = 'string') then + if (valueType = 'string') and (calcextValueType <> 'error') then begin node := ACellNode.FindNode('text:p'); if (node <> nil) and (node.FirstChild <> nil) then @@ -1843,6 +1906,12 @@ begin boolValue := ExtractBoolFromNode(ACellNode); FWorksheet.WriteBoolValue(cell, boolValue); end else + if (calcextValuetype = 'error') then + begin + if ExtractErrorFromNode(ACellNode, errorValue) then + FWorksheet.WriteErrorValue(cell, errorValue) else + FWorksheet.WriteUTF8Text(cell, 'ERROR'); + end else // (e) Text if (valueStr <> '') then FWorksheet.WriteUTF8Text(cell, valueStr); @@ -2835,31 +2904,33 @@ begin paramFormula := GetAttrValue(CellNode, 'table:formula'); tableStyleName := GetAttrValue(CellNode, 'table:style-name'); - if paramValueType = 'string' then - ReadLabel(row, col, cellNode) - else - if (paramValueType = 'float') or (paramValueType = 'percentage') or - (paramValueType = 'currency') - then - ReadNumber(row, col, cellNode) - else if (paramValueType = 'date') or (paramValueType = 'time') then - ReadDateTime(row, col, cellNode) - else if (paramValueType = 'boolean') then - ReadBoolean(row, col, cellNode) - else if (paramValueType = '') and (tableStyleName <> '') then - ReadBlank(row, col, cellNode); - { NOTE: Empty cells having no cell format, but a column format only, - are skipped here. --> Currently the reader does not detect the format - of empty cells correctly. - It would work if the "(tableStyleName <> '')" would be omitted, but - then the reader would create a record for all 1E9 cells prepared by - the Excel2007 export --> crash! - The column format is available in the FColumnList, but since the usage - of colsSpanned in the row it is possible to miss the correct column format. - Pretty nasty situation! } - if ParamFormula <> '' then - ReadFormula(row, col, cellNode); + ReadFormula(row, col, cellNode) + else + begin + if paramValueType = 'string' then + ReadLabel(row, col, cellNode) + else + if (paramValueType = 'float') or (paramValueType = 'percentage') or + (paramValueType = 'currency') + then + ReadNumber(row, col, cellNode) + else if (paramValueType = 'date') or (paramValueType = 'time') then + ReadDateTime(row, col, cellNode) + else if (paramValueType = 'boolean') then + ReadBoolean(row, col, cellNode) + else if (paramValueType = '') and (tableStyleName <> '') then + ReadBlank(row, col, cellNode); + { NOTE: Empty cells having no cell format, but a column format only, + are skipped here. --> Currently the reader does not detect the format + of empty cells correctly. + It would work if the "(tableStyleName <> '')" would be omitted, but + then the reader would create a record for all 1E9 cells prepared by + the Excel2007 export --> crash! + The column format is available in the FColumnList, but since the usage + of colsSpanned in the row it is possible to miss the correct column format. + Pretty nasty situation! } + end; // Read cell comment ReadComment(row, col, cellNode); @@ -2917,6 +2988,9 @@ begin rowNode := rowNode.NextSibling; end; // while Assigned(rowNode) + + cell := FWorksheet.FindCell(2, 1); + end; procedure TsSpreadOpenDocReader.ReadRowStyle(AStyleNode: TDOMNode); @@ -3821,6 +3895,48 @@ begin AppendToStream(FSContent, XML_HEADER); AppendToStream(FSContent, + '' + + '' + ); + +{ '' + ''); - +} // Fonts AppendToStream(FSContent, ''); @@ -4797,11 +4913,68 @@ end; procedure TsSpreadOpenDocWriter.WriteError(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TsErrorValue; ACell: PCell); +var + fmt: PsCellFormat; + lStyle: String; + comment: String; + rowsSpannedStr, colsSpannedStr: String; + spannedStr: String; + valueStr: String; + r1,c1,r2,c2: Cardinal; begin - Unused(AStream); Unused(ARow, ACol); - Unused(AValue, ACell); - // ?? + + fmt := FWorkbook.GetPointerToCellFormat(ACell^.FormatIndex); + if fmt^.UsedFormattingFields <> [] then + lStyle := ' table:style-name="ce' + IntToStr(ACell^.FormatIndex) + '" ' + else + lStyle := ''; + + // Comment + comment := WriteCommentXMLAsString(FWorksheet.ReadComment(ACell)); + + // Merged? + if FWorksheet.IsMergeBase(ACell) then + begin + FWorksheet.FindMergedRange(ACell, r1, c1, r2, c2); + rowsSpannedStr := Format(' table:number-rows-spanned="%d"', [r2 - r1 + 1]); + colsSpannedStr := Format(' table:number-columns-spanned="%d"', [c2 - c1 + 1]); + spannedStr := colsSpannedStr + rowsSpannedStr; + end else + spannedStr := ''; + + // Displayed value + valueStr := GetErrorValueStr(ACell^.ErrorValue); + + // Hyperlink + if FWorksheet.HasHyperlink(ACell) then + FWorkbook.AddErrorMsg(rsODSHyperlinksOfTextCellsOnly, [GetCellString(ARow, ACol)]); + + // Write to stream + AppendToStream(AStream, Format( + ''+ + 'office:string-value="" calcext:value-type="error">' + + comment + + '%s' + + '', [ + valueStr, lStyle, spannedStr, + valueStr + ])); + (* + + #NV + + + AppendToStream(AStream, Format( + '' + + comment + + '%s' + + '', [ + valType, StrValue, lStyle, spannedStr, + DisplayStr + ])); + *) end; function TsSpreadOpenDocWriter.WriteFontStyleXMLAsString(AFont: TsFont): String; @@ -5413,11 +5586,15 @@ begin value := ' office:boolean-value="' + BoolToStr(ACell^.BoolValue, 'true', 'false') + '"'; end; cctError: + if HasFormula(ACell) then begin - // Strange: but in case of an error, Open/LibreOffice always writes a - // float value 0 to the cell - valuetype := 'float'; + // Open/LibreOffice always writes a float value 0 to the cell + valuetype := 'float'; // error as result of a formula value := ' office:value="0"'; + end else + begin + valuetype := 'string" calcext:value-type="error'; // an error "constant" + value := ' office:value=""'; end; end; diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index f7775cf23..1ecb152d1 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/components/fpspreadsheet/fpsutils.pas @@ -86,6 +86,8 @@ function GetCellRangeString(ARange: TsCellRange; AFlags: TsRelFlags = rfAllRel; Compact: Boolean = false): String; overload; function GetErrorValueStr(AErrorValue: TsErrorValue): String; +function TryStrToErrorValue(AErrorStr: String; out AErr: TsErrorValue): boolean; + function GetFileFormatName(AFormat: TsSpreadsheetFormat): string; function GetFileFormatExt(AFormat: TsSpreadsheetFormat): String; function GetFormatFromFileName(const AFileName: TFileName; @@ -761,6 +763,32 @@ begin AFlags, Compact); end; +{@@ ---------------------------------------------------------------------------- + Returns the error value code from a string. Result is false, if the string does + not match one of the predefined error strings. + + @param AErrorStr Error string + @param AErr Corresponding error value code (type TsErrorValue) + @result TRUE if error code could be determined from the error string, + FALSE otherwise. +-------------------------------------------------------------------------------} +function TryStrToErrorValue(AErrorStr: String; out AErr: TsErrorValue): boolean; +begin + Result := true; + case AErrorStr of + '#NULL!' : AErr := errEmptyIntersection; + '#DIV/0!' : AErr := errDivideByZero; + '#VALUE!' : AErr := errWrongType; + '#REF!' : AErr := errIllegalRef; + '#NAME?' : AErr := errWrongName; + '#NUM!' : AErr := errOverflow; + '#N/A' : AErr := errArgError; + '#FORMULA?': AErr := errFormulaNotSupported; + '' : AErr := errOK; + else Result := false; + end; +end; + {@@ ---------------------------------------------------------------------------- Returns the message text assigned to an error value diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index 63e60836e..fe7196b96 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -3818,9 +3818,9 @@ var CellValueText: String; lStyleIndex: Integer; begin - CellPosText := TsWorksheet.CellPosToText(ARow, ACol); + CellPosText := GetCellString(ARow, ACol); lStyleIndex := GetStyleIndex(ACell); - if AValue then CellValueText := '1' else CellValueText := '0'; + CellValueText := StrUtils.IfThen(AValue, '1', '0'); AppendToStream(AStream, Format( '%s', [CellPosText, lStyleIndex, CellValueText])); end; @@ -3830,10 +3830,16 @@ end; -------------------------------------------------------------------------------} procedure TsSpreadOOXMLWriter.WriteError(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TsErrorValue; ACell: PCell); +var + CellPosText: String; + CellValueText: String; + lStyleIndex: Integer; begin - Unused(AStream); - Unused(ARow, ACol); - Unused(AValue, ACell); + CellPosText := TsWorksheet.CellPosToText(ARow, ACol); + lStyleIndex := GetStyleIndex(ACell); + CellValueText := GetErrorValueStr(ACell^.ErrorValue); + AppendToStream(AStream, Format( + '%s', [CellPosText, lStyleIndex, CellValueText])); end; {@@ ----------------------------------------------------------------------------