paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fpspreadsheet: Redo handling for formulas:

Browse Source 
- Allow processing of string formulas (conversion to/from rpn formulas, calculation). 
- Drop cell ContentType cctRPNFormula. 
- Drop field RPNFormulaValue of TCell record. 
- Remove all fekXXXX declarations for sheet functions. Function is specified by name now.
- Complete registration mechanism for user-defined formulas.
Adapt all demos
Test cases working
This commit does not yet support: shared formulas, formulas in ods.


git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3506 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2014-08-30 18:03:22 +00:00
parent a043b77519
commit c87afdcdec
52 changed files with 7168 additions and 4279 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
components/fpspreadsheet/examples/db_import_export/db_export_import.lpi
View File

@ -27,10 +27,13 @@
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<RequiredPackages Count="2">
<Item1>
<PackageName Value="LCL"/>
<PackageName Value="LazUtils"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="2">
<Unit0>
@ -43,6 +46,7 @@
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="main"/>
</Unit1>
</Units>
</ProjectOptions>

2
components/fpspreadsheet/examples/excel2demo/excel2read.lpi
View File

@ -32,7 +32,7 @@
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
<PackageName Value="LazUtils"/>
</Item1>
</RequiredPackages>
<Units Count="1">

11
components/fpspreadsheet/examples/excel2demo/excel2read.lpr
View File

@ -32,6 +32,8 @@ begin
// Create the spreadsheet
MyWorkbook := TsWorkbook.Create;
MyWorkbook.Options := MyWorkbook.Options + [boReadFormulas, boAutoCalc];
MyWorkbook.ReadFromFile(InputFilename, sfExcel2);
MyWorksheet := MyWorkbook.GetFirstWorksheet;
@ -44,9 +46,12 @@ begin
CurCell := MyWorkSheet.GetFirstCell();
for i := 0 to MyWorksheet.GetCellCount - 1 do
begin
WriteLn('Row: ', CurCell^.Row, ' Col: ', CurCell^.Col, ' Value: ',
UTF8ToAnsi(MyWorkSheet.ReadAsUTF8Text(CurCell^.Row, CurCell^.Col))
);
Write('Row: ', CurCell^.Row, ' Col: ', CurCell^.Col, ' Value: ',
UTF8ToAnsi(MyWorkSheet.ReadAsUTF8Text(CurCell^.Row, CurCell^.Col))
);
if HasFormula(CurCell) then
Write(' (Formula ', CurCell^.FormulaValue, ')');
WriteLn;
CurCell := MyWorkSheet.GetNextCell();
end;

2
components/fpspreadsheet/examples/excel2demo/excel2write.lpi
View File

@ -32,7 +32,7 @@
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
<PackageName Value="LazUtils"/>
</Item1>
</RequiredPackages>
<Units Count="1">

19
components/fpspreadsheet/examples/excel2demo/excel2write.lpr
View File

@ -51,30 +51,31 @@ begin
MyWorksheet.WriteNumber(0, 2, 3.0);
MyWorksheet.WriteNumber(0, 3, 4.0);
// Write the formula E1 = ABS(A1)
// Write the formula E1 = ABS(A1) as rpn token array
SetLength(MyRPNFormula, 2);
MyRPNFormula[0].ElementKind := fekCell;
MyRPNFormula[0].Col := 0;
MyRPNFormula[0].Row := 0;
MyRPNFormula[1].ElementKind := fekABS;
MyRPNFormula[1].ElementKind := fekFUNC;
MyRPNFormula[1].FuncName := 'ABS';
MyWorksheet.WriteRPNFormula(0, 4, MyRPNFormula);
// Write the formula F1 = ROUND(A1, 0)
// Write the formula F1 = ROUND(A1, 0) as rpn token array
SetLength(MyRPNFormula, 3);
MyRPNFormula[0].ElementKind := fekCell;
MyRPNFormula[0].Col := 0;
MyRPNFormula[0].Row := 0;
MyRPNFormula[1].ElementKind := fekNum;
MyRPNFormula[1].DoubleValue := 0.0;
MyRPNFormula[2].ElementKind := fekROUND;
MyRPNFormula[2].ElementKind := fekFUNC;
MyRPNFormula[2].FuncName := 'ROUND';
MyWorksheet.WriteRPNFormula(0, 5, MyRPNFormula);
// Write a string formula to G1 = "A" & "B"
MyWorksheet.WriteRPNFormula(0, 6, CreateRPNFormula(
RPNString('A',
RPNSTring('B',
RPNFunc(fekConcat,
nil)))));
MyWorksheet.WriteFormula(0, 6, '="A"&"B"');
// Write string formula to H1 = sin(A1+B1)
MyWorksheet.WriteFormula(0, 7, '=SIN(A1+B1)');
// Write some string cells
MyWorksheet.WriteUTF8Text(1, 0, 'First');

10
components/fpspreadsheet/examples/excel5demo/excel5read.lpr
View File

@ -31,6 +31,7 @@ begin
// Create the spreadsheet
MyWorkbook := TsWorkbook.Create;
MyWorkbook.Options := MyWorkbook.Options + [boReadFormulas];
MyWorkbook.ReadFromFile(InputFilename, sfExcel5);
MyWorksheet := MyWorkbook.GetFirstWorksheet;
@ -43,11 +44,12 @@ begin
CurCell := MyWorkSheet.GetFirstCell();
for i := 0 to MyWorksheet.GetCellCount - 1 do
begin
WriteLn('Row: ', CurCell^.Row,
Write('Row: ', CurCell^.Row,
' Col: ', CurCell^.Col, ' Value: ',
UTF8ToAnsi(MyWorkSheet.ReadAsUTF8Text(CurCell^.Row,
CurCell^.Col))
);
UTF8ToAnsi(MyWorkSheet.ReadAsUTF8Text(CurCell^.Row, CurCell^.Col)));
if HasFormula(CurCell) then
Write(' - Formula: ', CurCell^.FormulaValue);
WriteLn;
CurCell := MyWorkSheet.GetNextCell();
end;

2
components/fpspreadsheet/examples/excel5demo/excel5write.lpi
View File

@ -32,7 +32,7 @@
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
<PackageName Value="LazUtils"/>
</Item1>
</RequiredPackages>
<Units Count="1">

17
components/fpspreadsheet/examples/excel5demo/excel5write.lpr
View File

@ -35,7 +35,9 @@ begin
MyWorkbook := TsWorkbook.Create;
MyWorksheet := MyWorkbook.AddWorksheet(UTF8ToAnsi(Str_Worksheet1));
MyWorkbook.Options := MyWorkbook.Options + [boCalcBeforeSaving];
MyWorksheet.Options := MyWorksheet.Options + [soHasFrozenPanes];
MyWorksheet.LeftPaneWidth := 1;
MyWorksheet.TopPaneHeight := 2;
@ -139,7 +141,7 @@ begin
end;
}
// Write the formula E1 = A1 + B1
// Write the formula E1 = A1 + B1 as rpn roken array
SetLength(MyRPNFormula, 3);
MyRPNFormula[0].ElementKind := fekCell;
MyRPNFormula[0].Col := 0;
@ -150,15 +152,22 @@ begin
MyRPNFormula[2].ElementKind := fekAdd;
MyWorksheet.WriteRPNFormula(0, 4, MyRPNFormula);
// Write the formula F1 = ABS(A1)
// Write the formula F1 = ABS(A1) as rpn token array
SetLength(MyRPNFormula, 2);
MyRPNFormula[0].ElementKind := fekCell;
MyRPNFormula[0].Col := 0;
MyRPNFormula[0].Row := 0;
MyRPNFormula[1].ElementKind := fekABS;
MyRPNFormula[1].ElementKind := fekFunc;
MyRPNFormula[1].FuncName := 'ABS';
MyWorksheet.WriteRPNFormula(0, 5, MyRPNFormula);
r:= 10;
// Write formula G1 = "A"&"B" as string formula
MyWorksheet.WriteFormula(0, 6, '="A"&"B"');
// Write formula H1 = sin(A1+B1) as string formula
Myworksheet.WriteFormula(0, 7, '=SIN(A1+B1)');
r := 10;
// Write current date/time to cells B11:B16
MyWorksheet.WriteUTF8Text(r, 0, 'nfShortDate');
MyWorksheet.WriteDateTime(r, 1, now, nfShortDate);

2
components/fpspreadsheet/examples/excel8demo/excel8read.lpi
View File

@ -31,7 +31,7 @@
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
<PackageName Value="LazUtils"/>
</Item1>
</RequiredPackages>
<Units Count="1">

6
components/fpspreadsheet/examples/excel8demo/excel8read.lpr
View File

@ -36,7 +36,7 @@ begin
// Create the spreadsheet
MyWorkbook := TsWorkbook.Create;
MyWorkbook.Options := MyWorkbook.Options + [boReadFormulas, boAutoCalc];
MyWorkbook.ReadFormulas := true;
MyWorkbook.ReadFromFile(InputFilename, sfExcel8);
@ -55,8 +55,8 @@ begin
UTF8ToAnsi(MyWorkSheet.ReadAsUTF8Text(CurCell^.Row,
CurCell^.Col))
);
if Length(CurCell^.RPNFormulaValue) > 0 then
WriteLn(' Formula: ', MyWorkSheet.ReadRPNFormulaAsString(CurCell))
if HasFormula(CurCell) then
WriteLn(' Formula: ', MyWorkSheet.ReadFormulaAsString(CurCell))
else
WriteLn;
CurCell := MyWorkSheet.GetNextCell();

68
components/fpspreadsheet/examples/excel8demo/excel8write.lpi
View File

@ -15,64 +15,8 @@
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="3">
<BuildModes Count="1">
<Item1 Name="default" Default="True"/>
<Item2 Name="Debug">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<OtherUnitFiles Value=".."/>
<SrcPath Value=".."/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<IOChecks Value="True"/>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
</CodeGeneration>
<Linking>
<Debugging>
<UseExternalDbgSyms Value="True"/>
</Debugging>
</Linking>
</CompilerOptions>
</Item2>
<Item3 Name="Release">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<OtherUnitFiles Value=".."/>
<SrcPath Value=".."/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
</Debugging>
<LinkSmart Value="True"/>
</Linking>
</CompilerOptions>
</Item3>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
@ -88,7 +32,7 @@
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="laz_fpspreadsheet"/>
<PackageName Value="LazUtils"/>
</Item1>
</RequiredPackages>
<Units Count="1">
@ -101,8 +45,12 @@
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="excel8write"/>
</Target>
<SearchPaths>
<OtherUnitFiles Value=".."/>
<OtherUnitFiles Value="..\.."/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
@ -111,7 +59,7 @@
</Parsing>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf2Set"/>
<UseExternalDbgSyms Value="True"/>
</Debugging>
</Linking>
</CompilerOptions>

43
components/fpspreadsheet/examples/excel8demo/excel8write.lpr
View File

