pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Reading/writing of error values for xlsx and ods (initial implementation was incomplete).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4248 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-08-04 17:01:40 +00:00
parent 9af4fbd355
commit 68d15c38a9
4 changed files with 261 additions and 46 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
components/fpspreadsheet/fpsexprparser.pas
View File

@ -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

215
components/fpspreadsheet/fpsopendocument.pas
View File

@ -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,6 +2904,10 @@ begin
paramFormula := GetAttrValue(CellNode, 'table:formula');
tableStyleName := GetAttrValue(CellNode, 'table:style-name');
if ParamFormula <> '' then
ReadFormula(row, col, cellNode)
else
begin
if paramValueType = 'string' then
ReadLabel(row, col, cellNode)
else
@ -2857,9 +2930,7 @@ begin
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);
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,
'<office:document-content ' +
'xmlns:office="urn:oasis:names:tc:opendocument:xmlns:office:1.0" '+
'xmlns:style="urn:oasis:names:tc:opendocument:xmlns:style:1.0" '+
'xmlns:text="urn:oasis:names:tc:opendocument:xmlns:text:1.0" '+
'xmlns:table="urn:oasis:names:tc:opendocument:xmlns:table:1.0" '+
'xmlns:draw="urn:oasis:names:tc:opendocument:xmlns:drawing:1.0" '+
'xmlns:fo="urn:oasis:names:tc:opendocument:xmlns:xsl-fo-compatible:1.0" '+
'xmlns:xlink="http://www.w3.org/1999/xlink" '+
'xmlns:dc="http://purl.org/dc/elements/1.1/" '+
'xmlns:meta="urn:oasis:names:tc:opendocument:xmlns:meta:1.0" '+
'xmlns:number="urn:oasis:names:tc:opendocument:xmlns:datastyle:1.0" '+
'xmlns:presentation="urn:oasis:names:tc:opendocument:xmlns:presentation:1.0" '+
'xmlns:svg="urn:oasis:names:tc:opendocument:xmlns:svg-compatible:1.0" '+
'xmlns:chart="urn:oasis:names:tc:opendocument:xmlns:chart:1.0" '+
'xmlns:dr3d="urn:oasis:names:tc:opendocument:xmlns:dr3d:1.0" '+
'xmlns:math="http://www.w3.org/1998/Math/MathML" '+
'xmlns:form="urn:oasis:names:tc:opendocument:xmlns:form:1.0" '+
'xmlns:script="urn:oasis:names:tc:opendocument:xmlns:script:1.0" '+
'xmlns:ooo="http://openoffice.org/2004/office" '+
'xmlns:ooow="http://openoffice.org/2004/writer" '+
'xmlns:oooc="http://openoffice.org/2004/calc" '+
'xmlns:dom="http://www.w3.org/2001/xml-events" '+
'xmlns:xforms="http://www.w3.org/2002/xforms" '+
'xmlns:xsd="http://www.w3.org/2001/XMLSchema" '+
'xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" '+
'xmlns:rpt="http://openoffice.org/2005/report" '+
'xmlns:of="urn:oasis:names:tc:opendocument:xmlns:of:1.2" '+
'xmlns:xhtml="http://www.w3.org/1999/xhtml" '+
'xmlns:grddl="http://www.w3.org/2003/g/data-view#" '+
'xmlns:tableooo="http://openoffice.org/2009/table" '+
'xmlns:drawooo="http://openoffice.org/2010/draw" '+
'xmlns:calcext="urn:org:documentfoundation:names:experimental:calc:xmlns:calcext:1.0" '+
'xmlns:loext="urn:org:documentfoundation:names:experimental:office:xmlns:loext:1.0" '+
'xmlns:field="urn:openoffice:names:experimental:ooo-ms-interop:xmlns:field:1.0" '+
'xmlns:formx="urn:openoffice:names:experimental:ooxml-odf-interop:xmlns:form:1.0" '+
'xmlns:css3t="http://www.w3.org/TR/css3-text/" '+
'xmlns:rdfa="http://docs.oasis-open.org/opendocument/meta/rdfa#" '+
'office:version="1.2">' +
'<office:scripts />'
);
{
'<office:document-content xmlns:office="' + SCHEMAS_XMLNS_OFFICE +
'" xmlns:fo="' + SCHEMAS_XMLNS_FO +
'" xmlns:xlink="http://www.w3.org/1999/xlink" xmlns:dc="http://purl.org/dc/elements/1.1/' +
@ -3843,7 +3959,7 @@ begin
'" xmlns:xsd="' + SCHEMAS_XMLNS_XSD +
'" xmlns:xsi="' + SCHEMAS_XMLNS_XSI + '">' +
'<office:scripts />');
}
// Fonts
AppendToStream(FSContent,
'<office:font-face-decls>');
@ -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(
'<table:table-cell table:formula="%s" office:value-type="string"%s%s>'+
'office:string-value="" calcext:value-type="error">' +
comment +
'<text:p>%s</text:p>' +
'</table:table-cell>', [
valueStr, lStyle, spannedStr,
valueStr
]));
(*
<table:table-cell table:formula="of:=#N/A" office:value-type="string"
office:string-value="" calcext:value-type="error">
<text:p>#NV</text:p>
</table:table-cell>
AppendToStream(AStream, Format(
'<table:table-cell office:value-type="%s" office:boolean-value="%s" %s %s >' +
comment +
'<text:p>%s</text:p>' +
'</table:table-cell>', [
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;

28
components/fpspreadsheet/fpsutils.pas
View File

@ -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

16
components/fpspreadsheet/xlsxooxml.pas
View File

@ -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(
'<c r="%s" s="%d" t="b"><v>%s</v></c>', [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(
'<c r="%s" s="%d" t="e"><v>%s</v></c>', [CellPosText, lStyleIndex, CellValueText]));
end;
{@@ ----------------------------------------------------------------------------