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

fpspreadsheet: Fix ods formula issues, seems to be ok now.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3513 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-09-02 12:58:06 +00:00
parent 5d496d9cf4
commit e40683ea83
4 changed files with 159 additions and 78 deletions
Download Patch File Download Diff File Expand all files Collapse all files

133
components/fpspreadsheet/fpsexprparser.pas
View File

@ -3956,86 +3956,117 @@ var
cell: PCell;
begin
Result := 0;
if Arg.ResultType = rtInteger then
result := Arg.ResInteger
else
if Arg.ResultType = rtFloat then
result := trunc(Arg.ResFloat)
else
if Arg.ResultType = rtDateTime then
result := trunc(Arg.ResDateTime)
else
if (Arg.ResultType = rtCell) then
begin
cell := ArgToCell(Arg);
if Assigned(cell) and (cell^.ContentType = cctNumber) then
result := trunc(cell^.NumberValue);
case Arg.ResultType of
rtInteger : result := Arg.ResInteger;
rtFloat : result := trunc(Arg.ResFloat);
rtDateTime : result := trunc(Arg.ResDateTime);
rtBoolean : if Arg.ResBoolean then Result := 1 else Result := 0;
rtString : if not TryStrToInt(Arg.ResString, Result) then Result := 0;
rtCell : begin
cell := ArgToCell(Arg);
if Assigned(cell) then
case cell^.ContentType of
cctNumber : result := trunc(cell^.NumberValue);
cctDateTime : result := trunc(cell^.DateTimeValue);
cctBool : if cell^.BoolValue then result := 1;
cctUTF8String: if not TryStrToInt(cell^.UTF8StringValue, result)
then Result := 0;
end;
end;
end;
end;
function ArgToFloat(Arg: TsExpressionResult): TsExprFloat;
// Utility function for the built-in math functions. Accepts also integers
// in place of the floating point arguments. To be called in builtins or
// user-defined callbacks having float results.
// Utility function for the built-in math functions. Accepts also integers and
// other data types in place of floating point arguments. To be called in
// builtins or user-defined callbacks having float results or arguments.
var
cell: PCell;
s: String;
fs: TFormatSettings;
begin
Result := 0.0;
if Arg.ResultType = rtInteger then
result := Arg.ResInteger
else
if Arg.ResultType = rtDateTime then
result := Arg.ResDateTime
else
if Arg.ResultType = rtFloat then
result := Arg.ResFloat
else
if (Arg.ResultType = rtCell) then
begin
cell := ArgToCell(Arg);
if Assigned(cell) then
case cell^.ContentType of
cctNumber : Result := cell^.NumberValue;
cctDateTime : Result := cell^.DateTimeValue;
end;
case Arg.ResultType of
rtInteger : result := Arg.ResInteger;
rtDateTime : result := Arg.ResDateTime;
rtFloat : result := Arg.ResFloat;
rtBoolean : if Arg.ResBoolean then Result := 1.0 else Result := 0.0;
rtString : if not TryStrToFloat(Arg.ResString, Result) then Result := 0.0;
rtCell : begin
cell := ArgToCell(Arg);
if Assigned(cell) then
case cell^.ContentType of
cctNumber : Result := cell^.NumberValue;
cctDateTime : Result := cell^.DateTimeValue;
cctBool : if cell^.BoolValue then result := 1.0;
cctUTF8String: begin
fs := Arg.Worksheet.Workbook.FormatSettings;
s := cell^.UTF8StringValue;
if not TryStrToFloat(s, result, fs) then
result := 0.0;
end;
end;
end;
end;
end;
function ArgToDateTime(Arg: TsExpressionResult): TDateTime;
var
cell: PCell;
fs: TFormatSettings;
begin
Result := 0.0;
if Arg.ResultType = rtDateTime then
result := Arg.ResDateTime
else
if Arg.ResultType = rtInteger then
Result := Arg.ResInteger
else
if Arg.ResultType = rtFloat then
Result := Arg.ResFloat
else
if (Arg.ResultType = rtCell) then
begin
cell := ArgToCell(Arg);
if Assigned(cell) and (cell^.ContentType = cctDateTime) then
Result := cell^.DateTimeValue;
case Arg.ResultType of
rtDateTime : result := Arg.ResDateTime;
rtInteger : Result := Arg.ResInteger;
rtFloat : Result := Arg.ResFloat;
rtBoolean : if Arg.ResBoolean then Result := 1.0;
rtString : begin
fs := Arg.Worksheet.Workbook.FormatSettings;
if not TryStrToDateTime(Arg.ResString, Result) then
Result := 1.0;
end;
rtCell : begin
cell := ArgToCell(Arg);
if Assigned(cell) then
if (cell^.ContentType = cctDateTime) then
Result := cell^.DateTimeValue;
end;
end;
end;
function ArgToString(Arg: TsExpressionResult): String;
// The Office applications are very fuzzy about data types...
var
cell: PCell;
fs: TFormatSettings;
dt: TDateTime;
begin
Result := '';
case Arg.ResultType of
rtString : result := Arg.ResString;
rtInteger : Result := IntToStr(Arg.ResInteger);
rtFloat : Result := FloatToStr(Arg.ResFloat);
rtBoolean : if Arg.ResBoolean then Result := '1' else Result := '0';
rtCell : begin
cell := ArgToCell(Arg);
if Assigned(cell) and (cell^.ContentType = cctUTF8String) then
Result := cell^.UTF8Stringvalue;
if Assigned(cell) then
case cell^.ContentType of
cctUTF8String : Result := cell^.UTF8Stringvalue;
cctNumber : Result := Format('%g', [cell^.NumberValue]);
cctBool : if cell^.BoolValue then Result := '1' else Result := '0';
cctDateTime : begin
fs := Arg.Worksheet.Workbook.FormatSettings;
dt := cell^.DateTimeValue;
if frac(dt) = 0.0 then
Result := FormatDateTime(fs.LongTimeFormat, dt, fs)
else
if trunc(dt) = 0 then
Result := FormatDateTime(fs.ShortDateFormat, dt, fs)
else
Result := FormatDateTime('cc', dt, fs);
end;
end;
end;
end;
end;
@ -4070,7 +4101,7 @@ begin
end;
end
else
if (arg.ResultType in [rtInteger, rtFloat, rtDateTime, rtCell]) then
if (arg.ResultType in [rtInteger, rtFloat, rtDateTime, rtCell, rtBoolean]) then
begin
AData[n] := ArgToFloat(arg);
inc(n);