@ -10,8 +10,7 @@ program excel8write;
{$mode delphi}{$H+}
uses
Classes, SysUtils, fpspreadsheet, xlsbiff8,
laz_fpspreadsheet;
Classes, SysUtils, fpspreadsheet, xlsbiff8;
const
Str_First = 'First';
@ -41,6 +40,7 @@ begin
MyWorkbook.UsePalette(@PALETTE_BIFF8, Length(PALETTE_BIFF8));
MyWorkbook.FormatSettings.CurrencyFormat := 2;
MyWorkbook.FormatSettings.NegCurrFormat := 14;
MyWorkbook.Options := MyWorkbook.Options + [boCalcBeforeSaving];
MyWorksheet := MyWorkbook.AddWorksheet(Str_Worksheet1);
MyWorksheet.Options := MyWorksheet.Options - [soShowGridLines];
@ -147,28 +147,27 @@ begin
end;
}
// Write the formula E1 = A1 + B1
SetLength(MyRPNFormula, 3);
MyRPNFormula[0].ElementKind := fekCell;
MyRPNFormula[0].Col := 0;
MyRPNFormula[0].Row := 0;
MyRPNFormula[1].ElementKind := fekCell;
MyRPNFormula[1].Col := 1;
MyRPNFormula[1].Row := 0;
MyRPNFormula[2].ElementKind := fekAdd;
MyWorksheet.WriteRPNFormula(0, 4, MyRPNFormula);
MyWorksheet.WriteFont(0, 4, 'Arial', 10, [fssUnderline], scBlack);
// Write the string formula E1 = A1 + B1 ...
MyWorksheet.WriteFormula(0, 4, 'A1+B1');
// ... and the rpn formula E2 = A1 + B1
MyWorksheet.WriteRPNFormula(1, 4, CreateRPNFormula(
RPNCellValue('A1',
RPNCellValue('B1',
RPNFunc(fekAdd,
nil)))));
// Write the formula F1 = ABS(A1)
SetLength(MyRPNFormula, 2);
MyRPNFormula[0].ElementKind := fekCell;
MyRPNFormula[0].Col := 0;
MyRPNFormula[0].Row := 0;
MyRPNFormula[1].ElementKind := fekABS;
MyWorksheet.WriteRPNFormula(0, 5, MyRPNFormula);
// Write the formula F1 = ABS(A1) as string formula ...
MyWorksheet.WriteFormula(0, 5, 'ABS(A1)');
// ... and F2 = ABS(A1) as rpn formula
MyWorksheet.WriteRPNFormula(1, 5, CreateRPNFormula(
RPNCellValue('A1',
RPNFunc('ABS',
nil))));
// Write a string formula to G1 = "A" & "B"
MyWorksheet.WriteRPNFormula(0, 6, CreateRPNFormula(
// Write a string formula to G1 = "A" & "B" ...
MyWorksheet.WriteFormula(0, 6, '"A"&"B"');
// ... and again as rpn formula
MyWorksheet.WriteRPNFormula(1, 6, CreateRPNFormula(
RPNString('A',
RPNSTring('B',
RPNFunc(fekConcat,

1
components/fpspreadsheet/examples/ooxmldemo/ooxmlread.lpi
View File

@ -56,7 +56,6 @@
<SearchPaths>
<OtherUnitFiles Value="..\.."/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
<SrcPath Value=".."/>
</SearchPaths>
<Parsing>
<SyntaxOptions>

1
components/fpspreadsheet/examples/ooxmldemo/ooxmlread.lpr
View File

@ -35,6 +35,7 @@ begin
// Create the spreadsheet
MyWorkbook := TsWorkbook.Create;
MyWorkbook.Options := MyWorkbook.Options + [boReadFormulas];
MyWorkbook.ReadFromFile(InputFilename, sfOOXML);
MyWorksheet := MyWorkbook.GetFirstWorksheet;

5
components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpi
View File

@ -57,10 +57,5 @@
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Debugging>
<UseExternalDbgSyms Value="True"/>
</Debugging>
</Linking>
</CompilerOptions>
</CONFIG>

5
components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpr
View File

@ -40,6 +40,11 @@ begin
MyWorksheet.WriteColWidth(0, 20);
MyWorksheet.WriteRowHeight(0, 4);
// Write some formulas
Myworksheet.WriteFormula(0, 5, '=A1-B1');
Myworksheet.WriteFormula(0, 6, '=SUM(A1:D1)');
MyWorksheet.WriteFormula(0, 7, '=SIN(A1+B1)');
// Uncomment this to test large XLS files
for i := 2 to 2{20} do
begin

8
components/fpspreadsheet/examples/opendocdemo/opendocread.lpi
View File

@ -32,7 +32,7 @@
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LazUtils"/>
<PackageName Value="laz_fpspreadsheet"/>
</Item1>
</RequiredPackages>
<Units Count="1">
@ -51,16 +51,12 @@
<SearchPaths>
<OtherUnitFiles Value="..\.."/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
<SrcPath Value=".."/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Debugging>
<UseExternalDbgSyms Value="True"/>
</Debugging>
</Linking>
</CompilerOptions>
</CONFIG>

3
components/fpspreadsheet/examples/opendocdemo/opendocread.lpr
View File

@ -11,7 +11,8 @@ program opendocread;
{$mode delphi}{$H+}
uses
Classes, SysUtils, fpspreadsheet, fpsallformats;
Classes, SysUtils, fpspreadsheet, fpsallformats,
laz_fpspreadsheet;
var
MyWorkbook: TsWorkbook;

14
components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpi
View File

@ -32,7 +32,7 @@
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LazUtils"/>
<PackageName Value="laz_fpspreadsheet"/>
</Item1>
</RequiredPackages>
<Units Count="1">
@ -45,22 +45,14 @@
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="opendocwrite"/>
</Target>
<SearchPaths>
<OtherUnitFiles Value="..\.."/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
<OtherUnitFiles Value=".."/>
<SrcPath Value=".."/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Debugging>
<UseExternalDbgSyms Value="True"/>
</Debugging>
</Linking>
</CompilerOptions>
</CONFIG>

3
components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr
View File

@ -10,7 +10,8 @@ program opendocwrite;
{$mode delphi}{$H+}
uses
Classes, SysUtils, fpspreadsheet, fpsallformats;
Classes, SysUtils, fpspreadsheet, fpsallformats,
laz_fpspreadsheet;
var
MyWorkbook: TsWorkbook;

111
components/fpspreadsheet/examples/other/demo_expression_parser.pas
View File

@ -10,14 +10,6 @@ uses
{ you can add units after this },
TypInfo, fpSpreadsheet, fpsUtils, fpsExprParser;
function Prepare(AFormula: String): String;
begin
if (AFormula <> '') and (AFormula[1] = '=') then
Result := Copy(AFormula, 2, Length(AFormula)-1)
else
Result := AFormula;
end;
var
workbook: TsWorkbook;
worksheet: TsWorksheet;
@ -26,55 +18,89 @@ var
res: TsExpressionResult;
formula: TsRPNFormula;
i: Integer;
s: String;
begin
workbook := TsWorkbook.Create;
try
worksheet := workbook.AddWorksheet('Test');
{
worksheet.WriteNumber(0, 0, 2); // A1
worksheet.WriteNumber(0, 0, 1); // A1
worksheet.WriteNumber(0, 1, 2.5); // B1
}
{
worksheet.WriteUTF8Text(0, 0, 'Hallo'); // A1
worksheet.WriteUTF8Text(0, 1, 'World'); // B1
}
//cell := worksheet.WriteFormula(1, 0, '=4+5'); // A2
//cell := worksheet.WriteFormula(1, 0, 'AND(TRUE(), TRUE(), TRUE())');
//cell := worksheet.WriteFormula(1, 0, 'SIN(A1+B1)');
//cell := worksheet.WriteFormula(1, 0, '=TRUE()');
//cell := worksheet.WriteFormula(1, 0, '=1-(4/2)^2*2-1'); // A2
//cell := Worksheet.WriteFormula(1, 0, 'datedif(today(),Date(2014,1,1),"D")');
//cell := Worksheet.WriteFormula(1, 0, 'Day(Date(2014, 1, 12))');
//cell := Worksheet.WriteFormula(1, 0, 'SUM(1,2,3)');
//cell := Worksheet.WriteFormula(1, 0, 'CELL("address",A1)');
cell := Worksheet.WriteFormula(1, 0, 'ISBLANK(A1)');
//cell := worksheet.WriteFormula(1, 0, '=(A1+2)*3'); // A2
cell := worksheet.WriteFormula(1, 0, 'A1&" "&B1');
WriteLn('A1: ', worksheet.ReadAsUTF8Text(0, 0));
WriteLn('B1: ', worksheet.ReadAsUTF8Text(0, 1));
WriteLn('A1 = ', worksheet.ReadAsUTF8Text(0, 0));
WriteLn('B1 = ', worksheet.ReadAsUTF8Text(0, 1));
parser := TsExpressionParser.Create(worksheet);
parser := TsSpreadsheetParser.Create(worksheet);
try
parser.Builtins := [bcStrings, bcDateTime, bcMath, bcBoolean, bcConversion, bcData,
bcVaria, bcUser];
parser.Expression := Prepare(cell^.FormulaValue.FormulaStr);
res := parser.Evaluate;
try
parser.Expression := cell^.FormulaValue;
res := parser.Evaluate;
Write('A2 = ', Prepare(cell^.FormulaValue.FormulaStr), ' = ');
case res.ResultType of
rtBoolean : WriteLn(BoolToStr(res.ResBoolean));
rtFloat : WriteLn(FloatToStr(res.ResFloat));
rtInteger : WriteLn(IntToStr(res.ResInteger));
rtDateTime : WriteLn(FormatDateTime('c', res.ResDateTime));
rtString : WriteLn(res.ResString);
end;
WriteLn('Reconstructed string formula: ', parser.BuildFormula);
WriteLn('RPN formula:');
formula := parser.BuildRPNFormula;
for i:=0 to Length(formula)-1 do begin
Write(' Item ', i, ': token ', GetEnumName(TypeInfo(TFEKind), ord(formula[i].ElementKind)));
case formula[i].ElementKind of
fekCell : Write(' / cell: ' +GetCellString(formula[i].Row, formula[i].Col, formula[i].RelFlags));
fekNum : Write(' / number value: ', FloatToStr(formula[i].DoubleValue));
fekString : Write(' / string value: "', formula[i].StringValue, '"');
fekBool : Write(' / boolean value: ', BoolToStr(formula[i].DoubleValue <> 0));
WriteLn('A2: ', parser.Expression);
Write('Result: ');
case res.ResultType of
rtEmpty : WriteLn('--- empty ---');
rtBoolean : WriteLn(BoolToStr(res.ResBoolean, true));
rtFloat : WriteLn(FloatToStr(res.ResFloat));
rtInteger : WriteLn(IntToStr(res.ResInteger));
rtDateTime : WriteLn(FormatDateTime('c', res.ResDateTime));
rtString : WriteLn(res.ResString);
rtError : WriteLn(GetErrorValueStr(res.ResError));
end;
WriteLn;
WriteLn('Reconstructed string formula: ', parser.BuildStringFormula);
formula := parser.RPNFormula;
for i:=0 to Length(formula)-1 do begin
Write(' Item ', i, ': token ', GetEnumName(TypeInfo(TFEKind), ord(formula[i].ElementKind)), ' ', formula[i].FuncName);
case formula[i].ElementKind of
fekCell : Write(' / cell: ' +GetCellString(formula[i].Row, formula[i].Col, formula[i].RelFlags));
fekNum : Write(' / float value: ', FloatToStr(formula[i].DoubleValue));
fekInteger : Write(' / integer value: ', IntToStr(formula[i].IntValue));
fekString : Write(' / string value: "', formula[i].StringValue, '"');
fekBool : Write(' / boolean value: ', BoolToStr(formula[i].DoubleValue <> 0, true));
end;
WriteLn;
end;
finally
parser.Free;
end;
except on E:Exception do
begin
WriteLn('Parser/calculation error: ', E.Message);
raise;
end;
end;
parser := TsSpreadsheetParser.Create(worksheet);
try
try
parser.RPNFormula := formula;
s := parser.BuildStringFormula;
WriteLn('String formula, reconstructed from RPN formula: ', s);
except on E:Exception do
begin
WriteLn('RPN/string formula conversion error: ', E.Message);
raise;
end;
end;
finally
parser.Free;
end;
@ -82,5 +108,6 @@ begin
finally
workbook.Free;
end;
end.

1
components/fpspreadsheet/examples/other/demo_formula_func.lpi
View File

@ -46,6 +46,7 @@
<Unit1>
<Filename Value="financemath.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="financemath"/>
</Unit1>
</Units>
</ProjectOptions>

278
components/fpspreadsheet/examples/other/demo_formula_func.pas
View File

@ -8,7 +8,7 @@
- PMT() (payment)
- NPER() (number of payment periods)
The demo writes an xls file which uses these formulas and then displays
The demo writes a spreadsheet file which uses these formulas and then displays
the result in a console window. (Open the generated file in Excel or
Open/LibreOffice and compare).
}
@ -24,117 +24,118 @@ uses
{$ENDIF}
{$ENDIF}
Classes, SysUtils,
math, fpspreadsheet, xlsbiff8, fpsfunc, financemath;
math, fpspreadsheet, fpsallformats, fpsexprparser, financemath;
{ Base data used in this demonstration }
const
INTEREST_RATE = 0.03; // interest rate per period
NUMBER_PAYMENTS = 10; // number of payment periods
REG_PAYMENT = 1000; // regular payment per period
PRESENT_VALUE = 10000.0; // present value of investment
PAYMENT_WHEN: TPaymentTime = ptEndOfPeriod; // when is the payment made
{------------------------------------------------------------------------------}
{ Adaption of financial functions to usage by fpspreadsheet }
{ The functions are implemented in the unit "financemath.pas". }
{------------------------------------------------------------------------------}
function fpsFV(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var
data: TsArgNumberArray;
procedure fpsFV(var Result: TsExpressionResult; const Args: TsExprParameterArray);
begin
// Pop the argument from the stack. This can be done by means of PopNumberValues
// which brings the values back in the right order and reports an error
// in case of non-numerical values.
if Args.PopNumberValues(NumArgs, false, data, Result) then
// Call the FutureValue function with the NumberValues of the arguments.
Result := CreateNumberArg(FutureValue(
data[0], // interest rate
round(data[1]), // number of payments
data[2], // payment
data[3], // present value
TPaymentTime(round(data[4])) // payment type
));
Result.ResFloat := FutureValue(
ArgToFloat(Args[0]), // interest rate
ArgToInt(Args[1]), // number of payments
ArgToFloat(Args[2]), // payment
ArgToFloat(Args[3]), // present value
TPaymentTime(ArgToInt(Args[4])) // payment type
);
end;
function fpsPMT(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var
data: TsArgNumberArray;
procedure fpsPMT(var Result: TsExpressionResult; const Args: TsExprParameterArray);
begin
if Args.PopNumberValues(NumArgs, false, data, Result) then
Result := CreateNumberArg(Payment(
data[0], // interest rate
round(data[1]), // number of payments
data[2], // present value
data[3], // future value
TPaymentTime(round(data[4])) // payment type
));
Result.ResFloat := Payment(
ArgToFloat(Args[0]), // interest rate
ArgToInt(Args[1]), // number of payments
ArgToFloat(Args[2]), // present value
ArgToFloat(Args[3]), // future value
TPaymentTime(ArgToInt(Args[4])) // payment type
);
end;
function fpsPV(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
// Present value
var
data: TsArgNumberArray;
procedure fpsPV(var Result: TsExpressionResult; const Args: TsExprParameterArray);
begin
if Args.PopNumberValues(NumArgs, false, data, Result) then
Result := CreateNumberArg(PresentValue(
data[0], // interest rate
round(data[1]), // number of payments
data[2], // payment
data[3], // future value
TPaymentTime(round(data[4])) // payment type
));
Result.ResFloat := PresentValue(
ArgToFloat(Args[0]), // interest rate
ArgToInt(Args[1]), // number of payments
ArgToFloat(Args[2]), // payment
ArgToFloat(Args[3]), // future value
TPaymentTime(ArgToInt(Args[4])) // payment type
);
end;
function fpsNPER(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var
data: TsArgNumberArray;
procedure fpsNPER(var Result: TsExpressionResult; const Args: TsExprParameterArray);
begin
if Args.PopNumberValues(NumArgs, false, data, Result) then
Result := CreateNumberArg(NumberOfPeriods(
data[0], // interest rate
data[1], // payment
data[2], // present value
data[3], // future value
TPaymentTime(round(data[4])) // payment type
));
Result.ResFloat := NumberOfPeriods(
ArgToFloat(Args[0]), // interest rate
ArgToFloat(Args[1]), // payment
ArgToFloat(Args[2]), // present value
ArgToFloat(Args[3]), // future value
TPaymentTime(ArgToInt(Args[4])) // payment type
);
end;
function fpsRATE(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var
data: TsArgNumberArray;
procedure fpsRATE(var Result: TsExpressionResult; const Args: TsExprParameterArray);
begin
if Args.PopNumberValues(NumArgs, false, data, Result) then
Result := CreateNumberArg(InterestRate(
round(data[0]), // number of payment periods
data[1], // payment
data[2], // present value
data[3], // future value
TPaymentTime(round(data[4])) // payment type
));
Result.ResFloat := InterestRate(
ArgToInt(Args[0]), // number of payments
ArgToFloat(Args[1]), // payment
ArgToFloat(Args[2]), // present value
ArgToFloat(Args[3]), // future value
TPaymentTime(ArgToInt(Args[4])) // payment type
);
end;
{------------------------------------------------------------------------------}
{ Write xls file comparing our own calculations with Excel result }
{------------------------------------------------------------------------------}
procedure WriteFile(AFileName: String);
const
INTEREST_RATE = 0.03; // interest rate per period
NUMBER_PAYMENTS = 10; // number of payment periods
REG_PAYMENT = 1000; // regular payment per period
PRESENT_VALUE = 10000; // present value of investment
PAYMENT_WHEN: TPaymentTime = ptEndOfPeriod; // when is the payment made
INT_EXCEL_SHEET_FUNC_PV = 56;
INT_EXCEL_SHEET_FUNC_FV = 57;
INT_EXCEL_SHEET_FUNC_NPER = 58;
INT_EXCEL_SHEET_FUNC_PMT = 59;
INT_EXCEL_SHEET_FUNC_RATE = 60;
var
workbook: TsWorkbook;
worksheet: TsWorksheet;
fval, pval, pmtval, nperval, rateval: Double;
formula: String;
fs: TFormatSettings;
begin
{ We have to register our financial functions in fpspreadsheet. Otherwise an
error code would be displayed in the reading part of this demo for these
formula cells. }
RegisterFormulaFunc(fekFV, @fpsFV);
RegisterFormulaFunc(fekPMT, @fpsPMT);
RegisterFormulaFunc(fekPV, @fpsPV);
RegisterFormulaFunc(fekNPER, @fpsNPER);
RegisterFormulaFunc(fekRATE, @fpsRATE);
formula cells.
The 1st parameter is the data type of the function result ('F'=float)
The 2nd parameter shows the data types of the arguments ('F=float, 'I'=integer)
The 3rd parameter is the Excel ID needed when writing to xls files. (see
"OpenOffice Documentation of Microsoft Excel File Format", section 3.11)
The 4th parameter is the address of the function to be used for calculation. }
RegisterFunction('FV', 'F', 'FIFFI', INT_EXCEL_SHEET_FUNC_FV, @fpsFV);
RegisterFunction('PMT', 'F', 'FIFFI', INT_EXCEL_SHEET_FUNC_PMT, @fpsPMT);
RegisterFunction('PV', 'F', 'FIFFI', INT_EXCEL_SHEET_FUNC_PV, @fpsPV);
RegisterFunction('NPER', 'F', 'FFFFI', INT_EXCEL_SHEET_FUNC_NPER, @fpsNPER);
RegisterFunction('RATE', 'F', 'IFFFI', INT_EXCEL_SHEET_FUNC_RATE, @fpsRATE);
// The formula parser requires a point as decimals separator.
fs := DefaultFormatSettings;
fs.DecimalSeparator := '.';
workbook := TsWorkbook.Create;
try
workbook.Options := workbook.Options + [boCalcBeforeSaving];
//workbook.Options := workbook.Options + [boCalcBeforeSaving];
worksheet := workbook.AddWorksheet('Financial');
worksheet.WriteColWidth(0, 40);
@ -167,24 +168,14 @@ begin
worksheet.WriteUTF8Text(9, 0, 'Worksheet calculation using constants');
worksheet.WriteNumberFormat(9, 1, nfCurrency, 2, '$');
worksheet.WriteRPNFormula(9, 1, CreateRPNFormula(
RPNNumber(INTEREST_RATE,
RPNNumber(NUMBER_PAYMENTS,
RPNNumber(REG_PAYMENT,
RPNNumber(PRESENT_VALUE,
RPNNumber(ord(PAYMENT_WHEN),
RPNFunc(fekFV, 5,
nil))))))));
worksheet.WriteNumberFormat(9, 1, nfCurrency, 2, '$');
formula := Format('FV(%f,%d,%f,%f,%d)',
[1.0*INTEREST_RATE, NUMBER_PAYMENTS, 1.0*REG_PAYMENT, 1.0*PRESENT_VALUE, ord(PAYMENT_WHEN)], fs
);
worksheet.WriteFormula(9, 1, formula);
worksheet.WriteUTF8Text(10, 0, 'Worksheet calculation using cell values');
worksheet.WriteNumberFormat(10, 1, nfCurrency, 2, '$');
worksheet.WriteRPNFormula(10, 1, CreateRPNFormula(
RPNCellValue('B2', // interest rate
RPNCellValue('B3', // number of periods
RPNCellValue('B4', // payment
RPNCellValue('B5', // present value
RPNCellValue('B6', // payment at end or at start
RPNFunc(fekFV, 5, // Call Excel's FV formula
nil))))))));
worksheet.WriteFormula(10, 1, 'FV(B2,B3,B4,B5,B6)');
// present value calculation
pval := PresentValue(INTEREST_RATE, NUMBER_PAYMENTS, REG_PAYMENT, fval, PAYMENT_WHEN);
@ -194,25 +185,14 @@ begin
worksheet.WriteCurrency(13, 1, pval, nfCurrency, 2, '$');
worksheet.WriteUTF8Text(14, 0, 'Worksheet calculation using constants');
formula := Format('PV(%f,%d,%f,%f,%d)',
[1.0*INTEREST_RATE, NUMBER_PAYMENTS, 1.0*REG_PAYMENT, fval, ord(PAYMENT_WHEN)], fs
);
worksheet.WriteNumberFormat(14, 1, nfCurrency, 2, '$');
worksheet.WriteRPNFormula(14, 1, CreateRPNFormula(
RPNNumber(INTEREST_RATE,
RPNNumber(NUMBER_PAYMENTS,
RPNNumber(REG_PAYMENT,
RPNNumber(fval,
RPNNumber(ord(PAYMENT_WHEN),
RPNFunc(fekPV, 5,
nil))))))));
worksheet.WriteFormula(14, 1, formula);
Worksheet.WriteUTF8Text(15, 0, 'Worksheet calculation using cell values');
worksheet.WriteNumberFormat(15, 1, nfCurrency, 2, '$');
worksheet.WriteRPNFormula(15, 1, CreateRPNFormula(
RPNCellValue('B2', // interest rate
RPNCellValue('B3', // number of periods
RPNCellValue('B4', // payment
RPNCellValue('B11', // future value
RPNCellValue('B6', // payment at end or at start
RPNFunc(fekPV, 5, // Call Excel's PV formula
nil))))))));
worksheet.WriteFormula(15, 1, 'PV(B2,B3,B4,B11,B6)');
// payments calculation
pmtval := Payment(INTEREST_RATE, NUMBER_PAYMENTS, PRESENT_VALUE, fval, PAYMENT_WHEN);
@ -223,24 +203,13 @@ begin
worksheet.WriteUTF8Text(19, 0, 'Worksheet calculation using constants');
worksheet.WriteNumberFormat(19, 1, nfCurrency, 2, '$');
worksheet.WriteRPNFormula(19, 1, CreateRPNFormula(
RPNNumber(INTEREST_RATE,
RPNNumber(NUMBER_PAYMENTS,
RPNNumber(PRESENT_VALUE,
RPNNumber(fval,
RPNNumber(ord(PAYMENT_WHEN),
RPNFunc(fekPMT, 5,
nil))))))));
formula := Format('PMT(%g,%d,%g,%g,%d)',
[INTEREST_RATE, NUMBER_PAYMENTS, PRESENT_VALUE, fval, ord(PAYMENT_WHEN)], fs
);
worksheet.WriteFormula(19, 1, formula);
Worksheet.WriteUTF8Text(20, 0, 'Worksheet calculation using cell values');
worksheet.WriteNumberFormat(20, 1, nfCurrency, 2, '$');
worksheet.WriteRPNFormula(20, 1, CreateRPNFormula(
RPNCellValue('B2', // interest rate
RPNCellValue('B3', // number of periods
RPNCellValue('B5', // present value
RPNCellValue('B11', // future value
RPNCellValue('B6', // payment at end or at start
RPNFunc(fekPMT, 5, // Call Excel's PMT formula
nil))))))));
worksheet.WriteFormula(20, 1, 'PMT(B2,B3,B5,B11,B6)');
// number of periods calculation
nperval := NumberOfPeriods(INTEREST_RATE, REG_PAYMENT, PRESENT_VALUE, fval, PAYMENT_WHEN);
@ -251,24 +220,13 @@ begin
worksheet.WriteUTF8Text(24, 0, 'Worksheet calculation using constants');
worksheet.WriteNumberFormat(24, 1, nfFixed, 2);
worksheet.WriteRPNFormula(24, 1, CreateRPNFormula(
RPNNumber(INTEREST_RATE,
RPNNumber(REG_PAYMENT,
RPNNumber(PRESENT_VALUE,
RPNNumber(fval,
RPNNumber(ord(PAYMENT_WHEN),
RPNFunc(fekNPER, 5,
nil))))))));
formula := Format('NPER(%g,%g,%g,%g,%d)',
[1.0*INTEREST_RATE, 1.0*REG_PAYMENT, 1.0*PRESENT_VALUE, fval, ord(PAYMENT_WHEN)], fs
);
worksheet.WriteFormula(24, 1, formula);
Worksheet.WriteUTF8Text(25, 0, 'Worksheet calculation using cell values');
worksheet.WriteNumberFormat(25, 1, nfFixed, 2);
worksheet.WriteRPNFormula(25, 1, CreateRPNFormula(
RPNCellValue('B2', // interest rate
RPNCellValue('B4', // payment
RPNCellValue('B5', // present value
RPNCellValue('B11', // future value
RPNCellValue('B6', // payment at end or at start
RPNFunc(fekNPER, 5, // Call Excel's PMT formula
nil))))))));
worksheet.WriteFormula(25, 1, 'NPER(B2,B4,B5,B11,B6)');
// interest rate calculation
rateval := InterestRate(NUMBER_PAYMENTS, REG_PAYMENT, PRESENT_VALUE, fval, PAYMENT_WHEN);
@ -279,26 +237,15 @@ begin
worksheet.WriteUTF8Text(29, 0, 'Worksheet calculation using constants');
worksheet.WriteNumberFormat(29, 1, nfPercentage, 2);
worksheet.WriteRPNFormula(29, 1, CreateRPNFormula(
RPNNumber(NUMBER_PAYMENTS,
RPNNumber(REG_PAYMENT,
RPNNumber(PRESENT_VALUE,
RPNNumber(fval,
RPNNumber(ord(PAYMENT_WHEN),
RPNFunc(fekRATE, 5,
nil))))))));
formula := Format('RATE(%d,%g,%g,%g,%d)',
[NUMBER_PAYMENTS, 1.0*REG_PAYMENT, 1.0*PRESENT_VALUE, fval, ord(PAYMENT_WHEN)], fs
);
worksheet.WriteFormula(29, 1, formula);
Worksheet.WriteUTF8Text(30, 0, 'Worksheet calculation using cell values');
worksheet.WriteNumberFormat(30, 1, nfPercentage, 2);
worksheet.WriteRPNFormula(30, 1, CreateRPNFormula(
RPNCellValue('B3', // number of payments
RPNCellValue('B4', // payment
RPNCellValue('B5', // present value
RPNCellValue('B11', // future value
RPNCellValue('B6', // payment at end or at start
RPNFunc(fekRATE, 5, // Call Excel's PMT formula
nil))))))));
worksheet.WriteFormula(30, 1, 'RATE(B3,B4,B5,B11,B6)');
workbook.WriteToFile(AFileName, sfExcel8, true);
workbook.WriteToFile(AFileName, true);
finally
workbook.Free;
@ -317,9 +264,8 @@ var
begin
workbook := TsWorkbook.Create;
try
workbook.Options := workbook.Options + [boReadFormulas];
workbook.ReadFromFile(AFilename, sfExcel8);
workbook.Options := workbook.Options + [boReadFormulas, boAutoCalc];
workbook.ReadFromFile(AFilename);
worksheet := workbook.GetFirstWorksheet;
// Write all cells with contents to the console
@ -340,19 +286,27 @@ begin
WriteLn(s1+': ':50, s2);
end;
WriteLn;
WriteLn('Press [ENTER] to close...');
ReadLn;
finally
workbook.Free;
end;
end;
const
TestFile='test_fv.xls';
TestFile='test_user_formula.xlsx'; // Format depends on extension selected
// !!!! ods not working yet !!!!
begin
WriteLn('This demo registers user-defined functions for financial calculations');
WriteLn('and writes and reads the corresponding spreadsheet file.');
WriteLn;
WriteFile(TestFile);
ReadFile(TestFile);
WriteLn;
WriteLn('Open the file in Excel or OpenOffice/LibreOffice.');
WriteLn('Press [ENTER] to close...');
ReadLn;
end.

19
components/fpspreadsheet/examples/other/demo_recursive_calc.pas
View File

@ -21,7 +21,7 @@ var
workbook: TsWorkbook;
worksheet: TsWorksheet;
const
OutputFile='test_calc.xls';
OutputFile='test_recursive.xls';
begin
writeln('Starting program.');
@ -35,26 +35,33 @@ begin
// A1
worksheet.WriteUTF8Text(0, 0, '=B2+1');
// B1
worksheet.WriteFormula(0, 1, 'B2+1');
{
worksheet.WriteRPNFormula(0, 1, CreateRPNFormula(
RPNCellValue('B2',
RPNNumber(1,
RPNInteger(1,
RPNFunc(fekAdd, nil)))));
}
// A2
worksheet.WriteUTF8Text(1, 0, '=B3+1');
// B2
worksheet.WriteFormula(1, 1, 'B3+1');
{
worksheet.WriteRPNFormula(1, 1, CreateRPNFormula(
RPNCellValue('B3',
RPNNumber(1,
RPNInteger(1,
RPNFunc(fekAdd, nil)))));
}
// A3
worksheet.WriteUTF8Text(2, 0, '(not dependent)');
// B3
worksheet.WriteNumber(2, 1, 1);
workbook.WriteToFile(OutputFile, sfExcel8, true);
writeln('Finished. Please open "'+OutputFile+'" in your spreadsheet program.');
writeln('Finished.');
writeln;
writeln('Please open "'+OutputFile+'" in "fpsgrid".');
writeLn('It should show calculation results in cells B1 and B2.');
finally
workbook.Free;
end;

4
components/fpspreadsheet/examples/other/demo_virtualmode_write.lpr
View File

@ -97,9 +97,9 @@ begin
{ In case of a database, you would open the dataset before calling this: }
t := Now;
workbook.WriteToFile('test_virtual.ods', sfOpenDocument, true);
//workbook.WriteToFile('test_virtual.ods', sfOpenDocument, true);
//workbook.WriteToFile('test_virtual.xlsx', sfOOXML, true);
//workbook.WriteToFile('test_virtual.xls', sfExcel8, true);
workbook.WriteToFile('test_virtual.xls', sfExcel8, true);
//workbook.WriteToFile('test_virtual.xls', sfExcel5, true);
//workbook.WriteToFile('test_virtual.xls', sfExcel2, true);
t := Now - t;

45
components/fpspreadsheet/examples/other/demo_write_formula.pas
View File

@ -21,7 +21,7 @@ var
procedure WriteFirstWorksheet();
var
MyFormula: TsFormula;
MyFormula: String;
MyRPNFormula: TsRPNFormula;
MyCell: PCell;
begin
@ -37,40 +37,41 @@ begin
Myworksheet.WriteNumber(3, 4, 300); // E4
MyWorksheet.WriteNumber(4, 4, 250); // E5
// =Sum(E2:e5)
MyWorksheet.WriteUTF8Text(1, 0, '=Sum(E2:e5)'); // A2
//
MyFormula.FormulaStr := '=Sum(E2:e5)';
MyFormula.DoubleValue := 0.0;
// =Sum(E2:E5)
MyWorksheet.WriteUTF8Text(1, 0, '=Sum(E2:E5)'); // A2
MyFormula := '=Sum(E2:E5)';
MyWorksheet.WriteFormula(1, 1, MyFormula); // B2
//
MyWorksheet.WriteRPNFormula(1, 2, CreateRPNFormula( // C2
RPNCellRange('E2:E5',
RPNFunc(fekSum, 1, nil))));
RPNFunc('SUM', 1,
nil))));
// Write the formula =ABS(E1)
MyWorksheet.WriteUTF8Text(2, 0, '=ABS(E1)'); // A3
//
MyWorksheet.WriteFormula(2, 1, 'ABS(E1)'); // B3
MyWorksheet.WriteRPNFormula(2, 2, CreateRPNFormula( // C3
RPNCellValue('E1',
RPNFunc(fekAbs, nil))));
RPNFunc('ABS',
nil))));
// Write the formula =4+5
MyWorksheet.WriteUTF8Text(3, 0, '=4+5'); // A4
//
MyWorksheet.WriteFormula(3, 1, '=4+5'); // B4
MyWorksheet.WriteRPNFormula(3, 2, CreateRPNFormula( //C4
RPNNumber(4.0,
RPNNumber(5.0,
RPNFunc(fekAdd, nil)))));
RPNFunc(fekAdd,
nil)))));
(*
// Write a shared formula "=E1+100" to the cell range F1:F5
// Please note that shared formulas are not written by sfOOXML and sfOpenDocument formats.
MyCell := MyWorksheet.WriteRPNFormula(0, 5, CreateRPNFormula(
RPNCellOffset(0, -1, [rfRelRow, rfRelCol],
RPNNumber(100,
RPNFunc(fekAdd, nil)))));
RPNFunc(fekAdd,
nil)))));
MyWorksheet.UseSharedFormula('F1:F5', MyCell);
*)
end;
procedure WriteSecondWorksheet();
@ -98,15 +99,17 @@ begin
// Create the spreadsheet
MyWorkbook := TsWorkbook.Create;
try
WriteFirstWorksheet();
WriteSecondWorksheet();
WriteFirstWorksheet();
// Save the spreadsheet to a file
MyWorkbook.WriteToFile(MyDir + TestFile, sfExcel8, True);
WriteSecondWorksheet();
finally
MyWorkbook.Free;
end;
// Save the spreadsheet to a file
MyWorkbook.WriteToFile(MyDir + TestFile, sfExcel8, True);
// MyWorkbook.WriteToFile(MyDir + 'test_formula.odt', sfOpenDocument, False);
MyWorkbook.Free;
writeln('Finished. Please open "'+Testfile+'" in your spreadsheet program.');
end.

