You've already forked lazarus-ccr
fpspreadsheet: Implement writing and reading of ods formulas. Some issues with date/time formulas.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3510 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -33,6 +33,9 @@
|
||||
- add boolean constants "TRUE" and "FALSE".
|
||||
- add property RPNFormula to interface the parser to RPN formulas of xls files.
|
||||
- accept funtions with zero parameters
|
||||
- generalize scanner and parser to allow localized decimal and list separators
|
||||
- add to spreadsheet format to parser to take account of formula "dialect"
|
||||
(see OpenDocument using [] around cell addresses)
|
||||
|
||||
******************************************************************************}
|
||||
|
||||
@ -87,6 +90,8 @@ type
|
||||
TsExpressionParser = class;
|
||||
TsBuiltInExpressionManager = class;
|
||||
|
||||
TsFormulaDialect = (fdExcel, fdOpenDocument);
|
||||
|
||||
TsResultType = (rtEmpty, rtBoolean, rtInteger, rtFloat, rtDateTime, rtString,
|
||||
rtCell, rtCellRange, rtError, rtAny);
|
||||
TsResultTypes = set of TsResultType;
|
||||
@ -651,6 +656,7 @@ type
|
||||
function DoIdentifier: TsTokenType;
|
||||
function DoNumber: TsTokenType;
|
||||
function DoDelimiter: TsTokenType;
|
||||
function DoSquareBracket: TsTokenType;
|
||||
function DoString: TsTokenType;
|
||||
function NextPos: Char; // inline;
|
||||
procedure SkipWhiteSpace; // inline;
|
||||
@ -681,6 +687,7 @@ type
|
||||
FHashList: TFPHashObjectlist;
|
||||
FDirty: Boolean;
|
||||
FWorksheet: TsWorksheet;
|
||||
FDialect: TsFormulaDialect;
|
||||
procedure CheckEOF;
|
||||
procedure CheckNodes(var ALeft, ARight: TsExprNode);
|
||||
function ConvertNode(Todo: TsExprNode; ToType: TsResultType): TsExprNode;
|
||||
@ -743,6 +750,7 @@ type
|
||||
property Identifiers: TsExprIdentifierDefs read FIdentifiers write SetIdentifiers;
|
||||
property BuiltIns: TsBuiltInExprCategories read FBuiltIns write SetBuiltIns;
|
||||
property Worksheet: TsWorksheet read FWorksheet;
|
||||
property Dialect: TsFormulaDialect read FDialect write FDialect;
|
||||
end;
|
||||
|
||||
TsSpreadsheetParser = class(TsExpressionParser)
|
||||
@ -855,6 +863,8 @@ resourcestring
|
||||
SErrCommaExpected = 'Expected comma (,) at position %d, but got %s';
|
||||
SErrInvalidNumberChar = 'Unexpected character in number : %s';
|
||||
SErrInvalidNumber = 'Invalid numerical value : %s';
|
||||
SErrInvalidCell = 'No valid cell address specification : %s';
|
||||
SErrInvalidCellRange = 'No valid cell range specification : %s';
|
||||
SErrNoOperand = 'No operand for unary operation %s';
|
||||
SErrNoLeftOperand = 'No left operand for binary operation %s';
|
||||
SErrNoRightOperand = 'No left operand for binary operation %s';
|
||||
@ -1039,6 +1049,40 @@ begin
|
||||
Result := ttNumber;
|
||||
end;
|
||||
|
||||
{ Scans until closing square bracket is reached. In OpenDocument, this is
|
||||
a cell or cell range identifier. }
|
||||
function TsExpressionScanner.DoSquareBracket: TsTokenType;
|
||||
var
|
||||
C: Char;
|
||||
p: Integer;
|
||||
r1,c1,r2,c2: Cardinal;
|
||||
flags: TsRelFlags;
|
||||
begin
|
||||
FToken := '';
|
||||
C := NextPos;
|
||||
while (C <> ']') do
|
||||
begin
|
||||
if C = cNull then
|
||||
ScanError(SErrUnexpectedEndOfExpression);
|
||||
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!)
|
||||
if p <> 0 then Delete(FToken, 1, p);
|
||||
if system.pos(':', FToken) > 0 then
|
||||
begin
|
||||
if ParseCellRangeString(FToken, r1, c1, r2, c2, flags) then
|
||||
Result := ttCellRange
|
||||
else
|
||||
ScanError(Format(SErrInvalidCellRange, [FToken]));
|
||||
end else
|
||||
if ParseCellString(FToken, r1, c1, flags) then
|
||||
Result := ttCell
|
||||
else
|
||||
ScanError(Format(SErrInvalidCell, [FToken]));
|
||||
end;
|
||||
|
||||
function TsExpressionScanner.DoString: TsTokenType;
|
||||
|
||||
function TerminatingChar(C: Char): boolean;
|
||||
@ -1082,7 +1126,9 @@ begin
|
||||
FToken := '';
|
||||
SkipWhiteSpace;
|
||||
C := FChar^;
|
||||
if c = cNull then
|
||||
if (FParser.Dialect = fdOpenDocument) and (C = '[') then
|
||||
Result := DoSquareBracket
|
||||
else if C = cNull then
|
||||
Result := ttEOF
|
||||
else if IsDelim(C) then
|
||||
Result := DoDelimiter
|
||||
@ -1156,6 +1202,7 @@ end;
|
||||
constructor TsExpressionParser.Create(AWorksheet: TsWorksheet);
|
||||
begin
|
||||
inherited Create;
|
||||
FDialect := fdExcel;
|
||||
FWorksheet := AWorksheet;
|
||||
FIdentifiers := TsExprIdentifierDefs.Create(TsExprIdentifierDef);
|
||||
FIdentifiers.FParser := Self;
|
||||
@ -3723,6 +3770,8 @@ end;
|
||||
function TsCellExprNode.AsString: string;
|
||||
begin
|
||||
Result := GetCellString(FRow, FCol, FFlags);
|
||||
if FParser.Dialect = fdOpenDocument then
|
||||
Result := '[.' + Result + ']';
|
||||
end;
|
||||
|
||||
procedure TsCellExprNode.GetNodeValue(var Result: TsExpressionResult);
|
||||
|
||||
@ -193,7 +193,7 @@ type
|
||||
implementation
|
||||
|
||||
uses
|
||||
StrUtils, Variants, fpsStreams;
|
||||
StrUtils, Variants, fpsStreams, fpsExprParser;
|
||||
|
||||
const
|
||||
{ OpenDocument general XML constants }
|
||||
@ -685,6 +685,7 @@ begin
|
||||
inherited Create(AWorkbook);
|
||||
FPointSeparatorSettings := DefaultFormatSettings;
|
||||
FPointSeparatorSettings.DecimalSeparator := '.';
|
||||
FPointSeparatorSettings.ListSeparator := ';'; // for formulas
|
||||
|
||||
FCellStyleList := TFPList.Create;
|
||||
FColumnStyleList := TFPList.Create;
|
||||
@ -1257,10 +1258,12 @@ var
|
||||
valueType: String;
|
||||
valueStr: String;
|
||||
node: TDOMNode;
|
||||
parser: TsSpreadsheetParser;
|
||||
p: Integer;
|
||||
begin
|
||||
|
||||
// Create cell and apply format
|
||||
if FIsVirtualMode then begin
|
||||
if FIsVirtualMode then
|
||||
begin
|
||||
InitCell(ARow, ACol, FVirtualCell);
|
||||
cell := @FVirtualCell;
|
||||
end else
|
||||
@ -1269,10 +1272,28 @@ begin
|
||||
styleName := GetAttrValue(ACellNode, 'table:style-name');
|
||||
ApplyStyleToCell(cell, stylename);
|
||||
|
||||
// Read formula, store in the cell's FormulaValue.FormulaStr
|
||||
if (boReadFormulas in FWorkbook.Options) then begin
|
||||
// Read formula, trim it, ...
|
||||
formula := GetAttrValue(ACellNode, 'table:formula');
|
||||
if formula <> '' then Delete(formula, 1, 3); // delete "of:"
|
||||
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
|
||||
@ -2685,6 +2706,8 @@ end;
|
||||
procedure TsSpreadOpenDocWriter.WriteWorksheet(AStream: TStream;
|
||||
CurSheet: TsWorksheet);
|
||||
begin
|
||||
FWorksheet := CurSheet;
|
||||
|
||||
// Header
|
||||
AppendToStream(AStream,
|
||||
'<table:table table:name="' + CurSheet.Name + '" table:style-name="ta1">');
|
||||
@ -3069,6 +3092,7 @@ begin
|
||||
|
||||
FPointSeparatorSettings := SysUtils.DefaultFormatSettings;
|
||||
FPointSeparatorSettings.DecimalSeparator:='.';
|
||||
FPointSeparatorSettings.ListSeparator := ';'; // for formulas
|
||||
|
||||
// http://en.wikipedia.org/wiki/List_of_spreadsheet_software#Specifications
|
||||
FLimitations.MaxColCount := 1024;
|
||||
@ -3576,6 +3600,10 @@ procedure TsSpreadOpenDocWriter.WriteFormula(AStream: TStream; const ARow,
|
||||
var
|
||||
lStyle: String = '';
|
||||
lIndex: Integer;
|
||||
parser: TsExpressionParser;
|
||||
formula: String;
|
||||
valuetype: String;
|
||||
value: string;
|
||||
begin
|
||||
Unused(AStream, ARow, ACol);
|
||||
|
||||
@ -3585,15 +3613,65 @@ begin
|
||||
end else
|
||||
lStyle := '';
|
||||
|
||||
// Convert string formula to the format needed by ods: semicolon list separators!
|
||||
parser := TsSpreadsheetParser.Create(FWorksheet);
|
||||
try
|
||||
parser.Dialect := fdOpenDocument;
|
||||
parser.Expression := ACell^.FormulaValue;
|
||||
formula := Parser.LocalizedExpression[FPointSeparatorSettings];
|
||||
finally
|
||||
parser.Free;
|
||||
end;
|
||||
|
||||
case ACell^.ContentType of
|
||||
cctNumber:
|
||||
begin
|
||||
valuetype := 'float';
|
||||
value := FormatFloat('%g', ACell^.NumberValue, FPointSeparatorSettings);
|
||||
end;
|
||||
cctDateTime:
|
||||
begin
|
||||
valuetype := 'float';
|
||||
value := FormatFloat('%g', ACell^.DateTimeValue, FPointSeparatorSettings);
|
||||
end;
|
||||
cctUTF8String:
|
||||
begin
|
||||
valuetype := 'string';
|
||||
value := ACell^.UTF8StringValue;
|
||||
end;
|
||||
cctBool:
|
||||
begin
|
||||
valuetype := 'boolean';
|
||||
value := BoolToStr(ACell^.BoolValue, 'true', 'false');
|
||||
end;
|
||||
cctError:
|
||||
begin
|
||||
valuetype := 'error';
|
||||
value := GetErrorValueStr(ACell^.ErrorValue);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Fix special xml characters }
|
||||
formula := UTF8TextToXMLText(formula);
|
||||
|
||||
{ We are writing a very rudimentary formula here without result and result
|
||||
data type. Seems to work... }
|
||||
if ACell^.CalcState=csCalculated then
|
||||
AppendToStream(AStream, Format(
|
||||
'<table:table-cell table:formula="%s" %s>' +
|
||||
'<table:table-cell table:formula="=%s" office:value-type="%s" office-value="%s" %s>' +
|
||||
'<text:p>%s</text:p>'+
|
||||
'</table:table-cell>', [
|
||||
ACell^.FormulaValue, lStyle
|
||||
formula, valuetype, value, lStyle,
|
||||
value
|
||||
]))
|
||||
else
|
||||
AppendToStream(AStream, Format(
|
||||
'<table:table-cell table:formula="=%s" %s/>', [
|
||||
formula, lStyle
|
||||
]));
|
||||
end;
|
||||
|
||||
|
||||
{
|
||||
Writes a cell with text content
|
||||
|
||||
|
||||
@ -47,6 +47,8 @@ type
|
||||
procedure Test_Write_Read_FormulaStrings_BIFF8;
|
||||
{ OOXML Tests }
|
||||
procedure Test_Write_Read_FormulaStrings_OOXML;
|
||||
{ ODS Tests }
|
||||
procedure Test_Write_Read_FormulaStrings_ODS;
|
||||
|
||||
// Writes out and calculates rpn formulas, read back
|
||||
{ BIFF2 Tests }
|
||||
@ -185,6 +187,11 @@ begin
|
||||
TestWriteReadFormulaStrings(sfOOXML, true);
|
||||
end;
|
||||
|
||||
procedure TSpreadWriteReadFormulaTests.Test_Write_Read_FormulaStrings_ODS;
|
||||
begin
|
||||
TestWriteReadFormulaStrings(sfOpenDocument, true);
|
||||
end;
|
||||
|
||||
|
||||
{ Test calculation of formulas }
|
||||
|
||||
|
||||
@ -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>
|
||||
|
||||
Reference in New Issue
Block a user