23
components/fpspreadsheet/fpsopendocument.pas
View File

@ -1230,9 +1230,12 @@ begin
end;
// Read formula results
// ... number value
valueType := GetAttrValue(ACellNode, 'office:value-type');
valueStr := GetAttrValue(ACellNode, 'office:value');
// 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;
// (a) number value
if (valueType = 'float') then begin
if UpperCase(valueStr) = '1.#INF' then
FWorksheet.WriteNumber(cell, 1.0/0.0)
@ -1253,12 +1256,12 @@ begin
end;
end;
end else
// Date/time value
// (b) 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
// (c) text
if (valueType = 'string') then begin
node := ACellNode.FindNode('text:p');
if (node <> nil) and (node.FirstChild <> nil) then begin
@ -1266,7 +1269,7 @@ begin
FWorksheet.WriteUTF8Text(cell, valueStr);
end;
end else
// Text
// (e) Text
FWorksheet.WriteUTF8Text(cell, valueStr);
if FIsVirtualMode then
@ -3604,6 +3607,7 @@ var
formula: String;
valuetype: String;
value: string;
valueStr: String;
begin
Unused(AStream, ARow, ACol);
@ -3623,6 +3627,7 @@ begin
parser.Free;
end;
valueStr := '';
case ACell^.ContentType of
cctNumber:
begin
@ -3647,6 +3652,7 @@ begin
begin
valuetype := 'string';
value := 'office:string-value="' + ACell^.UTF8StringValue +'"';
valueStr := '<text:p>' + ACell^.UTF8StringValue + '</text:p>';
end;
cctBool:
begin
@ -3655,8 +3661,10 @@ begin
end;
cctError:
begin
valuetype := 'error';
value := 'office:value="' + GetErrorValueStr(ACell^.ErrorValue) + '"';
// Strange: but in case of an error, Open/LibreOffice always writes a
// float value 0 to the cell
valuetype := 'float';
value := 'office:value="0"';
end;
end;
@ -3668,10 +3676,9 @@ begin
if ACell^.CalcState=csCalculated then
AppendToStream(AStream, Format(
'<table:table-cell table:formula="=%s" office:value-type="%s" %s %s>' +
// '<text:p>%s</text:p>'+
valueStr +
'</table:table-cell>', [
formula, valuetype, value, lStyle
//value
]))
else
AppendToStream(AStream, Format(

8
components/fpspreadsheet/tests/spreadtestgui.lpi
View File

@ -48,10 +48,12 @@
<Unit1>
<Filename Value="datetests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="datetests"/>
</Unit1>
<Unit2>
<Filename Value="stringtests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="stringtests"/>
</Unit2>
<Unit3>
<Filename Value="numberstests.pas"/>
@ -61,7 +63,6 @@
<Unit4>
<Filename Value="manualtests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="manualtests"/>
</Unit4>
<Unit5>
<Filename Value="testsutility.pas"/>
@ -71,6 +72,7 @@
<Unit6>
<Filename Value="internaltests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="internaltests"/>
</Unit6>
<Unit7>
<Filename Value="formattests.pas"/>
@ -80,6 +82,7 @@
<Unit8>
<Filename Value="colortests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="colortests"/>
</Unit8>
<Unit9>
<Filename Value="fonttests.pas"/>
@ -96,7 +99,6 @@
<Unit12>
<Filename Value="rpnformulaunit.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="rpnFormulaUnit"/>
</Unit12>
<Unit13>
<Filename Value="formulatests.pas"/>
@ -110,10 +112,12 @@
<Unit15>
<Filename Value="errortests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="errortests"/>
</Unit15>
<Unit16>
<Filename Value="virtualmodetests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="virtualmodetests"/>
</Unit16>
</Units>
</ProjectOptions>

73
components/fpspreadsheet/tests/testcases_calcrpnformula.inc
View File

@ -220,7 +220,10 @@
MyWorksheet.WriteFormula(Row, 1, formula);
MyWorksheet.WriteErrorValue(Row, 2, errDivideByZero);
SetLength(sollValues, Row+1);
sollValues[Row] := ErrorResult(errDivideByZero);
if AFormat = sfOpenDocument then
sollValues[Row] := FloatResult(0)
else
sollValues[Row] := ErrorResult(errDivideByZero);
// Division of cell values
inc(Row);
@ -956,9 +959,12 @@
RPNFunc('ACOS', nil))))
else
MyWorksheet.WriteFormula(Row, 1, formula);
MyWorksheet.WriteErrorValue(Row, 2, errOverflow);;
SetLength(sollValues, Row+1);
sollValues[Row] := ErrorResult(errOverFlow);
MyWorksheet.WriteErrorValue(Row, 2, errOverflow);
if AFormat = sfOpenDocument then
sollValues[Row] := FloatResult(0)
else
sollValues[Row] := ErrorResult(errOverFlow);
// ARCCOSH - valid result
inc(Row);
@ -985,9 +991,12 @@
RPNFunc('ACOSH', nil))))
else
MyWorksheet.WriteFormula(Row, 1, formula);
SetLength(sollValues, Row+1);
sollValues[Row] := ErrorResult(errOverFlow);
MyWorksheet.WriteErrorValue(Row, 2, errOverflow);
SetLength(sollValues, Row+1);
if AFormat = sfOpenDocument then
sollValues[Row] := FloatResult(0)
else
sollValues[Row] := ErrorResult(errOverFlow);
// ASIN
inc(Row);
@ -1014,9 +1023,12 @@
RPNFunc('ASIN', nil))))
else
Myworksheet.WriteFormula(Row, 1, formula);
SetLength(sollValues, Row+1);
sollValues[Row] := ErrorResult(errOverFlow);
MyWorksheet.WriteErrorValue(Row, 2, errOverflow);
SetLength(sollValues, Row+1);
if AFormat = sfOpenDocument then
sollValues[Row] := FloatResult(0)
else
sollValues[Row] := ErrorResult(errOverFlow);
// ARCSINH
inc(Row);
@ -1073,9 +1085,12 @@
RPNFunc('ATANH', nil))))
else
myWorksheet.WriteFormula(Row, 1, formula);
SetLength(sollValues, Row+1);
sollValues[Row] := ErrorResult(errOverFlow);
MyWorksheet.WriteErrorValue(Row, 2, errOverFlow);
SetLength(sollValues, Row+1);
if AFormat = sfOpenDocument then
sollValues[Row] := FloatResult(0)
else
sollValues[Row] := ErrorResult(errOverFlow);
// CEILING
if AFormat <> sfExcel2 then begin
@ -1262,7 +1277,10 @@
MyWorksheet.WriteFormula(Row, 1, formula);
myWorksheet.WriteUTF8Text(Row, 2, GetErrorValueStr(errOverflow));
SetLength(sollValues, Row+1);
sollValues[Row] := ErrorResult(errOverflow);
if AFormat = sfOpenDocument then
sollValues[Row] := FloatResult(0)
else
sollValues[Row] := ErrorResult(errOverflow);
// LN - error due to argument < 0
inc(Row);
@ -1276,7 +1294,10 @@
MyWorksheet.WriteFormula(Row, 1, formula);
MyWorksheet.WriteUTF8Text(Row, 2, GetErrorValueStr(errOverflow));
SetLength(sollValues, Row+1);
sollValues[Row] := ErrorResult(errOverflow);
if AFormat = sfOpenDocument then
sollValues[Row] := FloatResult(0)
else
sollValues[Row] := ErrorResult(errOverflow);
// LOG10 - valid result
inc(Row);
@ -1305,7 +1326,10 @@
MyWorksheet.WriteFormula(Row, 1, formula);
myWorksheet.WriteUTF8Text(Row, 2, GetErrorValueStr(errOverflow));
SetLength(sollValues, Row+1);
sollValues[Row] := ErrorResult(errOverflow);
if AFormat = sfOpenDocument then
sollValues[Row] := FloatResult(0)
else
sollValues[Row] := ErrorResult(errOverflow);
// LOG10 - error due to argument < 0
inc(Row);
@ -1319,7 +1343,10 @@
MyWorksheet.WriteFormula(Row, 1, formula);
MyWorksheet.WriteUTF8Text(Row, 2, GetErrorValueStr(errOverFlow));
SetLength(sollValues, Row+1);
sollValues[Row] := ErrorResult(errOverflow);
if AFormat = sfOpenDocument then
sollValues[Row] := FloatResult(0)
else
sollValues[Row] := ErrorResult(errOverflow);
// LOG - valid result (2 arguments)
inc(Row);
@ -1352,7 +1379,10 @@
MyWorksheet.WriteFormula(Row, 1, formula);
MyWorksheet.WriteUTF8Text(Row, 2, GetErrorValueStr(errOverflow));
SetLength(sollValues, Row+1);
sollValues[Row] := ErrorResult(errOverflow);
if AFormat = sfOpenDocument then
sollValues[Row] := FloatResult(0)
else
sollValues[Row] := ErrorResult(errOverflow);
}
// LOG - valid result (1 argument)
@ -1383,7 +1413,10 @@
MyWorksheet.WriteFormula(Row, 1, formula);
MyWorksheet.WriteUTF8Text(Row, 2, GetErrorValueStr(errOverflow));
SetLength(sollValues, Row+1);
sollValues[Row] := ErrorResult(errOverflow);
if AFormat = sfOpenDocument then
sollValues[Row] := FloatResult(0)
else
sollValues[Row] := ErrorResult(errOverflow);
// LOG - negative value
inc(Row);
@ -1398,7 +1431,10 @@
MyWorksheet.WriteFormula(Row, 1, formula);
MyWorksheet.WriteUTF8Text(Row, 2, GetErrorValueStr(errOverflow));
SetLength(sollValues, Row+1);
sollValues[Row] := ErrorResult(errOverflow);
if AFormat = sfOpenDocument then
sollValues[Row] := FloatResult(0)
else
sollValues[Row] := ErrorResult(errOverflow);
// LOG of cell
inc(Row);
@ -1623,7 +1659,10 @@
myWorksheet.WriteFormula(Row, 1, formula);
MyWorksheet.WriteUTF8Text(Row, 2, GetErrorValueStr(errOverflow));
SetLength(sollValues, Row+1);
sollValues[Row] := ErrorResult(errOverflow);
if AFormat = sfOpenDocument then
sollValues[Row] := FloatResult(0)
else
sollValues[Row] := ErrorResult(errOverflow);
// SQRT of cell value
inc(Row);