22
components/fpspreadsheet/examples/spready/mainform.pas
View File

@ -727,10 +727,15 @@ end;
procedure TForm1.EdFormulaEditingDone(Sender: TObject);
var
r, c: Cardinal;
s: String;
begin
r := WorksheetGrid.GetWorksheetRow(WorksheetGrid.Row);
c := WorksheetGrid.GetWorksheetCol(WorksheetGrid.Col);
WorksheetGrid.Worksheet.WriteCellValueAsString(r, c, EdFormula.Text);
s := EdFormula.Text;
if (s <> '') and (s[1] = '=') then
WorksheetGrid.Worksheet.WriteFormula(r, c, Copy(s, 2, Length(s)))
else
WorksheetGrid.Worksheet.WriteCellValueAsString(r, c, EdFormula.Text);
end;
procedure TForm1.EdFrozenColsChange(Sender: TObject);
@ -895,8 +900,10 @@ begin
cell := WorksheetGrid.Worksheet.FindCell(r, c);
if cell <> nil then begin
s := WorksheetGrid.Worksheet.ReadFormulaAsString(cell);
if s <> '' then
EdFormula.Text := s
if s <> '' then begin
if s[1] <> '=' then s := '=' + s;
EdFormula.Text := s;
end
else
case cell^.ContentType of
cctNumber:
@ -993,12 +1000,9 @@ begin
then Strings.Add('ErrorValue=')
else Strings.Add(Format('ErrorValue=%s', [
GetEnumName(TypeInfo(TsErrorValue), ord(ACell^.ErrorValue)) ]));
if (ACell=nil) or (Length(ACell^.RPNFormulaValue) = 0)
then Strings.Add('RPNFormulaValue=')
else Strings.Add(Format('RPNFormulaValue=(%d tokens)', [Length(ACell^.RPNFormulaValue)]));
if (ACell=nil) or (Length(ACell^.FormulaValue.FormulaStr)=0)
then Strings.Add('FormulaValue.FormulaStr=')
else Strings.Add(Format('FormulaValue.FormulaStr="%s"', [ACell^.FormulaValue.FormulaStr]));
if (ACell=nil) or (Length(ACell^.FormulaValue)=0)
then Strings.Add('FormulaValue=')
else Strings.Add(Format('FormulaValue="%s"', [ACell^.FormulaValue]));
if (ACell=nil) or (ACell^.SharedFormulaBase=nil)
then Strings.Add('SharedFormulaBase=')
else Strings.Add(Format('SharedFormulaBase=%s', [GetCellString(

12
components/fpspreadsheet/examples/wikitabledemo/wikitableread.lpi
View File

@ -31,7 +31,7 @@
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LazUtils"/>
<PackageName Value="laz_fpspreadsheet"/>
</Item1>
</RequiredPackages>
<Units Count="1">
@ -44,23 +44,13 @@
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="wikitableread"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="..\.."/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Debugging>
<UseExternalDbgSyms Value="True"/>
</Debugging>
</Linking>
</CompilerOptions>
</CONFIG>

2
components/fpspreadsheet/examples/wikitabledemo/wikitableread.lpr
View File

@ -11,7 +11,7 @@ program wikitableread;
uses
Classes, SysUtils, fpspreadsheet, wikitable,
fpsutils;
laz_fpspreadsheet, fpsutils;
var
MyWorkbook: TsWorkbook;

14
components/fpspreadsheet/examples/wikitabledemo/wikitablewrite.lpi
View File

@ -32,7 +32,7 @@
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LazUtils"/>
<PackageName Value="laz_fpspreadsheet"/>
</Item1>
</RequiredPackages>
<Units Count="1">
@ -45,22 +45,14 @@
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="wikitablewrite"/>
</Target>
<SearchPaths>
<OtherUnitFiles Value="..\.."/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
<OtherUnitFiles Value=".."/>
<SrcPath Value=".."/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Debugging>
<UseExternalDbgSyms Value="True"/>
</Debugging>
</Linking>
</CompilerOptions>
</CONFIG>

3
components/fpspreadsheet/examples/wikitabledemo/wikitablewrite.lpr
View File

@ -10,7 +10,8 @@ program wikitablewrite;
{$mode delphi}{$H+}
uses
Classes, SysUtils, fpspreadsheet, wikitable;
Classes, SysUtils, fpspreadsheet, wikitable,
laz_fpspreadsheet;
const
Str_First = 'First';

4997
components/fpspreadsheet/fpsexprparser.pas
View File

File diff suppressed because it is too large Load Diff

2
components/fpspreadsheet/fpsfunc.pas
View File

@ -2182,7 +2182,7 @@ begin
end;
{ Lookup / refernence functions }
{ Lookup / reference functions }
function fpsCOLUMN(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
{ COLUMN( [reference] )

4
components/fpspreadsheet/fpsopendocument.pas
View File

@ -1272,7 +1272,7 @@ begin
// Read formula, store in the cell's FormulaValue.FormulaStr
formula := GetAttrValue(ACellNode, 'table:formula');
if formula <> '' then Delete(formula, 1, 3); // delete "of:"
cell^.FormulaValue.FormulaStr := formula;
cell^.FormulaValue := formula;
// Read formula results
// ... number value
@ -3590,7 +3590,7 @@ begin
AppendToStream(AStream, Format(
'<table:table-cell table:formula="%s" %s>' +
'</table:table-cell>', [
ACell^.FormulaValue.FormulaStr, lStyle
ACell^.FormulaValue, lStyle
]));
end;

726
components/fpspreadsheet/fpspreadsheet.pas
View File

File diff suppressed because it is too large Load Diff

4
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -2975,10 +2975,6 @@ end;
initial column widths and row heights.
}
procedure TsCustomWorksheetGrid.Setup;
var
i: Integer;
lCol: PCol;
lRow: PRow;
begin
if (FWorksheet = nil) or (FWorksheet.GetCellCount = 0) then begin
if ShowHeaders then begin

2
components/fpspreadsheet/fpsutils.pas
View File

@ -483,6 +483,8 @@ function ParseCellString(const AStr: String; out ACellRow, ACellCol: Cardinal;
while (i <= Length(AStr)) do begin
if (UpCase(AStr[i]) in LETTERS) then begin
ACellCol := Cardinal(ord(UpCase(AStr[i])) - ord('A')) + 1 + ACellCol * 26;
if ACellCol >= MAX_COL_COUNT then // too many columns (dropping this limitation could cause overflow if a too long string is passed
exit;
inc(i);
end
else

1
components/fpspreadsheet/reference/BIFFExplorer/BIFFExplorer.lpi
View File

@ -155,6 +155,7 @@
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="beMain"/>
</Unit5>
<Unit6>
<Filename Value="beutils.pas"/>

146
components/fpspreadsheet/reference/BIFFExplorer/bebiffgrid.pas
View File

@ -12,18 +12,6 @@ type
TBIFFDetailsEvent = procedure(Sender: TObject; ADetails: TStrings) of object;
TBIFF2RichTextRun = packed record // valid up to BIFF5
IndexToFirstChar: Byte;
FontIndex: Byte;
end;
TBIFF8RichTextRun = packed record
IndexToFirstChar: Word;
FontIndex: Word;
end;
TRichTextRuns = array of TBiff8RichTextRun;
TBIFFGrid = class(TStringGrid)
private
FRecType: Word;
@ -126,11 +114,7 @@ type
procedure Click; override;
procedure DoExtractDetails;
procedure ExtractString(ABufIndex: Integer; ALenBytes: Byte; AUnicode: Boolean;
out AString: String; out ANumBytes: Integer; out AOffsetToAsianPhoneticBlock: Integer;
out AsianPhoneticBlockSize: DWord; out ARichTextRuns: TRichTextRuns;
AIgnoreCompressedFlag: Boolean = false); overload;
procedure ExtractString(ABufIndex: Integer; ALenBytes: Byte; AUnicode: Boolean;
out AString: String; out ANumBytes: Integer; AIgnoreCompressedFlag: Boolean = false); overload;
out AString: String; out ANumBytes: Integer; IgnoreCompressedFlag: Boolean = false);
procedure PopulateGrid;
procedure ShowInRow(var ARow: Integer; var AOffs: LongWord; ASize: Word; AValue,ADescr: String);
procedure ShowRowColData(var ABufIndex: LongWord);
@ -147,7 +131,7 @@ type
implementation
uses
StrUtils, Math, lazutf8,
StrUtils, Math,
fpsutils,
beBIFFUtils;
@ -198,32 +182,19 @@ end;
procedure TBIFFGrid.ExtractString(ABufIndex: Integer; ALenBytes: Byte; AUnicode: Boolean;
out AString: String; out ANumBytes: Integer; out AOffsetToAsianPhoneticBlock: Integer;
out AsianPhoneticBlockSize: DWord; out ARichTextRuns: TRichTextRuns;
AIgnoreCompressedFlag: Boolean = false);
out AString: String; out ANumBytes: Integer; IgnoreCompressedFlag: Boolean = false);
var
i: Integer;
ls: Integer;
sa: ansiString;
sw: WideString;
w: Word;
optn: Byte;
bytesPerChar: Byte;
containsAsianPhonetics: Boolean;
containsRichText: Boolean;
richTextCount: Word = 0;
savedBufIndex: Integer;
begin
AString := '';
ANumBytes := 0;
AOffsetToAsianPhoneticBlock := -1;
AsianPhoneticBlockSize := 0;
SetLength(ARichTextRuns, 0);
if Length(FBuffer) = 0 then
if Length(FBuffer) = 0 then begin
AString := '';
ANumBytes := 0;
exit;
savedBufIndex := ABufIndex;
end;
if ALenBytes = 1 then
ls := FBuffer[ABufIndex]
else begin
@ -232,48 +203,18 @@ begin
end;
if AUnicode then begin
optn := FBuffer[ABufIndex + ALenBytes];
if (optn and $01 = 0) and (not AIgnoreCompressedFlag) then
bytesPerChar := 1
else
bytesPerChar := 2;
containsAsianPhonetics := (optn and $04 <> 0);
containsRichText := (optn and $08 <> 0);
ABufIndex := ABufIndex + ALenBytes + 1;
if containsRichText then begin
Move(FBuffer[ABufIndex], richTextCount, 2);
richTextCount := WordLEToN(richTextCount);
inc(ABufIndex, 2);
end;
if containsAsianPhonetics then begin
Move(FBuffer[ABufIndex], AsianPhoneticBlockSize, 4);
AsianPhoneticBlockSize := DWordLEToN(AsianPhoneticBlockSize);
inc(ABufIndex, 4);
end;
if bytesPerChar = 1 then begin
if (optn and $01 = 0) and (not IgnoreCompressedFlag)
then begin // compressed --> 1 byte per character
SetLength(sa, ls);
Move(FBuffer[ABufIndex], sa[1], ls*SizeOf(AnsiChar));
inc(ABufIndex, ls*SizeOf(AnsiChar));
AString := AnsiToUTF8(sa);
ANumbytes := ls*SizeOf(AnsiChar) + ALenBytes + 1;
Move(FBuffer[ABufIndex + ALenBytes + 1], sa[1], ls*SizeOf(AnsiChar));
AString := sa;
end else begin
SetLength(sw, ls);
Move(FBuffer[ABufIndex], sw[1], ls*SizeOf(WideChar));
inc(ABufIndex, ls*SizeOf(WideChar));
ANumBytes := ls*SizeOf(WideChar) + ALenBytes + 1;
Move(FBuffer[ABufIndex + ALenBytes + 1], sw[1], ls*SizeOf(WideChar));
AString := UTF8Encode(WideStringLEToN(sw));
end;
if containsRichText then begin
SetLength(ARichTextRuns, richTextCount);
Move(FBuffer[ABufIndex], ARichTextRuns[0], richTextCount*SizeOf(TBiff8RichTextRun));
for i:=0 to richTextCount-1 do begin
ARichTextRuns[i].IndexToFirstchar := WordLEToN(ARichTextRuns[i].IndexToFirstChar);
ARichTextRuns[i].FontIndex := WordLEToN(ARichTextRuns[i].FontIndex);
end;
inc(ABufIndex, richTextCount*SizeOf(word));
end;
if containsAsianPhonetics then begin
AOffsetToAsianPhoneticBlock := ABufIndex;
inc(ABufIndex, AsianPhoneticBlockSize);
end;
ANumBytes := ABufIndex - savedBufIndex;
end else begin
SetLength(sa, ls);
ANumBytes := ls*SizeOf(AnsiChar) + ALenBytes;
@ -282,17 +223,6 @@ begin
end;
end;
procedure TBIFFGrid.ExtractString(ABufIndex: Integer; ALenBytes: Byte; AUnicode: Boolean;
out AString: String; out ANumBytes: Integer; AIgnoreCompressedFlag: Boolean = false);
var
asianPhoneticBlockOffset: Integer;
asianPhoneticBlockSize: DWord;
richTextRuns: TRichTextRuns;
begin
ExtractString(ABufIndex, ALenBytes, AUnicode, AString, ANumBytes,
asianPhoneticBlockOffset, asianPhoneticBlockSize, richTextRuns,
AIgnoreCompressedFlag);
end;
function TBIFFGrid.GetStringType: String;
begin
@ -1575,7 +1505,6 @@ begin
'(relict of BIFF5)');
end else begin
ExtractString(FBufferIndex, 2, true, s, numBytes);
if Row = FCurrRow then begin
FDetails.Add('Encoded URL without sheet name:'#13);
case s[1] of
@ -4225,12 +4154,7 @@ var
numBytes: Integer;
s: String;
total1, total2: DWord;
i, j: Integer;
asianPhoneticBlockOffset: Integer;
asianPhoneticBlockSize: DWord;
richTextRuns: TRichTextRuns;
dw: DWord;
b: Byte;
i: Integer;
begin
numBytes := 4;
Move(FBuffer[FBufferIndex], total1, numBytes);
@ -4246,47 +4170,9 @@ begin
'Number of following strings');
for i:=1 to total2 do begin
ExtractString(FBufferIndex, 2, true, s, numBytes, asianPhoneticBlockOffset,
asianPhoneticBlockSize, richTextRuns);
if FFormat = sfExcel8 then begin
if Row = FCurrRow then begin
FDetails.Add('Wide string info:'#13);
FDetails.Add('2 length bytes: ' + IntToStr(UTF8Length(s)));
b := FBuffer[FBufferIndex+2];
FDetails.Add('Options byte: ' + IntToStr(b));
if b and $01 = 0
then FDetails.Add(' Bit 1 = 0: compressed characters (8-bit characters)')
else FDetails.Add(' Bit 1 = 1: uncompressed characters (16-bit characters)');
if b and $04 = 0
then FDetails.Add(' Bit 4 = 0: Does not contain Asian phonetic settings')
else FDetails.Add(' Bit 4 = 1: Contains Asian phonetic settings');
if b and $08 = 0
then FDetails.Add(' Bit 8 = 0: Does not contain Rich-Text settings')
else FDetails.Add(' Bit 8 = 1: Contains Rich-Text settings');
if Length(richTextRuns) > 0 then begin
FDetails.Add('Rich-Text information (2 bytes):');
FDetails.Add(' ' +IntToStr(Length(richTextRuns)) + ' Rich-Text runs');
end;
if asianPhoneticBlockSize > 0 then begin
FDetails.Add('Asian phonetic block size information (4 bytes): ');
FDetails.Add(' Block size: ' + IntToStr(AsianPhoneticBlockSize) + ' bytes');
end;
FDetails.Add('String text: ' + s);
if Length(richTextRuns)>0 then begin
FDetails.Add('Rich text runs:');
for j:=0 to High(richTextRuns) do
FDetails.Add(Format(' Rich text run #%d: binary data $%.4x --> index of first formatted character %d, font index %d',
[j, DWord(richTextRuns[j]), richTextRuns[j].IndexToFirstChar, richTextRuns[j].FontIndex]));
end;
if asianPhoneticBlockSize>0 then begin
FDetails.Add('Asian phonetic block:');
FDetails.Add(' Size: ' + IntToStr(asianPhoneticBlockSize));
FDetails.Add(' (not decoded)');
end;
end;
ExtractString(FBufferIndex, 2, true, s, numBytes);
ShowInRow(FCurrRow, FBufferIndex, numBytes, s, Format('Shared string #%d', [i]));
end;
end;
end;

5
components/fpspreadsheet/tests/errortests.pas
View File

@ -61,15 +61,14 @@ var
row, col: Cardinal;
row1, row2: Cardinal;
col1, col2: Cardinal;
formula: TsFormula;
formula: string;
s: String;
TempFile: String;
ErrList: TStringList;
newColor: TsColor;
expected: integer;
begin
formula.FormulaStr := '=A1';
formula.DoubleValue := 0.0;
formula := '=A1';
ErrList := TStringList.Create;
try

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

@ -17,7 +17,7 @@ uses
// Not using Lazarus package as the user may be working with multiple versions
// Instead, add .. to unit search path
Classes, SysUtils, fpcunit, testutils, testregistry,
fpsallformats, fpspreadsheet, fpsfunc,
fpsallformats, fpspreadsheet, fpsexprparser,
xlsbiff8 {and a project requirement for lclbase for utf8 handling},
testsutility;
@ -31,27 +31,42 @@ type
procedure SetUp; override;
procedure TearDown; override;
// Test formula strings
procedure TestWriteReadFormulaStrings(AFormat: TsSpreadsheetFormat);
procedure TestWriteReadFormulaStrings(AFormat: TsSpreadsheetFormat;
UseRPNFormula: Boolean);
// Test calculation of rpn formulas
procedure TestCalcRPNFormulas(AFormat: TsSpreadsheetformat);
procedure TestCalcFormulas(AFormat: TsSpreadsheetformat; UseRPNFormula: Boolean);
published
// Writes out numbers & reads back.
// If previous read tests are ok, this effectively tests writing.
{ BIFF2 Tests }
procedure TestWriteRead_BIFF2_FormulaStrings;
procedure Test_Write_Read_FormulaStrings_BIFF2;
{ BIFF5 Tests }
procedure TestWriteRead_BIFF5_FormulaStrings;
procedure Test_Write_Read_FormulaStrings_BIFF5;
{ BIFF8 Tests }
procedure TestWriteRead_BIFF8_FormulaStrings;
procedure Test_Write_Read_FormulaStrings_BIFF8;
{ OOXML Tests }
procedure Test_Write_Read_FormulaStrings_OOXML;
// Writes out and calculates formulas, read back
// Writes out and calculates rpn formulas, read back
{ BIFF2 Tests }
procedure TestWriteRead_BIFF2_CalcRPNFormula;
procedure Test_Write_Read_CalcRPNFormula_BIFF2;
{ BIFF5 Tests }
procedure TestWriteRead_BIFF5_CalcRPNFormula;
procedure Test_Write_Read_CalcRPNFormula_BIFF5;
{ BIFF8 Tests }
procedure TestWriteRead_BIFF8_CalcRPNFormula;
procedure Test_Write_Read_CalcRPNFormula_BIFF8;
{ OOXML Tests }
procedure Test_Write_Read_CalcRPNFormula_OOXML;
// Writes out and calculates string formulas, read back
{ BIFF2 Tests }
procedure Test_Write_Read_CalcStringFormula_BIFF2;
{ BIFF5 Tests }
procedure Test_Write_Read_CalcStringFormula_BIFF5;
{ BIFF8 Tests }
procedure Test_Write_Read_CalcStringFormula_BIFF8;
{ OOXML Tests }
procedure Test_Write_Read_CalcStringFormula_OOXML;
end;
implementation
@ -59,6 +74,18 @@ implementation
uses
math, typinfo, lazUTF8, fpsUtils, rpnFormulaUnit;
var
// Array containing the "true" results of the formulas, for comparison
SollValues: array of TsExpressionResult;
// Helper for statistics tests
const
STATS_NUMBERS: Array[0..4] of Double = (1.0, 1.1, 1.2, 0.9, 0.8);
var
numberArray: array[0..4] of Double;
{ TSpreadWriteReadFormatTests }
procedure TSpreadWriteReadFormulaTests.SetUp;
@ -71,7 +98,10 @@ begin
inherited TearDown;
end;
procedure TSpreadWriteReadFormulaTests.TestWriteReadFormulaStrings(AFormat: TsSpreadsheetFormat);
procedure TSpreadWriteReadFormulaTests.TestWriteReadFormulaStrings(
AFormat: TsSpreadsheetFormat; UseRPNFormula: Boolean);
{ If UseRPNFormula is true the test formulas are generated from RPN formulas.
Otherwise they are generated from string formulas. }
const
SHEET = 'Sheet1';
var
@ -79,20 +109,29 @@ var
MyWorkbook: TsWorkbook;
Row: Integer;
TempFile: string; //write xls/xml to this file and read back from it
formula: String;
expected: String;
actual: String;
cell: PCell;
cellB1: Double;
cellB2: Double;
number: Double;
s: String;
hr, min, sec, msec: Word;
k: Integer;
begin
TempFile := GetTempFileName;
// Create test workbook
MyWorkbook := TsWorkbook.Create;
try
MyWorkbook.Options := MyWorkbook.Options + [boCalcBeforeSaving];
MyWorkSheet:= MyWorkBook.AddWorksheet(SHEET);
// Write out all test formulas
// All formulas are in column B
WriteRPNFormulaSamples(MyWorksheet, AFormat, true);
{$I testcases_calcrpnformula.inc}
// WriteRPNFormulaSamples(MyWorksheet, AFormat, true, UseRPNFormula);
MyWorkBook.WriteToFile(TempFile, AFormat, true);
finally
MyWorkbook.Free;
@ -113,8 +152,8 @@ begin
for Row := 0 to MyWorksheet.GetLastRowIndex do
begin
cell := MyWorksheet.FindCell(Row, 1);
if (cell <> nil) and (Length(cell^.RPNFormulaValue) > 0) then begin
actual := MyWorksheet.ReadRPNFormulaAsString(cell);
if HasFormula(cell) then begin
actual := MyWorksheet.ReadFormulaAsString(cell);
expected := MyWorksheet.ReadAsUTF8Text(Row, 0);
CheckEquals(expected, actual, 'Test read formula mismatch, cell '+CellNotation(MyWorkSheet,Row,1));
end;
@ -126,40 +165,46 @@ begin
end;
end;
procedure TSpreadWriteReadFormulaTests.TestWriteRead_BIFF2_FormulaStrings;
procedure TSpreadWriteReadFormulaTests.Test_Write_Read_FormulaStrings_BIFF2;
begin
TestWriteReadFormulaStrings(sfExcel2);
TestWriteReadFormulaStrings(sfExcel2, true);
end;
procedure TSpreadWriteReadFormulaTests.TestWriteRead_BIFF5_FormulaStrings;
procedure TSpreadWriteReadFormulaTests.Test_Write_Read_FormulaStrings_BIFF5;
begin
TestWriteReadFormulaStrings(sfExcel5);
TestWriteReadFormulaStrings(sfExcel5, true);
end;
procedure TSpreadWriteReadFormulaTests.TestWriteRead_BIFF8_FormulaStrings;
procedure TSpreadWriteReadFormulaTests.Test_Write_Read_FormulaStrings_BIFF8;
begin
TestWriteReadFormulaStrings(sfExcel8);
TestWriteReadFormulaStrings(sfExcel8, true);
end;
procedure TSpreadWriteReadFormulaTests.Test_Write_Read_FormulaStrings_OOXML;
begin
TestWriteReadFormulaStrings(sfOOXML, true);
end;
{ Test calculation of rpn formulas }
{ Test calculation of formulas }
procedure TSpreadWriteReadFormulaTests.TestCalcRPNFormulas(AFormat: TsSpreadsheetFormat);
procedure TSpreadWriteReadFormulaTests.TestCalcFormulas(AFormat: TsSpreadsheetFormat;
UseRPNFormula: Boolean);
{ If UseRPNFormula is TRUE, the test formulas are generated from RPN syntax,
otherwise string formulas are used. }
const
SHEET = 'Sheet1';
STATS_NUMBERS: Array[0..4] of Double = (1.0, 1.1, 1.2, 0.9, 0.8);
var
MyWorksheet: TsWorksheet;
MyWorkbook: TsWorkbook;
Row: Integer;
TempFile: string; //write xls/xml to this file and read back from it
actual: TsArgument;
expected: TsArgument;
actual: TsExpressionResult;
expected: TsExpressionResult;
cell: PCell;
sollValues: array of TsArgument;
sollValues: array of TsExpressionResult;
formula: String;
s: String;
t: TTime;
hr,min,sec,msec: Word;
ErrorMargin: double;
k: Integer;
@ -168,7 +213,8 @@ var
the formula calculation as well. The next variables, along with STATS_NUMBERS
above, hold the arguments for the direction function calls. }
number: Double;
numberArray: array[0..4] of Double;
cellB1: Double;
cellB2: Double;
begin
ErrorMargin:=0; //1.44E-7;
//1.44E-7 for SUMSQ formula
@ -200,6 +246,7 @@ begin
// Open the workbook
MyWorkbook := TsWorkbook.Create;
try
MyWorkbook.Options := Myworkbook.Options + [boReadFormulas];
MyWorkbook.ReadFromFile(TempFile, AFormat);
if AFormat = sfExcel2 then
MyWorksheet := MyWorkbook.GetFirstWorksheet
@ -214,15 +261,24 @@ begin
cell := MyWorksheet.FindCell(Row, 1);
if (cell = nil) then
fail('Error in test code: Failed to get cell ' + CellNotation(MyWorksheet, Row, 1));
case cell^.ContentType of
cctBool : actual := CreateBoolArg(cell^.BoolValue);
cctNumber : actual := CreateNumberArg(cell^.NumberValue);
cctError : actual := CreateErrorArg(cell^.ErrorValue);
cctUTF8String : actual := CreateStringArg(cell^.UTF8StringValue);
cctBool : actual := BooleanResult(cell^.BoolValue);
cctNumber : actual := FloatResult(cell^.NumberValue);
cctDateTime : actual := DateTimeResult(cell^.DateTimeValue);
cctUTF8String : actual := StringResult(cell^.UTF8StringValue);
cctError : actual := ErrorResult(cell^.ErrorValue);
cctEmpty : actual := EmptyResult;
else fail('ContentType not supported');
end;
expected := SollValues[row];
CheckEquals(ord(expected.ArgumentType), ord(actual.ArgumentType),
// Cell does not store integers!
if expected.ResultType = rtInteger then expected := FloatResult(expected.ResInteger);
CheckEquals(
GetEnumName(TypeInfo(TsExpressionResult), ord(expected.ResultType)),
GetEnumName(TypeInfo(TsExpressionResult), ord(actual.ResultType)),
'Test read calculated formula data type mismatch, formula "' + formula +
'", cell '+CellNotation(MyWorkSheet,Row,1));
@ -231,22 +287,22 @@ begin
// the file value in the same second. Therefore we neglect the milliseconds.
if formula = '=NOW()' then begin
// Round soll value to seconds
DecodeTime(expected.NumberValue, hr,min,sec,msec);
expected.NumberValue := EncodeTime(hr, min, sec, 0);
DecodeTime(expected.ResDateTime, hr,min,sec,msec);
expected.ResDateTime := EncodeTime(hr, min, sec, 0);
// Round formula value to seconds
DecodeTime(actual.NumberValue, hr,min,sec,msec);
actual.NumberValue := EncodeTime(hr,min,sec,0);
DecodeTime(actual.ResDateTime, hr,min,sec,msec);
actual.ResDateTime := EncodeTime(hr,min,sec,0);
end;
case actual.ArgumentType of
atBool:
CheckEquals(BoolToStr(expected.BoolValue), BoolToStr(actual.BoolValue),
case actual.ResultType of
rtBoolean:
CheckEquals(BoolToStr(expected.ResBoolean), BoolToStr(actual.ResBoolean),
'Test read calculated formula result mismatch, formula "' + formula +
'", cell '+CellNotation(MyWorkSheet,Row,1));
atNumber:
rtFloat:
{$if (defined(mswindows)) or (FPC_FULLVERSION>=20701)}
// FPC 2.6.x and trunk on Windows need this, also FPC trunk on Linux x64
CheckEquals(expected.NumberValue, actual.NumberValue, ErrorMargin,
CheckEquals(expected.ResFloat, actual.ResFloat, ErrorMargin,
'Test read calculated formula result mismatch, formula "' + formula +
'", cell '+CellNotation(MyWorkSheet,Row,1));
{$else}
@ -255,14 +311,14 @@ begin
'Test read calculated formula result mismatch, formula "' + formula +
'", cell '+CellNotation(MyWorkSheet,Row,1));
{$endif}
atString:
CheckEquals(expected.StringValue, actual.StringValue,
rtString:
CheckEquals(expected.ResString, actual.ResString,
'Test read calculated formula result mismatch, formula "' + formula +
'", cell '+CellNotation(MyWorkSheet,Row,1));
atError:
rtError:
CheckEquals(
GetEnumName(TypeInfo(TsErrorValue), ord(expected.ErrorValue)),
GetEnumname(TypeInfo(TsErrorValue), ord(actual.ErrorValue)),
GetEnumName(TypeInfo(TsErrorValue), ord(expected.ResError)),
GetEnumname(TypeInfo(TsErrorValue), ord(actual.ResError)),
'Test read calculated formula error value mismatch, formula ' + formula +
', cell '+CellNotation(MyWorkSheet,Row,1));
end;
@ -274,19 +330,44 @@ begin
end;
end;
procedure TSpreadWriteReadFormulaTests.TestWriteRead_BIFF2_CalcRPNFormula;
procedure TSpreadWriteReadFormulaTests.Test_Write_Read_CalcRPNFormula_BIFF2;
begin
TestCalcRPNFormulas(sfExcel2);
TestCalcFormulas(sfExcel2, true);
end;
procedure TSpreadWriteReadFormulaTests.TestWriteRead_BIFF5_CalcRPNFormula;
procedure TSpreadWriteReadFormulaTests.Test_Write_Read_CalcRPNFormula_BIFF5;
begin
TestCalcRPNFormulas(sfExcel5);
TestCalcFormulas(sfExcel5, true);
end;
procedure TSpreadWriteReadFormulaTests.TestWriteRead_BIFF8_CalcRPNFormula;
procedure TSpreadWriteReadFormulaTests.Test_Write_Read_CalcRPNFormula_BIFF8;
begin
TestCalcRPNFormulas(sfExcel8);
TestCalcFormulas(sfExcel8, true);
end;
procedure TSpreadWriteReadFormulaTests.Test_Write_Read_CalcRPNFormula_OOXML;
begin
TestCalcFormulas(sfOOXML, true);
end;
procedure TSpreadWriteReadFormulaTests.Test_Write_Read_CalcStringFormula_BIFF2;
begin
TestCalcFormulas(sfExcel2, false);
end;
procedure TSpreadWriteReadFormulaTests.Test_Write_Read_CalcStringFormula_BIFF5;
begin
TestCalcFormulas(sfExcel5, false);
end;
procedure TSpreadWriteReadFormulaTests.Test_Write_Read_CalcStringFormula_BIFF8;
begin
TestCalcFormulas(sfExcel8, false);
end;
procedure TSpreadWriteReadFormulaTests.Test_Write_Read_CalcStringFormula_OOXML;
begin
TestCalcFormulas(sfOOXML, false);
end;

3
components/fpspreadsheet/tests/internaltests.pas
View File

@ -350,7 +350,8 @@ begin
CheckEquals('$XFE$1',GetCellString(0,16384,[])); // the first column beyond xlsx
// Something VERY big, beyond xlsx
s := 'ZZZZ1';
// s := 'ZZZZ1'; // this is case is no longer possible because max column count has been cut down to 65536
s := 'CRAA1';
ParseCellString(s, r, c, flags);
CheckEquals(s, GetCellString(r, c, flags));
end;

21
components/fpspreadsheet/tests/manualtests.pas
View File

@ -58,6 +58,8 @@ type
// As described in bug 25718: Feature request & patch: Implementation of writing more functions
// Writes all rpn formulas. Use Excel or Open/LibreOffice to check validity.
procedure TestRPNFormula;
// Dto, but writes string formulas.
// procedure TestStringFormula;
{$ENDIF}
// For BIFF8 format, writes all background colors in A1..A16
procedure TestBiff8CellBackgroundColor;
@ -69,8 +71,9 @@ uses
fpsUtils, rpnFormulaUnit;
const
COLORSHEETNAME='colorsheet'; //for background color tests
RPNSHEETNAME='formula_sheet'; //for rpn formula tests
COLORSHEETNAME='color_sheet'; //for background color tests
RPNSHEETNAME='rpn_formula_sheet'; //for rpn formula tests
FORMULASHEETNAME='formula_sheet'; // for string formula tests
OUTPUT_FORMAT = sfExcel8; //change manually if you want to test different formats. To do: automatically output all formats
var
@ -195,7 +198,7 @@ begin
Worksheet := Workbook.AddWorksheet(COLORSHEETNAME);
WorkSheet.WriteUTF8Text(0,1,'TSpreadManualTests.TestBiff8CellBackgroundColor');
RowOffset:=1;
RowOffset := 1;
for i:=0 to Workbook.GetPaletteSize-1 do begin
WorkSheet.WriteUTF8Text(i+RowOffset,0,'BACKGROUND COLOR TEST');
Cell := Worksheet.GetCell(i+RowOffset, 0);
@ -218,6 +221,18 @@ begin
Worksheet := Workbook.AddWorksheet(RPNSHEETNAME);
WriteRPNFormulaSamples(Worksheet, OUTPUT_FORMAT, false);
end;
(*
procedure TSpreadManualTests.TestStringFormula;
var
Worksheet: TsWorksheet;
begin
if Workbook = nil then
Workbook := TsWorkbook.Create;
Worksheet := Workbook.AddWorksheet(FORMULASHEETNAME);
WriteRPNFormulaSamples(Worksheet, OUTPUT_FORMAT, false, false);
end;
*)
{$ENDIF}
initialization

107
components/fpspreadsheet/tests/rpnformulaunit.pas
View File

@ -150,7 +150,7 @@ begin
Worksheet.WriteUTF8Text(Row, 0, Format('=COUNT(%s)', [cellAddr]));
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellRange(cellAddr,
RPNFunc(fekCOUNT, 1, // 1 parameter used in COUNT
RPNFunc('COUNT', 1, // 1 parameter used in COUNT
nil
))));
Worksheet.WriteNumber(Row, 2, 6); // 7 cells, but 1 is alpha-numerical!
@ -161,7 +161,7 @@ begin
Worksheet.WriteUTF8Text(Row, 0, Format('=COUNT(%s)', [cellAddr]));
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellRange(cellAddr,
RPNFunc(fekCOUNT, 1,
RPNFunc('COUNT', 1,
nil
))));
Worksheet.WriteNumber(Row, 2, 6); // 7 cells, but 1 is alph-numerical!
@ -172,7 +172,7 @@ begin
Worksheet.WriteUTF8Text(Row, 0, Format('=COUNT(%s)', [cellAddr]));
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellRange(cellAddr,
RPNFunc(fekCOUNT, 1,
RPNFunc('COUNT', 1,
nil
))));
Worksheet.WriteNumber(Row, 2, 6); // 7 cells, but 1 is alpha-numerical!
@ -486,7 +486,7 @@ begin
inc(Row);
Worksheet.WriteUTF8Text(Row, 0, '=TRUE()');
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNFunc(fekTRUE,
RPNFunc('TRUE',
nil)));
Worksheet.WriteUTF8Text(Row, 2, FALSE_TRUE[true]);
@ -494,7 +494,7 @@ begin
inc(Row);
Worksheet.WriteUTF8Text(Row, 0, '=FALSE()');
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNFunc(fekFALSE,
RPNFunc('FALSE',
nil)));
Worksheet.WriteUTF8Text(Row, 2, FALSE_TRUE[false]);
@ -505,8 +505,8 @@ begin
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellValue('C1',
RPNCellValue('C1',
RPNFunc(fekEQUAL,
RPNFunc(fekNOT,
RPNFunc(fekEqual,
RPNFunc('NOT',
nil))))));
Worksheet.WriteUTF8Text(Row, 2, FALSE_TRUE[not (cellC1=cellC1)]);
@ -520,7 +520,7 @@ begin
RPNNumber(1,
RPNNumber(2,
RPNFunc(fekEQUAL,
RPNFunc(fekAND, 2,
RPNFunc('AND', 2,
nil)))))))));
Worksheet.WriteUTF8Text(Row, 2, FALSE_TRUE[(1=0) and (1=2)]);
@ -534,7 +534,7 @@ begin
RPNNumber(2,
RPNNumber(2,
RPNFunc(fekEQUAL,
RPNFunc(fekAND, 2,
RPNFunc('AND', 2,
nil)))))))));
Worksheet.WriteUTF8Text(Row, 2, FALSE_TRUE[(1=0) and (2=2)]);
@ -548,7 +548,7 @@ begin
RPNNumber(2,
RPNNumber(2,
RPNFunc(fekEQUAL,
RPNFunc(fekAND, 2,
RPNFunc('AND', 2,
nil)))))))));
Worksheet.WriteUTF8Text(Row, 2, FALSE_TRUE[(1=1) and (2=2)]);
@ -562,7 +562,7 @@ begin
RPNNumber(1,
RPNNumber(2,
RPNFunc(fekEQUAL,
RPNFunc(fekOR, 2,
RPNFunc('OR', 2,
nil)))))))));
Worksheet.WriteUTF8Text(Row, 2, FALSE_TRUE[(1=0) or (1=2)]);
@ -576,7 +576,7 @@ begin
RPNNumber(2,
RPNNumber(2,
RPNFunc(fekEQUAL,
RPNFunc(fekOR, 2,
RPNFunc('OR', 2,
nil)))))))));
Worksheet.WriteUTF8Text(Row, 2, FALSE_TRUE[(1=0) or (2=2)]);
@ -590,7 +590,7 @@ begin
RPNNumber(2,
RPNNumber(2,
RPNFunc(fekEQUAL,
RPNFunc(fekOR, 2,
RPNFunc('OR', 2,
nil)))))))));
Worksheet.WriteUTF8Text(Row, 2, FALSE_TRUE[(1=1) or (2=2)]);
@ -603,7 +603,7 @@ begin
RPNFunc(fekEQUAL,
RPNString('correct',
RPNString('wrong',
RPNFunc(fekIF, 3,
RPNFunc('IF', 3,
nil))))))));
Worksheet.WriteUTF8Text(Row, 2, IfThen(cellB1=1.0, 'correct', 'wrong'));
@ -616,7 +616,7 @@ begin
RPNFunc(fekNotEQUAL,
RPNString('correct',
RPNString('wrong',
RPNFunc(fekIF, 3,
RPNFunc('IF', 3,
nil))))))));
Worksheet.WriteUTF8Text(Row, 2, IfThen(cellB1<>1.0, 'correct', 'wrong'));
@ -628,7 +628,7 @@ begin
RPNNumber(1,
RPNFunc(fekEQUAL,
RPNString('correct',
RPNFunc(fekIF, 2,
RPNFunc('IF', 2,
nil)))))));
Worksheet.WriteUTF8Text(Row, 2, IfThen(cellB1=1.0, 'correct', 'FALSE'));
@ -640,7 +640,7 @@ begin
RPNNumber(1,
RPNFunc(fekNotEQUAL,
RPNString('correct',
RPNFunc(fekIF, 2,
RPNFunc('IF', 2,
nil)))))));
Worksheet.WriteUTF8Text(Row, 2, IfThen(cellB1<>1.0, 'correct', 'FALSE'));
@ -656,7 +656,7 @@ begin
Worksheet.WriteUTF8Text(Row, 0, '=ABS($B1)');
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellValue('$B1',
RPNFunc(fekABS,
RPNFunc('ABS',
nil))));
Worksheet.WriteNumber(Row, 2, abs(cellB1));
@ -665,7 +665,7 @@ begin
Worksheet.WriteUTF8Text(Row, 0, '=ABS(E$1)');
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellValue('E$1',
RPNFunc(fekABS,
RPNFunc('ABS',
nil))));
Worksheet.WriteNumber(Row, 2, abs(cellE1));
@ -674,7 +674,7 @@ begin
Worksheet.WriteUTF8Text(Row, 0, '=SIGN(F1)');
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellValue('F1',
RPNFunc(fekSIGN,
RPNFunc('SIGN',
nil))));
Worksheet.WriteNumber(Row, 2, sign(cellF1));
@ -683,7 +683,7 @@ begin
Worksheet.WriteUTF8Text(Row, 0, '=SIGN(0)');
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNNumber(0,
RPNFunc(fekSIGN,
RPNFunc('SIGN',
nil))));
Worksheet.WriteNumber(Row, 2, sign(0));
@ -692,7 +692,7 @@ begin
Worksheet.WriteUTF8Text(Row, 0, '=SIGN(G1)');
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellValue('G1',
RPNFunc(fekSIGN,
RPNFunc('SIGN',
nil))));
Worksheet.WriteNumber(Row, 2, sign(cellG1));
@ -700,7 +700,7 @@ begin
inc(Row);
Worksheet.WriteUTF8Text(Row, 0, '=RAND()');
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNFunc(fekRAND,
RPNFunc('RAND',
nil)));
Worksheet.WriteUTF8Text(Row, 2, '(random number - cannot compare)');
@ -708,7 +708,7 @@ begin
inc(Row);
Worksheet.WriteUTF8Text(Row, 0, '=PI()');
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNFunc(fekPI,
RPNFunc('PI',
nil)));
Worksheet.WriteNumber(Row, 2, pi);
@ -718,10 +718,10 @@ begin
value := pi/2;
Worksheet.WriteUTF8Text(Row, 0, '=DEGREES(PI()/2)');
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNFunc(fekPI,
RPNFunc('PI',
RPNNumber(2,
RPNFunc(fekDIV,
RPNFunc(fekDEGREES,
RPNFunc('DEGREES',
nil))))));
Worksheet.WriteNumber(Row, 2, value/pi*180);
@ -731,7 +731,7 @@ begin
Worksheet.WriteUTF8Text(Row, 0, '=RADIANS(90)');
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNNumber(value,
RPNFunc(fekRADIANS,
RPNFunc('RADIANS',
nil))));
Worksheet.WriteNumber(Row, 2, value/180*pi);
end;
@ -740,10 +740,10 @@ begin
inc(Row);
Worksheet.WriteUTF8Text(Row, 0, '=SIN(PI()/2)');
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNFunc(fekPI,
RPNFunc('PI',
RPNNumber(2,
RPNFunc(fekDIV,
RPNFunc(fekSIN,
RPNFunc('SIN',
nil))))));
Worksheet.WriteNumber(Row, 2, sin(pi/2));
@ -753,7 +753,7 @@ begin
Worksheet.WriteUTF8Text(Row, 0, Format('=ASIN(%.1f)', [value], fs));
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNNumber(value,
RPNFunc(fekASIN,
RPNFunc('ASIN',
nil))));
Worksheet.WriteNumber(Row, 2, arcsin(value));
@ -761,8 +761,8 @@ begin
inc(Row);
Worksheet.WriteUTF8Text(Row, 0, '=COS(PI())');
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNFunc(fekPI,
RPNFunc(fekCOS,
RPNFunc('PI',
RPNFunc('COS',
nil))));
Worksheet.WriteNumber(Row, 2, cos(pi));
@ -772,7 +772,7 @@ begin
Worksheet.WriteUTF8Text(Row, 0, Format('=ACOS(%.1f)', [value], fs));
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNNumber(value,
RPNFunc(fekACOS,
RPNFunc('ACOS',
nil))));
Worksheet.WriteNumber(Row, 2, arccos(value));
@ -780,10 +780,10 @@ begin
inc(Row);
Worksheet.WriteUTF8Text(Row, 0, '=TAN(PI()/4)');
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNFunc(fekPI,
RPNFunc('PI',
RPNNumber(4,
RPNFunc(fekDiv,
RPNFunc(fekTAN,
RPNFunc('TAN',
nil))))));
Worksheet.WriteNumber(Row, 2, tan(pi/4));
@ -793,7 +793,7 @@ begin
Worksheet.WriteUTF8Text(Row, 0, '=ATAN(1)');
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNNumber(value,
RPNFunc(fekATAN,
RPNFunc('ATAN',
nil))));
Worksheet.WriteNumber(Row, 2, arctan(1.0));
@ -806,7 +806,7 @@ begin
Worksheet.WriteUTF8Text(Row, 0, '=SINH(3)');
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNNumber(value,
RPNFunc(fekSINH,
RPNFunc('SINH',
nil))));
Worksheet.WriteNumber(Row, 2, sinh(value));
@ -816,7 +816,7 @@ begin
Worksheet.WriteUTF8Text(Row, 0, Format('=ASINH(%.1f)', [value], fs));
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNNumber(value,
RPNFunc(fekASINH,
RPNFunc('ASINH',
nil))));
Worksheet.WriteNumber(Row, 2, arcsinh(value));
@ -826,7 +826,7 @@ begin
Worksheet.WriteUTF8Text(Row, 0, '=COSH(3)');
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNNumber(value,
RPNFunc(fekCOSH,
RPNFunc('COSH',
nil))));
Worksheet.WriteNumber(Row, 2, cosh(value));
@ -836,7 +836,7 @@ begin
Worksheet.WriteUTF8Text(Row, 0, '=ACOSH(10)');
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNNumber(value,
RPNFunc(fekACOSH,
RPNFunc('ACOSH',
nil))));
Worksheet.WriteNumber(Row, 2, arccosh(value));
@ -846,7 +846,7 @@ begin
Worksheet.WriteUTF8Text(Row, 0, '=TANH(3)');
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNNumber(value,
RPNFunc(fekTANH,
RPNFunc('TANH',
nil))));
Worksheet.WriteNumber(Row, 2, tanh(value));
@ -856,7 +856,7 @@ begin
Worksheet.WriteUTF8Text(Row, 0, Format('=ATANH(%.1f)', [value], fs));
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNNumber(value,
RPNFunc(fekATANH,
RPNFunc('ATANH',
nil))));
Worksheet.WriteNumber(Row, 2, arctanh(value));
end;
@ -867,7 +867,7 @@ begin
Worksheet.WriteUTF8Text(Row, 0, '=SQRT(2)');
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNNumber(value,
RPNFunc(fekSQRT,
RPNFunc('SQRT',
nil))));
Worksheet.WriteNumber(Row, 2, sqrt(value));
@ -877,7 +877,7 @@ begin
Worksheet.WriteUTF8Text(Row, 0, '=EXP(2)');
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNNumber(value,
RPNFunc(fekEXP,
RPNFunc('EXP',
nil))));
Worksheet.WriteNumber(Row, 2, exp(value));
@ -887,7 +887,7 @@ begin
Worksheet.WriteUTF8Text(Row, 0, '=LN(2)');
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNNumber(value,
RPNFunc(fekLN,
RPNFunc('LN',
nil))));
Worksheet.WriteNumber(Row, 2, ln(value));
@ -898,7 +898,7 @@ begin
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNNumber(value,
RPNNumber(2,
RPNFunc(fekLOG, 2,
RPNFunc('LOG', 2,
nil)))));
Worksheet.WriteNumber(Row, 2, logn(2.0, value));
@ -908,7 +908,7 @@ begin
Worksheet.WriteUTF8Text(Row, 0, '=LOG10(100)');
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNNumber(value,
RPNFunc(fekLOG10,
RPNFunc('LOG10',
nil))));
Worksheet.WriteNumber(Row, 2, log10(value));
@ -918,7 +918,7 @@ begin
Worksheet.WriteUTF8Text(Row, 0, Format('=LOG10(%.2f)', [value], fs));
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNNumber(value,
RPNFunc(fekLOG10,
RPNFunc('LOG10',
nil))));
Worksheet.WriteNumber(Row, 2, log10(value));
@ -935,7 +935,7 @@ begin
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellValue('$F$1',
RPNNumber(1,
RPNFunc(fekROUND,
RPNFunc('ROUND',
nil)))));
Worksheet.WriteNumber(Row, 2, Round(cellF1*10)/10); //RoundTo(cellF1, 1));
@ -945,7 +945,7 @@ begin
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellValue('G1',
RPNNumber(1,
RPNFunc(fekROUND,
RPNFunc('ROUND',
nil)))));
Worksheet.WriteNumber(Row, 2, Round(cellG1*10)/10); //RoundTo(cellG1, 1));
@ -954,7 +954,7 @@ begin
Worksheet.WriteUTF8Text(Row, 0, '=INT(F1)');
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellValue('F1',
RPNFunc(fekINT,
RPNFunc('INT',
nil))));
Worksheet.WriteNumber(Row, 2, trunc(cellF1));
@ -963,10 +963,10 @@ begin
Worksheet.WriteUTF8Text(Row, 0, '=INT(G1)');
Worksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellValue('G1',
RPNFunc(fekINT,
RPNFunc('INT',
nil))));
Worksheet.WriteNumber(Row, 2, floor(cellG1)); // is this true?
(*
{ ---------- }
inc(Row);
@ -2012,6 +2012,7 @@ begin
Worksheet.WriteUTF8Text(Row, 2, 'Error #N/A!');
Worksheet.WriteUTF8Text(Row, 3, 'Should be "=1/2", but there are too many operands...');
end;
*)
end;
end.

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

