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

fpspreadsheet: Fix formula issues with ods (written error values still different between fps and ods).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3512 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-09-02 09:25:54 +00:00
parent c03833de40
commit 5d496d9cf4
5 changed files with 188 additions and 133 deletions
Download Patch File Download Diff File Expand all files Collapse all files

31
components/fpspreadsheet/fpsexprparser.pas
View File

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

255
components/fpspreadsheet/fpsopendocument.pas
View File

@ -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(
'<table:table-cell table:formula="=%s" office:value-type="%s" office-value="%s" %s>' +
'<text:p>%s</text:p>'+
'<table:table-cell table:formula="=%s" office:value-type="%s" %s %s>' +
// '<text:p>%s</text:p>'+
'</table:table-cell>', [
formula, valuetype, value, lStyle,
value
formula, valuetype, value, lStyle
//value
]))
else
AppendToStream(AStream, Format(

17
components/fpspreadsheet/fpspreadsheet.pas
View File

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

2
components/fpspreadsheet/fpsutils.pas
View File

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

16
components/fpspreadsheet/tests/formulatests.pas
View File

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