@ -56,14 +56,17 @@
<Unit3>
<Filename Value="numberstests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="numberstests"/>
</Unit3>
<Unit4>
<Filename Value="manualtests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="manualtests"/>
</Unit4>
<Unit5>
<Filename Value="testsutility.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="testsutility"/>
</Unit5>
<Unit6>
<Filename Value="internaltests.pas"/>
@ -72,11 +75,11 @@
<Unit7>
<Filename Value="formattests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="formattests"/>
</Unit7>
<Unit8>
<Filename Value="colortests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="colortests"/>
</Unit8>
<Unit9>
<Filename Value="fonttests.pas"/>

BIN
components/fpspreadsheet/tests/testbiff8_1899.xls
View File

Binary file not shown.

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

File diff suppressed because it is too large Load Diff

15
components/fpspreadsheet/tests/testsutility.pas
View File

@ -111,7 +111,10 @@ begin
if not(assigned(Worksheet)) then
result:='CellNotation: error getting worksheet.'
else
result:=WorkSheet.Name+'!'+ColumnToLetter(Column)+inttostr(Row+1)
if Worksheet.Name <> '' then
result := WorkSheet.Name + '!' + ColumnToLetter(Column) + inttostr(Row+1)
else
Result := ColumnToLetter(Column) + IntToStr(Row + 1);
end;
function ColNotation(WorkSheet: TsWorksheet; Column:Integer): String;
@ -119,7 +122,10 @@ begin
if not Assigned(Worksheet) then
Result := 'ColNotation: error getting worksheet.'
else
Result := WorkSheet.Name + '!' + ColumnToLetter(Column);
if Worksheet.Name <> '' then
Result := WorkSheet.Name + '!' + ColumnToLetter(Column)
else
Result := ColumnToLetter(Column);
end;
function RowNotation(Worksheet: TsWorksheet; Row: Integer): String;
@ -127,7 +133,10 @@ begin
if not Assigned(Worksheet) then
Result := 'RowNotation: error getting worksheet.'
else
Result := Worksheet.Name + '!' + IntToStr(Row+1);
if Worksheet.Name <> '' then
Result := Worksheet.Name + '!' + IntToStr(Row+1)
else
Result := IntToStr(Row+1);
end;
end.

35
components/fpspreadsheet/xlsbiff2.pas
View File

@ -605,7 +605,7 @@ begin
end;
{ Formula token array }
if boReadFormulas in FWorkbook.Options then begin
if (boReadFormulas in FWorkbook.Options) then begin
ok := ReadRPNTokenArray(AStream, cell);
if not ok then FWorksheet.WriteErrorValue(cell, errFormulaNotSupported);
end;
@ -1230,10 +1230,9 @@ end;
}
procedure TsSpreadBIFF2Writer.WriteToStream(AStream: TStream);
var
sheet: TsWorksheet;
pane: Byte;
begin
sheet := Workbook.GetFirstWorksheet;
FWorksheet := Workbook.GetFirstWorksheet;
WriteBOF(AStream);
WriteFonts(AStream);
@ -1241,21 +1240,21 @@ begin
WriteFormats(AStream);
WriteXFRecords(AStream);
WriteColWidths(AStream);
WriteDimensions(AStream, sheet);
WriteRows(AStream, sheet);
WriteDimensions(AStream, FWorksheet);
WriteRows(AStream, FWorksheet);
if (boVirtualMode in Workbook.Options) then
WriteVirtualCells(AStream)
else begin
WriteRows(AStream, sheet);
WriteCellsToStream(AStream, sheet.Cells);
WriteRows(AStream, FWorksheet);
WriteCellsToStream(AStream, FWorksheet.Cells);
end;
WriteWindow1(AStream);
// { -- currently not working
WriteWindow2(AStream, sheet);
WritePane(AStream, sheet, false, pane); // false for "is not BIFF5 or BIFF8"
WriteSelections(AStream, sheet);
WriteWindow2(AStream, FWorksheet);
WritePane(AStream, FWorksheet, false, pane); // false for "is not BIFF5 or BIFF8"
WriteSelections(AStream, FWorksheet);
//}
WriteEOF(AStream);
end;
@ -1630,11 +1629,6 @@ begin
else
WriteRPNTokenArray(AStream, AFormula, true, RPNLength);
(*
{ Formula data (RPN token array) }
WriteRPNTokenArray(AStream, AFormula, true, RPNLength);
*)
{ Finally write sizes after we know them }
FinalPos := AStream.Position;
AStream.Position := RecordSizePos;
@ -1665,13 +1659,12 @@ var
i: Integer;
formula: TsRPNFormula;
begin
SetLength(formula, Length(ACell^.SharedFormulaBase^.RPNFormulaValue));
for i:=0 to Length(formula)-1 do begin
// Copy formula
formula[i] := ACell^.SharedFormulaBase^.RPNFormulaValue[i];
// Adapt relative cell references
// Create RPN formula from the shared formula base's string formula
formula := FWorksheet.BuildRPNFormula(ACell^.SharedFormulaBase);
// Adapt relative cell references
for i:=0 to Length(formula)-1 do
FixRelativeReferences(ACell, formula[i]);
end;
// Write adapted copy of shared formula to stream.
WriteRPNTokenArray(AStream, formula, true, RPNLength);

35
components/fpspreadsheet/xlsbiff8.pas
View File

@ -222,7 +222,7 @@ var
implementation
uses
fpsStreams;
fpsStreams, fpsExprParser;
const
{ Excel record IDs }
@ -1247,6 +1247,14 @@ begin
inherited;
end;
var
counter: Integer = 0;
function TsSpreadBIFF8Reader.ReadWideString(const AStream: TStream;
const ALength: WORD): WideString;
var
@ -1264,16 +1272,15 @@ var
begin
StringFlags:=AStream.ReadByte;
Dec(PendingRecordSize);
if StringFlags and 4 = 4 then begin
//Asian phonetics
//Read Asian phonetics Length (not used)
AsianPhoneticBytes:=DWordLEtoN(AStream.ReadDWord);
end;
if StringFlags and 8 = 8 then begin
//Rich string
RunsCounter:=WordLEtoN(AStream.ReadWord);
dec(PendingRecordSize, 2);
end;
if StringFlags and 4 = 4 then begin
//Asian phonetics
//Read Asian phonetics length (not used)
AsianPhoneticBytes:=DWordLEtoN(AStream.ReadDWord);
dec(PendingRecordSize, 4);
dec(PendingRecordSize,2);
end;
if StringFlags and 1 = 1 Then begin
//String is WideStringLE
@ -1290,6 +1297,11 @@ begin
end else begin
//String is 1 byte per char, this is UTF-16 with the high byte ommited because it is zero
//so decompress and then convert
inc(Counter);
lLen:=ALength;
SetLength(DecomprStrValue, lLen);
for i := 1 to lLen do
@ -1298,7 +1310,7 @@ begin
DecomprStrValue[i] := C;
Dec(PendingRecordSize);
if (PendingRecordSize<=0) and (i<lLen) then begin
//A CONTINUE may happen here
//A CONTINUE may happend here
RecordType := WordLEToN(AStream.ReadWord);
RecordSize := WordLEToN(AStream.ReadWord);
if RecordType<>INT_EXCEL_ID_CONTINUE then begin
@ -1310,13 +1322,14 @@ begin
end;
end;
end;
Result := DecomprStrValue;
end;
if StringFlags and 8 = 8 then begin
//Rich string (This only happens in BIFF8)
//Rich string (This only happened in BIFF8)
for j := 1 to RunsCounter do begin
if (PendingRecordSize<=0) then begin
//A CONTINUE may happen here
//A CONTINUE may happend here
RecordType := WordLEToN(AStream.ReadWord);
RecordSize := WordLEToN(AStream.ReadWord);
if RecordType<>INT_EXCEL_ID_CONTINUE then begin

282
components/fpspreadsheet/xlscommon.pas
View File

@ -67,176 +67,6 @@ const
INT_FONT_WEIGHT_NORMAL = $0190;
INT_FONT_WEIGHT_BOLD = $02BC;
{ Formula constants TokenID values }
{ Binary Operator Tokens 3.6}
INT_EXCEL_TOKEN_TADD = $03;
INT_EXCEL_TOKEN_TSUB = $04;
INT_EXCEL_TOKEN_TMUL = $05;
INT_EXCEL_TOKEN_TDIV = $06;
INT_EXCEL_TOKEN_TPOWER = $07; // Power Exponentiation ^
INT_EXCEL_TOKEN_TCONCAT = $08; // Concatenation &
INT_EXCEL_TOKEN_TLT = $09; // Less than <
INT_EXCEL_TOKEN_TLE = $0A; // Less than or equal <=
INT_EXCEL_TOKEN_TEQ = $0B; // Equal =
INT_EXCEL_TOKEN_TGE = $0C; // Greater than or equal >=
INT_EXCEL_TOKEN_TGT = $0D; // Greater than >
INT_EXCEL_TOKEN_TNE = $0E; // Not equal <>
INT_EXCEL_TOKEN_TISECT = $0F; // Cell range intersection
INT_EXCEL_TOKEN_TLIST = $10; // Cell range list
INT_EXCEL_TOKEN_TRANGE = $11; // Cell range
INT_EXCEL_TOKEN_TUPLUS = $12; // Unary plus +
INT_EXCEL_TOKEN_TUMINUS = $13; // Unary minus +
INT_EXCEL_TOKEN_TPERCENT= $14; // Percent (%, divides operand by 100)
INT_EXCEL_TOKEN_TPAREN = $15; // Operator in parenthesis
{ Constant Operand Tokens, 3.8}
INT_EXCEL_TOKEN_TMISSARG= $16; //missing operand
INT_EXCEL_TOKEN_TSTR = $17; //string
INT_EXCEL_TOKEN_TERR = $1C; //error value
INT_EXCEL_TOKEN_TBOOL = $1D; //boolean
INT_EXCEL_TOKEN_TINT = $1E; //(unsigned) integer
INT_EXCEL_TOKEN_TNUM = $1F; //floating-point
{ Operand Tokens }
// _R: reference; _V: value; _A: array
INT_EXCEL_TOKEN_TREFR = $24;
INT_EXCEL_TOKEN_TREFV = $44;
INT_EXCEL_TOKEN_TREFA = $64;
INT_EXCEL_TOKEN_TAREA_R = $25;
INT_EXCEL_TOKEN_TAREA_V = $45;
INT_EXCEL_TOKEN_TAREA_A = $65;
INT_EXCEL_TOKEN_TREFN_R = $2C;
INT_EXCEL_TOKEN_TREFN_V = $4C;
INT_EXCEL_TOKEN_TREFN_A = $6C;
{ Function Tokens }
// _R: reference; _V: value; _A: array
// Offset 0: token; offset 1: index to a built-in sheet function ( ➜ 3.111)
INT_EXCEL_TOKEN_FUNC_R = $21;
INT_EXCEL_TOKEN_FUNC_V = $41;
INT_EXCEL_TOKEN_FUNC_A = $61;
//VAR: variable number of arguments:
INT_EXCEL_TOKEN_FUNCVAR_R = $22;
INT_EXCEL_TOKEN_FUNCVAR_V = $42;
INT_EXCEL_TOKEN_FUNCVAR_A = $62;
{ Special tokens }
INT_EXCEL_TOKEN_TEXP = $01; // cell belongs to shared formula
{ Built-in/worksheet functions }
INT_EXCEL_SHEET_FUNC_COUNT = 0;
INT_EXCEL_SHEET_FUNC_IF = 1;
INT_EXCEL_SHEET_FUNC_ISNA = 2;
INT_EXCEL_SHEET_FUNC_ISERROR = 3;
INT_EXCEL_SHEET_FUNC_SUM = 4;
INT_EXCEL_SHEET_FUNC_AVERAGE = 5;
INT_EXCEL_SHEET_FUNC_MIN = 6;
INT_EXCEL_SHEET_FUNC_MAX = 7;
INT_EXCEL_SHEET_FUNC_ROW = 8;
INT_EXCEL_SHEET_FUNC_COLUMN = 9;
INT_EXCEL_SHEET_FUNC_STDEV = 12;
INT_EXCEL_SHEET_FUNC_SIN = 15;
INT_EXCEL_SHEET_FUNC_COS = 16;
INT_EXCEL_SHEET_FUNC_TAN = 17;
INT_EXCEL_SHEET_FUNC_ATAN = 18;
INT_EXCEL_SHEET_FUNC_PI = 19;
INT_EXCEL_SHEET_FUNC_SQRT = 20;
INT_EXCEL_SHEET_FUNC_EXP = 21;
INT_EXCEL_SHEET_FUNC_LN = 22;
INT_EXCEL_SHEET_FUNC_LOG10 = 23;
INT_EXCEL_SHEET_FUNC_ABS = 24; // $18
INT_EXCEL_SHEET_FUNC_INT = 25;
INT_EXCEL_SHEET_FUNC_SIGN = 26;
INT_EXCEL_SHEET_FUNC_ROUND = 27; // $1B
INT_EXCEL_SHEET_FUNC_MID = 31;
INT_EXCEL_SHEET_FUNC_VALUE = 33;
INT_EXCEL_SHEET_FUNC_TRUE = 34;
INT_EXCEL_SHEET_FUNC_FALSE = 35;
INT_EXCEL_SHEET_FUNC_AND = 36;
INT_EXCEL_SHEET_FUNC_OR = 37;
INT_EXCEL_SHEET_FUNC_NOT = 38;
INT_EXCEL_SHEET_FUNC_VAR = 46;
INT_EXCEL_SHEET_FUNC_PV = 56;
INT_EXCEL_SHEET_FUNC_FV = 57;
INT_EXCEL_SHEET_FUNC_NPER = 58;
INT_EXCEL_SHEET_FUNC_PMT = 59;
INT_EXCEL_SHEET_FUNC_RATE = 60;
INT_EXCEL_SHEET_FUNC_RAND = 63;
INT_EXCEL_SHEET_FUNC_DATE = 65; // $41
INT_EXCEL_SHEET_FUNC_TIME = 66; // $42
INT_EXCEL_SHEET_FUNC_DAY = 67;
INT_EXCEL_SHEET_FUNC_MONTH = 68;
INT_EXCEL_SHEET_FUNC_YEAR = 69;
INT_EXCEL_SHEET_FUNC_WEEKDAY = 70;
INT_EXCEL_SHEET_FUNC_HOUR = 71;
INT_EXCEL_SHEET_FUNC_MINUTE = 72;
INT_EXCEL_SHEET_FUNC_SECOND = 73;
INT_EXCEL_SHEET_FUNC_NOW = 74;
INT_EXCEL_SHEET_FUNC_ROWS = 76;
INT_EXCEL_SHEET_FUNC_COLUMNS = 77;
INT_EXCEL_SHEET_FUNC_ASIN = 98;
INT_EXCEL_SHEET_FUNC_ACOS = 99;
INT_EXCEL_SHEET_FUNC_ISREF = 105;
INT_EXCEL_SHEET_FUNC_LOG = 109;
INT_EXCEL_SHEET_FUNC_CHAR = 111;
INT_EXCEL_SHEET_FUNC_LOWER = 112;
INT_EXCEL_SHEET_FUNC_UPPER = 113;
INT_EXCEL_SHEET_FUNC_PROPER = 114;
INT_EXCEL_SHEET_FUNC_LEFT = 115;
INT_EXCEL_SHEET_FUNC_RIGHT = 116;
INT_EXCEL_SHEET_FUNC_TRIM = 118;
INT_EXCEL_SHEET_FUNC_REPLACE = 119;
INT_EXCEL_SHEET_FUNC_SUBSTITUTE = 120;
INT_EXCEL_SHEET_FUNC_CODE = 121;
INT_EXCEL_SHEET_FUNC_CELL = 125;
INT_EXCEL_SHEET_FUNC_ISERR = 126;
INT_EXCEL_SHEET_FUNC_ISTEXT = 127;
INT_EXCEL_SHEET_FUNC_ISNUMBER = 128;
INT_EXCEL_SHEET_FUNC_ISBLANK = 129;
INT_EXCEL_SHEET_FUNC_DATEVALUE = 140;
INT_EXCEL_SHEET_FUNC_TIMEVALUE = 141;
INT_EXCEL_SHEET_FUNC_COUNTA = 169;
INT_EXCEL_SHEET_FUNC_PRODUCT = 183;
INT_EXCEL_SHEET_FUNC_ISNONTEXT = 190;
INT_EXCEL_SHEET_FUNC_STDEVP = 193;
INT_EXCEL_SHEET_FUNC_VARP = 194;
INT_EXCEL_SHEET_FUNC_ISLOGICAL = 198;
INT_EXCEL_SHEET_FUNC_TODAY = 221; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_MEDIAN = 227; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_SINH = 229; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_COSH = 230; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_TANH = 231; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_ASINH = 232; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_ACOSH = 233; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_ATANH = 234; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_INFO = 244; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_AVEDEV = 269; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_BETADIST = 270; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_BETAINV = 272; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_BINOMDIST = 273; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_CHIDIST = 274; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_CHIINV = 275; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_PERMUT = 299; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_POISSON = 300; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_SUMSQ = 321; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_RADIANS = 342; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_DEGREES = 343; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_SUMIF = 345; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_COUNTIF = 346; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_COUNTBLANK = 347; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_DATEDIF = 351; // not available in BIFF2
{ Control Tokens, Special Tokens }
// 01H tExp Matrix formula or shared formula
// 02H tTbl Multiple operation table
// 15H tParen Parentheses
// 18H tNlr Natural language reference (BIFF8)
INT_EXCEL_TOKEN_TATTR = $19; // tAttr Special attribute
// 1AH tSheet Start of external sheet reference (BIFF2-BIFF4)
// 1BH tEndSheet End of external sheet reference (BIFF2-BIFF4)
{ CODEPAGE record constants }
WORD_ASCII = 367;
WORD_UTF_16 = 1200; // BIFF 8
@ -475,7 +305,7 @@ type
function GetLastRowIndex(AWorksheet: TsWorksheet): Integer;
procedure GetLastColCallback(ACell: PCell; AStream: TStream);
function GetLastColIndex(AWorksheet: TsWorksheet): Word;
function FormulaElementKindToExcelTokenID(AElementKind: TFEKind; out ASecondaryID: Word): Word;
// function FormulaElementKindToExcelTokenID(AElementKind: TFEKind; out ASecondaryID: Word): Word;
// Helper function for writing a string with 8-bit length }
function WriteString_8BitLen(AStream: TStream; AString: String): Integer; virtual;
@ -555,11 +385,11 @@ type
implementation
uses
AVL_Tree, Math, Variants, fpsNumFormatParser;
AVL_Tree, Math, Variants, xlsConst, fpsNumFormatParser, fpsExprParser;
{ Helper table for rpn formulas:
Assignment of FormulaElementKinds (fekXXXX) to EXCEL_TOKEN IDs. }
const
{ Helper table for rpn formulas:
Assignment of FormulaElementKinds (fekXXXX) to EXCEL_TOKEN IDs. }
TokenIDs: array[TFEKind] of Word = (
// Basic operands
INT_EXCEL_TOKEN_TREFV, {fekCell}
@ -590,6 +420,9 @@ const
INT_EXCEL_TOKEN_TLE, {fekLessEqual, <=}
INT_EXCEL_TOKEN_TNE, {fekNotEqual, <>}
INT_EXCEL_TOKEN_TPAREN, {Operator in parenthesis}
Word(-1) {fekFunc}
);
(*
// Math functions
INT_EXCEL_SHEET_FUNC_ABS, {fekABS}
@ -711,7 +544,7 @@ const
// Other operations
INT_EXCEL_TOKEN_TATTR {fekOpSum}
);
*)
type
TBIFF58BlankRecord = packed record
RecordID: Word;
@ -1188,7 +1021,6 @@ var
err: TsErrorValue;
ok: Boolean;
cell: PCell;
begin
{ Index to XF Record }
ReadRowColXF(AStream, ARow, ACol, XF);
@ -1247,7 +1079,7 @@ begin
if IsDateTime(ResultFormula, nf, nfs, dt) then
FWorksheet.WriteDateTime(cell, dt, nf, nfs)
else
FWorksheet.WriteNumber(cell, ResultFormula, nf, nfs); //, nd, ncs);
FWorksheet.WriteNumber(cell, ResultFormula, nf, nfs);
end;
{ Formula token array }
@ -1274,7 +1106,7 @@ var
begin
ARow := WordLEtoN(AStream.ReadWord);
fc := WordLEtoN(AStream.ReadWord);
pending := RecordSize - Sizeof(fc) - Sizeof(ARow);
pending := RecordSize - SizeOf(fc) - SizeOf(ARow);
if FIsVirtualMode then begin
InitCell(ARow, 0, FVirtualCell);
cell := @FVirtualCell;
@ -1626,7 +1458,7 @@ begin
end;
{ Reads the array of rpn tokens from the current stream position, creates an
rpn formula and stores it in the cell. }
rpn formula, converts it to a string formula and stores it in the cell. }
function TsSpreadBIFFReader.ReadRPNTokenArray(AStream: TStream;
ACell: PCell): Boolean;
var
@ -1640,9 +1472,11 @@ var
r, c, r2, c2: Cardinal;
dr, dc: Integer;
fek: TFEKind;
func: Word;
exprDef: TsBuiltInExprIdentifierDef;
funcCode: Word;
b: Byte;
found: Boolean;
formula: TsRPNformula;
begin
rpnItem := nil;
n := ReadRPNTokenArraySize(AStream);
@ -1698,16 +1532,11 @@ begin
INT_EXCEL_TOKEN_FUNC_A:
// functions with fixed argument count
begin
func := ReadRPNFunc(AStream);
found := false;
for fek in TFuncTokens do begin
if (TokenIDs[fek] = func) and FixedParamCount(fek) then begin
rpnItem := RPNFunc(fek, rpnItem);
found := true;
break;
end;
end;
if not found then
funcCode := ReadRPNFunc(AStream);
exprDef := BuiltInIdentifiers.IdentifierByExcelCode(funcCode);
if exprDef <> nil then
rpnItem := RPNFunc(exprDef.Name, rpnItem)
else
supported := false;
end;
@ -1717,15 +1546,11 @@ begin
// functions with variable argument count
begin
b := AStream.ReadByte;
func := ReadRPNFunc(AStream);
found := false;
for fek in TFuncTokens do
if (TokenIDs[fek] = func) and not FixedParamCount(fek) then begin
rpnItem := RPNFunc(fek, b, rpnItem);
found := true;
break;
end;
if not found then
funcCode := ReadRPNFunc(AStream);
exprDef := BuiltinIdentifiers.IdentifierByExcelCode(funcCode);
if exprDef <> nil then
rpnItem := RPNFunc(exprDef.Name, b, rpnItem)
else
supported := false;
end;
@ -1751,11 +1576,11 @@ begin
end;
if not supported then begin
DestroyRPNFormula(rpnItem);
SetLength(ACell^.RPNFormulaValue, 0);
Result := false;
end
else begin
ACell^.RPNFormulaValue := CreateRPNFormula(rpnItem, true); // true --> we have to flip the order of items!
formula := CreateRPNFormula(rpnItem, true); // true --> we have to flip the order of items!
ACell^.FormulaValue := FWorksheet.ConvertRPNFormulaToStringFormula(formula);
Result := true;
end;
end;
@ -1938,10 +1763,11 @@ begin
end else
Result := AColor;
end;
(*
function TsSpreadBIFFWriter.FormulaElementKindToExcelTokenID(
AElementKind: TFEKind; out ASecondaryID: Word): Word;
begin
if AElementKind = fekFunc then
if (AElementKind >= Low(TFuncTokens)) and (AElementKind <= High(TFuncTokens))
then begin
if FixedParamCount(AElementKind) then
@ -1955,7 +1781,7 @@ begin
ASecondaryID := 0;
end;
end;
*)
procedure TsSpreadBIFFWriter.GetLastRowCallback(ACell: PCell; AStream: TStream);
begin
Unused(AStream);
@ -2174,12 +2000,17 @@ end;
{ Writes an Excel FORMULA record.
Note: The formula is already stored in the cell.
Since BIFF files contain RPN formulas the method calls WriteRPNFormula.
Since BIFF files contain RPN formulas the string formula of the cell is
converted to an RPN formula and the method calls WriteRPNFormula.
}
procedure TsSpreadBIFFWriter.WriteFormula(AStream: TStream;
const ARow, ACol: Cardinal; ACell: PCell);
var
formula: TsRPNFormula;
begin
WriteRPNFormula(AStream, ARow, ACol, ACell^.RPNFormulaValue, ACell);
formula := FWorksheet.BuildRPNFormula(ACell);
WriteRPNFormula(AStream, ARow, ACol, formula, ACell);
SetLength(formula, 0);
end;
{ Writes a 64-bit floating point NUMBER record.
@ -2586,10 +2417,12 @@ procedure TsSpreadBIFFWriter.WriteRPNTokenArray(AStream: TStream;
const AFormula: TsRPNFormula; WriteTokenArraySize: Boolean; var RPNLength: Word);
var
i: Integer;
tokenID, secondaryID: Word;
n: Word;
TokenArraySizePos: Int64;
FinalPos: Int64;
exprDef: TsExprIdentifierDef;
excelCode: Word;
primaryExcelCode, secondaryExcelCode: Word;
begin
RPNLength := 0;
@ -2604,12 +2437,22 @@ begin
for i := 0 to Length(AFormula) - 1 do begin
{ Token identifier }
tokenID := FormulaElementKindToExcelTokenID(AFormula[i].ElementKind, secondaryID);
AStream.WriteByte(tokenID);
if AFormula[i].ElementKind = fekFunc then begin
exprDef := BuiltinIdentifiers.IdentifierByName(Aformula[i].FuncName);
if exprDef.HasFixedArgumentCount then
primaryExcelCode := INT_EXCEL_TOKEN_FUNC_V
else
primaryExcelCode := INT_EXCEL_TOKEN_FUNCVAR_V;
secondaryExcelCode := exprDef.ExcelCode;
end else begin
primaryExcelCode := TokenIDs[AFormula[i].ElementKind];
secondaryExcelCode := 0;
end;
AStream.WriteByte(primaryExcelCode);
inc(RPNLength);
{ Token data }
case tokenID of
case primaryExcelCode of
{ Operand Tokens }
INT_EXCEL_TOKEN_TREFR, INT_EXCEL_TOKEN_TREFV, INT_EXCEL_TOKEN_TREFA: { fekCell }
// INT_EXCEL_TOKEN_TREFN_R, INT_EXCEL_TOKEN_TREFN_V, INT_EXCEL_TOKEN_TREFN_A: { fekCellOffset}
@ -2651,6 +2494,12 @@ begin
inc(RPNLength, 8);
end;
INT_EXCEL_TOKEN_TINT: { fekNum, but integer }
begin
AStream.WriteBuffer(AFormula[i].IntValue, 2);
inc(RPNLength, 2);
end;
INT_EXCEL_TOKEN_TSTR: { fekString }
{ string constant is stored as widestring in BIFF8, otherwise as ansistring
Writing is done by the virtual method WriteString_8bitLen. }
@ -2667,7 +2516,7 @@ begin
// Functions with fixed parameter count
INT_EXCEL_TOKEN_FUNC_R, INT_EXCEL_TOKEN_FUNC_V, INT_EXCEL_TOKEN_FUNC_A:
begin
n := WriteRPNFunc(AStream, secondaryID);
n := WriteRPNFunc(AStream, secondaryExcelCode);
inc(RPNLength, n);
end;
@ -2675,7 +2524,7 @@ begin
INT_EXCEL_TOKEN_FUNCVAR_V:
begin
AStream.WriteByte(AFormula[i].ParamsNum);
n := WriteRPNFunc(AStream, secondaryID);
n := WriteRPNFunc(AStream, secondaryExcelCode);
inc(RPNLength, 1 + n);
end;
@ -2933,14 +2782,13 @@ begin
// Number of existing formula records
AStream.WriteByte((r2-r1+1) * (c2-c1+1));
// Copy the formula (we don't want to overwrite the cell formulas)
// Create an RPN formula from the shared formula base's string formula
// and adjust relative references
SetLength(formula, Length(ACell^.SharedFormulaBase^.RPNFormulaValue));
for i:=0 to Length(ACell^.SharedFormulaBase^.RPNFormulaValue)-1 do begin
formula[i] := ACell^.SharedFormulaBase^.RPNFormulaValue[i];
formula := FWorksheet.BuildRPNFormula(ACell^.SharedFormulaBase);
for i:=0 to Length(formula)-1 do
FixRelativeReferences(ACell, formula[i]);
end;
// Writes the (copied) rpn token array
// Writes the rpn token array
WriteRPNTokenArray(AStream, formula, true, RPNLength);
{ Write record size at the end after we known it }

69
components/fpspreadsheet/xlsxooxml.pas
View File

@ -114,7 +114,7 @@ type
function GetStyleIndex(ACell: PCell): Cardinal;
procedure ListAllBorders;
procedure ListAllFills;
function PrepareFormula(const AFormula: TsFormula): String;
function PrepareFormula(const AFormula: String): String;
procedure ResetStreams;
procedure WriteBorderList(AStream: TStream);
procedure WriteCols(AStream: TStream; AWorksheet: TsWorksheet);
@ -648,7 +648,7 @@ begin
if datanode.NodeName = 'v' then
dataStr := GetNodeValue(datanode)
else
if datanode.NodeName = 'f' then
if (boReadFormulas in FWorkbook.Options) and (datanode.NodeName = 'f') then
begin
// Formula to cell
formulaStr := GetNodeValue(datanode);
@ -660,12 +660,12 @@ begin
s := GetAttrValue(datanode, 'ref');
if (s <>'') then
begin
cell^.FormulaValue.FormulaStr := '=' + formulaStr;
cell^.FormulaValue := formulaStr;
FWorksheet.UseSharedFormula(s, cell);
end;
end
else
cell^.FormulaValue.FormulaStr := '=' + formulaStr;
cell^.FormulaValue := formulaStr;
end;
end;
datanode := datanode.NextSibling;
@ -2407,10 +2407,11 @@ begin
end;
{ Prepares a string formula for writing }
function TsSpreadOOXMLWriter.PrepareFormula(const AFormula: TsFormula): String;
function TsSpreadOOXMLWriter.PrepareFormula(const AFormula: String): String;
begin
Result := AFormula.FormulaStr;
Result := AFormula;
if (Result <> '') and (Result[1] = '=') then Delete(Result, 1, 1);
Result := UTF8TextToXMLText(Result)
end;
{ Is called before zipping the individual file parts. Rewinds the streams. }
@ -2426,15 +2427,6 @@ begin
ResetStream(FSSharedStrings_complete);
for i := 0 to High(FSSheets) do
ResetStream(FSSheets[i]);
{
FSContentTypes.Position := 0;
FSRelsRels.Position := 0;
FSWorkbookRels.Position := 0;
FSWorkbook.Position := 0;
FSStyles.Position := 0;
FSSharedStrings_complete.Position := 0;
for stream in FSSheets do stream.Position := 0;
}
end;
{
@ -2544,6 +2536,7 @@ var
r, c, r2, c2: Cardinal;
cell: PCell;
id: Cardinal;
t, v: String;
begin
cellPosText := TsWorksheet.CellPosToText(ARow, ACol);
lStyleIndex := GetStyleIndex(ACell);
@ -2596,15 +2589,53 @@ begin
CellPosText, lStyleIndex,
PtrInt(ACell^.SharedFormulaBase) // ID of the shared formula
]));
end else
end else begin
// "normal" formula
case ACell^.ContentType of
cctFormula:
begin
t := '';
v := '';
end;
cctUTF8String:
begin
t := ' t="str"';
v := Format('<v>%s</v>', [UTF8TextToXMLText(ACell^.UTF8StringValue)]);
end;
cctNumber:
begin
t := '';
v := Format('<v>%g</v>', [ACell^.NumberValue], FPointSeparatorSettings);
end;
cctDateTime:
begin
t := '';
v := Format('<v>%g</v>', [ACell^.DateTimeValue], FPointSeparatorSettings);
end;
cctBool:
begin
t := ' t="b"';
if ACell^.BoolValue then
v := '<v>1</v>'
else
v := '<v>0</v>';
end;
cctError:
begin
t := ' t="e"';
v := Format('<v>%s</v>', [GetErrorValueStr(ACell^.ErrorValue)]);
end;
end;
AppendToStream(AStream, Format(
'<c r="%s" s="%d">' +
'<c r="%s" s="%d"%s>' +
'<f>%s</f>' +
'%s' +
'</c>', [
CellPosText, lStyleIndex,
PrepareFormula(ACell^.FormulaValue)
CellPosText, lStyleIndex, t,
PrepareFormula(ACell^.FormulaValue),
v
]));
end;
end;
{*******************************************************************