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

fpspreadsheet: Redo storage of formulas: formulas now are stored in a separate tree independent of the cells tree. The field FormulaValue of TCell record was removed. All unit tests passed. Demos updated (issues of speedtest due to SST in BIFF8 found - not related).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6446 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-05-30 22:15:07 +00:00
parent 9da45f0c2c
commit 40fabfc201
35 changed files with 1476 additions and 856 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
components/fpspreadsheet/examples/fpsspeedtest/fpsspeedtest.lpi
View File

@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8"?> <?xml version="1.0" encoding="UTF-8"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<Version Value="10"/> <Version Value="11"/>
<PathDelim Value="\"/> <PathDelim Value="\"/>
<General> <General>
<SessionStorage Value="InProjectDir"/> <SessionStorage Value="InProjectDir"/>
@ -21,9 +21,10 @@
<DestinationDirectory Value="c:\temp\fpsspeedtest"/> <DestinationDirectory Value="c:\temp\fpsspeedtest"/>
</PublishOptions> </PublishOptions>
<RunParams> <RunParams>
<local> <FormatVersion Value="2"/>
<FormatVersion Value="1"/> <Modes Count="1">
</local> <Mode0 Name="default"/>
</Modes>
</RunParams> </RunParams>
<RequiredPackages Count="2"> <RequiredPackages Count="2">
<Item1> <Item1>

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

@ -51,7 +51,7 @@ begin
parser := TsSpreadsheetParser.Create(worksheet); parser := TsSpreadsheetParser.Create(worksheet);
try try
try try
parser.Expression := cell^.FormulaValue; parser.Expression := worksheet.ReadFormula(cell);
res := parser.Evaluate; res := parser.Evaluate;
WriteLn('A2: ', parser.Expression); WriteLn('A2: ', parser.Expression);

2
components/fpspreadsheet/examples/other/demo_search.pas
View File

@ -7,7 +7,7 @@ uses
cthreads, cthreads,
{$ENDIF}{$ENDIF} {$ENDIF}{$ENDIF}
SysUtils, Classes, TypInfo, SysUtils, Classes, TypInfo,
fpsTypes, fpSpreadsheet, fpsSearch, fpsUtils, laz_fpspreadsheet; fpsTypes, fpSpreadsheet, fpsSearch, fpsUtils;
var var
workbook: TsWorkbook; workbook: TsWorkbook;

2
components/fpspreadsheet/examples/other/demo_write_headerfooter_images.lpi
View File

@ -55,7 +55,7 @@
<SearchPaths> <SearchPaths>
<IncludeFiles Value="..\..\source"/> <IncludeFiles Value="..\..\source"/>
<OtherUnitFiles Value="..\..\source\common"/> <OtherUnitFiles Value="..\..\source\common"/>
<UnitOutputDirectory Value="..\..\lib\$(TargetCPU)-$(TargetOS)"/> <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths> </SearchPaths>
<Parsing> <Parsing>
<SyntaxOptions> <SyntaxOptions>

2
components/fpspreadsheet/examples/read_write/excel2demo/excel2read.lpr
View File

@ -50,7 +50,7 @@ begin
UTF8ToConsole(MyWorkSheet.ReadAsText(CurCell^.Row, CurCell^.Col)) UTF8ToConsole(MyWorkSheet.ReadAsText(CurCell^.Row, CurCell^.Col))
); );
if HasFormula(CurCell) then if HasFormula(CurCell) then
Write(' (Formula ', CurCell^.FormulaValue, ')'); Write(' (Formula ', MyWorksheet.ReadFormula(CurCell), ')');
WriteLn; WriteLn;
end; end;

2
components/fpspreadsheet/examples/read_write/excel5demo/excel5read.lpr
View File

@ -48,7 +48,7 @@ begin
' Col: ', CurCell^.Col, ' Value: ', ' Col: ', CurCell^.Col, ' Value: ',
UTF8ToConsole(MyWorkSheet.ReadAsText(CurCell^.Row, CurCell^.Col))); UTF8ToConsole(MyWorkSheet.ReadAsText(CurCell^.Row, CurCell^.Col)));
if HasFormula(CurCell) then if HasFormula(CurCell) then
Write(' - Formula: ', CurCell^.FormulaValue); Write(' - Formula: ', MyWorksheet.ReadFormula(CurCell));
WriteLn; WriteLn;
end; end;

11
components/fpspreadsheet/examples/read_write/htmldemo/htmlread_http.lpi
View File

@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8"?> <?xml version="1.0" encoding="UTF-8"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<Version Value="10"/> <Version Value="11"/>
<PathDelim Value="\"/> <PathDelim Value="\"/>
<General> <General>
<Flags> <Flags>
@ -23,9 +23,16 @@
</PublishOptions> </PublishOptions>
<RunParams> <RunParams>
<local> <local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/> <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
</local> </local>
<FormatVersion Value="2"/>
<Modes Count="1">
<Mode0 Name="default">
<local>
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
</local>
</Mode0>
</Modes>
</RunParams> </RunParams>
<RequiredPackages Count="1"> <RequiredPackages Count="1">
<Item1> <Item1>

2
components/fpspreadsheet/examples/read_write/htmldemo/htmlread_http.lpr
View File

@ -20,7 +20,7 @@ var
const const
// url = 'http://unicode.e-workers.de/entities.php'; // url = 'http://unicode.e-workers.de/entities.php';
url = 'http://www.freepascal.org/docs.var'; url = 'https://www.freepascal.org/docs.var';
begin begin
stream := TMemoryStream.Create; stream := TMemoryStream.Create;

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

@ -53,7 +53,7 @@ begin
UTF8ToConsole(MyWorkSheet.ReadAsText(CurCell^.Row, CurCell^.Col)) UTF8ToConsole(MyWorkSheet.ReadAsText(CurCell^.Row, CurCell^.Col))
); );
if HasFormula(CurCell) then if HasFormula(CurCell) then
WriteLn(' Formula: ', CurCell^.FormulaValue) WriteLn(' Formula: ', MyWorksheet.ReadFormula(Curcell))
else else
WriteLn; WriteLn;
end; end;

9
components/fpspreadsheet/examples/visual/fpschart/workbookchartsource-deprecated/fpschartsource.lpi
View File

@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8"?> <?xml version="1.0" encoding="UTF-8"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<Version Value="10"/> <Version Value="11"/>
<PathDelim Value="\"/> <PathDelim Value="\"/>
<General> <General>
<SessionStorage Value="InProjectDir"/> <SessionStorage Value="InProjectDir"/>
@ -44,9 +44,10 @@
<Version Value="2"/> <Version Value="2"/>
</PublishOptions> </PublishOptions>
<RunParams> <RunParams>
<local> <FormatVersion Value="2"/>
<FormatVersion Value="1"/> <Modes Count="1">
</local> <Mode0 Name="default"/>
</Modes>
</RunParams> </RunParams>
<RequiredPackages Count="3"> <RequiredPackages Count="3">
<Item1> <Item1>

3
components/fpspreadsheet/examples/visual/fpschart/workbookchartsource-deprecated/fpschartsource.lpr
View File

@ -7,8 +7,7 @@ uses
cthreads, cthreads,
{$ENDIF}{$ENDIF} {$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset Interfaces, // this includes the LCL widgetset
Forms, mainform, tachartlazaruspkg Forms, mainform;
{ you can add units after this };
{$R *.res} {$R *.res}

18
components/fpspreadsheet/examples/visual/fpschart/workbookchartsource-deprecated/mainform.lfm
View File

@ -7,7 +7,7 @@ object Form1: TForm1
ClientHeight = 634 ClientHeight = 634
ClientWidth = 877 ClientWidth = 877
OnCreate = FormCreate OnCreate = FormCreate
LCLVersion = '1.7' LCLVersion = '1.9.0.0'
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 0
Height = 40 Height = 40
@ -77,7 +77,6 @@ object Form1: TForm1
WorkbookSource = sWorkbookSource1 WorkbookSource = sWorkbookSource1
Align = alClient Align = alClient
AutoAdvance = aaDown AutoAdvance = aaDown
ColCount = 27
DefaultColWidth = 64 DefaultColWidth = 64
DefaultRowHeight = 22 DefaultRowHeight = 22
Font.Color = clBlack Font.Color = clBlack
@ -85,7 +84,6 @@ object Form1: TForm1
Font.Name = 'Calibri' Font.Name = 'Calibri'
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goThumbTracking] Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goThumbTracking]
ParentFont = False ParentFont = False
RowCount = 101
TabOrder = 1 TabOrder = 1
TitleFont.Color = clBlack TitleFont.Color = clBlack
TitleFont.Height = -15 TitleFont.Height = -15
@ -110,12 +108,16 @@ object Form1: TForm1
Width = 470 Width = 470
AxisList = < AxisList = <
item item
Marks.LabelBrush.Style = bsClear
Minors = <> Minors = <>
Title.LabelFont.Orientation = 900 Title.LabelFont.Orientation = 900
Title.LabelBrush.Style = bsClear
end end
item item
Alignment = calBottom Alignment = calBottom
Marks.LabelBrush.Style = bsClear
Minors = <> Minors = <>
Title.LabelBrush.Style = bsClear
end> end>
BackColor = clWhite BackColor = clWhite
Foot.Brush.Color = clBtnFace Foot.Brush.Color = clBtnFace
@ -141,12 +143,16 @@ object Form1: TForm1
Width = 470 Width = 470
AxisList = < AxisList = <
item item
Marks.LabelBrush.Style = bsClear
Minors = <> Minors = <>
Title.LabelFont.Orientation = 900 Title.LabelFont.Orientation = 900
Title.LabelBrush.Style = bsClear
end end
item item
Alignment = calBottom Alignment = calBottom
Marks.LabelBrush.Style = bsClear
Minors = <> Minors = <>
Title.LabelBrush.Style = bsClear
end> end>
BackColor = clWhite BackColor = clWhite
Depth = 10 Depth = 10
@ -179,13 +185,17 @@ object Form1: TForm1
AxisList = < AxisList = <
item item
Visible = False Visible = False
Marks.LabelBrush.Style = bsClear
Minors = <> Minors = <>
Title.LabelFont.Orientation = 900 Title.LabelFont.Orientation = 900
Title.LabelBrush.Style = bsClear
end end
item item
Visible = False Visible = False
Alignment = calBottom Alignment = calBottom
Marks.LabelBrush.Style = bsClear
Minors = <> Minors = <>
Title.LabelBrush.Style = bsClear
end> end>
Foot.Brush.Color = clBtnFace Foot.Brush.Color = clBtnFace
Foot.Font.Color = clBlue Foot.Font.Color = clBlue
@ -210,7 +220,7 @@ object Form1: TForm1
end end
object sWorkbookSource1: TsWorkbookSource object sWorkbookSource1: TsWorkbookSource
AutoDetectFormat = False AutoDetectFormat = False
FileFormat = sfOOXML FileFormat = sfUser
Options = [] Options = []
left = 184 left = 184
top = 320 top = 320

2
components/fpspreadsheet/examples/visual/fpschart/workbookchartsource-deprecated/mainform.pas
View File

@ -7,7 +7,7 @@ interface
uses uses
Classes, SysUtils, FileUtil, TAGraph, TASeries, Forms, Controls, Classes, SysUtils, FileUtil, TAGraph, TASeries, Forms, Controls,
Graphics, Dialogs, ExtCtrls, StdCtrls, Graphics, Dialogs, ExtCtrls, StdCtrls,
fpstypes, fpspreadsheetctrls, fpspreadsheetgrid, fpspreadsheetchart; fpstypes, fpspreadsheetctrls, fpspreadsheetgrid, fpspreadsheetchart, fpsallformats;
type type

11
components/fpspreadsheet/examples/visual/fpschart/worksheetchartsource/fpschart.lpi
View File

@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8"?> <?xml version="1.0" encoding="UTF-8"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<Version Value="10"/> <Version Value="11"/>
<General> <General>
<SessionStorage Value="InProjectDir"/> <SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/> <MainUnit Value="0"/>
@ -24,9 +24,16 @@
</PublishOptions> </PublishOptions>
<RunParams> <RunParams>
<local> <local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local> </local>
<FormatVersion Value="2"/>
<Modes Count="1">
<Mode0 Name="default">
<local>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</Mode0>
</Modes>
</RunParams> </RunParams>
<RequiredPackages Count="4"> <RequiredPackages Count="4">
<Item1> <Item1>

11
components/fpspreadsheet/examples/visual/fpsctrls_no_install/demo_ctrls.lpi
View File

@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8"?> <?xml version="1.0" encoding="UTF-8"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<Version Value="10"/> <Version Value="11"/>
<PathDelim Value="\"/> <PathDelim Value="\"/>
<General> <General>
<SessionStorage Value="InProjectDir"/> <SessionStorage Value="InProjectDir"/>
@ -21,9 +21,10 @@
<Version Value="2"/> <Version Value="2"/>
</PublishOptions> </PublishOptions>
<RunParams> <RunParams>
<local> <FormatVersion Value="2"/>
<FormatVersion Value="1"/> <Modes Count="1">
</local> <Mode0 Name="default"/>
</Modes>
</RunParams> </RunParams>
<RequiredPackages Count="1"> <RequiredPackages Count="1">
<Item1> <Item1>
@ -51,7 +52,7 @@
<Filename Value="demo_ctrls"/> <Filename Value="demo_ctrls"/>
</Target> </Target>
<SearchPaths> <SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/> <IncludeFiles Value="$(ProjOutDir);..\..\..\source"/>
<OtherUnitFiles Value="..\..\..\source\common;..\..\..\source\visual"/> <OtherUnitFiles Value="..\..\..\source\common;..\..\..\source\visual"/>
<UnitOutputDirectory Value="..\..\lib\$(TargetCPU)-$(TargetOS)"/> <UnitOutputDirectory Value="..\..\lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths> </SearchPaths>

11
components/fpspreadsheet/examples/visual/wikitablemaker/wikitablemaker.lpi
View File

@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8"?> <?xml version="1.0" encoding="UTF-8"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<Version Value="10"/> <Version Value="11"/>
<PathDelim Value="\"/> <PathDelim Value="\"/>
<General> <General>
<SessionStorage Value="InProjectDir"/> <SessionStorage Value="InProjectDir"/>
@ -83,9 +83,10 @@
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions> </PublishOptions>
<RunParams> <RunParams>
<local> <FormatVersion Value="2"/>
<FormatVersion Value="1"/> <Modes Count="1">
</local> <Mode0 Name="default"/>
</Modes>
</RunParams> </RunParams>
<RequiredPackages Count="3"> <RequiredPackages Count="3">
<Item1> <Item1>
@ -124,7 +125,7 @@
<Filename Value="wikitablemaker"/> <Filename Value="wikitablemaker"/>
</Target> </Target>
<SearchPaths> <SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/> <IncludeFiles Value="$(ProjOutDir);..\..\..\source"/>
<OtherUnitFiles Value="..\..\..\source\common;..\..\..\source\visual"/> <OtherUnitFiles Value="..\..\..\source\common;..\..\..\source\visual"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths> </SearchPaths>

4
components/fpspreadsheet/examples/visual/zoom/zdmain.lfm
View File

@ -7,7 +7,7 @@ object MainForm: TMainForm
ClientHeight = 476 ClientHeight = 476
ClientWidth = 678 ClientWidth = 678
OnCreate = FormCreate OnCreate = FormCreate
LCLVersion = '1.7' LCLVersion = '1.9.0.0'
object Grid: TsWorksheetGrid object Grid: TsWorksheetGrid
Left = 5 Left = 5
Height = 386 Height = 386
@ -20,12 +20,10 @@ object MainForm: TMainForm
WorkbookSource = Grid.internal WorkbookSource = Grid.internal
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
AutoAdvance = aaDown AutoAdvance = aaDown
ColCount = 27
DefaultColWidth = 64 DefaultColWidth = 64
DefaultRowHeight = 22 DefaultRowHeight = 22
MouseWheelOption = mwGrid MouseWheelOption = mwGrid
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSizing, goColSizing, goEditing, goThumbTracking, goSmoothScroll] Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSizing, goColSizing, goEditing, goThumbTracking, goSmoothScroll]
RowCount = 101
TabOrder = 0 TabOrder = 0
OnMouseWheel = GridMouseWheel OnMouseWheel = GridMouseWheel
end end

2
components/fpspreadsheet/examples/visual/zoom/zdmain.pas
View File

@ -7,7 +7,7 @@ interface
uses uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
Spin, Buttons, Types, Spin, Buttons, Types,
fpstypes, fpspreadsheet, fpspreadsheetgrid; fpstypes, fpspreadsheet, fpspreadsheetgrid, {%H-}fpsAllFormats;
type type

9
components/fpspreadsheet/examples/visual/zoom/zoomdemo.lpi
View File

@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8"?> <?xml version="1.0" encoding="UTF-8"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<Version Value="10"/> <Version Value="11"/>
<PathDelim Value="\"/> <PathDelim Value="\"/>
<General> <General>
<SessionStorage Value="InProjectDir"/> <SessionStorage Value="InProjectDir"/>
@ -18,9 +18,10 @@
<Version Value="2"/> <Version Value="2"/>
</PublishOptions> </PublishOptions>
<RunParams> <RunParams>
<local> <FormatVersion Value="2"/>
<FormatVersion Value="1"/> <Modes Count="1">
</local> <Mode0 Name="default"/>
</Modes>
</RunParams> </RunParams>
<RequiredPackages Count="2"> <RequiredPackages Count="2">
<Item1> <Item1>

380
components/fpspreadsheet/source/common/fpsclasses.pas
View File

@ -6,7 +6,7 @@ interface
uses uses
Classes, SysUtils, avglvltree, Classes, SysUtils, avglvltree,
fpstypes; fpstypes, fpsExprParser;
type type
{ forward declarations } { forward declarations }
@ -61,7 +61,8 @@ type
function GetFirst: PsRowCol; function GetFirst: PsRowCol;
function GetLast: PsRowCol; function GetLast: PsRowCol;
procedure InsertRowOrCol(AIndex: Cardinal; IsRow: Boolean); procedure InsertRowOrCol(AIndex: Cardinal; IsRow: Boolean);
procedure MoveAlongRow(ARow, AFromCol, AToCol: Cardinal); procedure MoveAlongCol(ARow, ACol, AToRow: Cardinal);
procedure MoveAlongRow(ARow, ACol, AToCol: Cardinal);
procedure Remove(ARow, ACol: Cardinal); overload; procedure Remove(ARow, ACol: Cardinal); overload;
end; end;
@ -174,6 +175,32 @@ type
function GetEnumerator: TsCellRangeEnumerator; function GetEnumerator: TsCellRangeEnumerator;
end; end;
{ TsFormulas }
TsFormulaEnumerator = class(TsRowColEnumerator)
protected
function GetCurrent: PsFormula;
public
function GetEnumerator: TsFormulaEnumerator; inline;
property Current: PsFormula read GetCurrent;
end;
TsFormulas = class(TsRowColAVLTree)
protected
procedure DisposeData(var AData: Pointer); override;
function NewData: Pointer; override;
public
function AddFormula(ARow, ACol: Cardinal; AFormula: String = '';
AParsedFormula: TsExpressionParser = nil): PsFormula;
procedure DeleteFormula(ACell: PCell); overload;
procedure DeleteFormula(ARow, ACol: Cardinal); overload;
procedure DeleteRowOrCol(AIndex: Cardinal; IsRow: Boolean);
function FindFormula(ACell: PCell): PsFormula; overload;
function FindFormula(ARow, ACol: Cardinal): PsFormula; overload;
procedure InsertRowOrCol(AIndex: Cardinal; IsRow: Boolean);
// enumerators
function GetEnumerator: TsFormulaEnumerator;
end;
{ TsCellFormatList } { TsCellFormatList }
TsCellFormatList = class(TFPList) TsCellFormatList = class(TFPList)
private private
@ -223,6 +250,146 @@ begin
end; end;
{ Call-back function for formulas when rows/cols are inserted/deleted }
function FixDeletedCol(AExprNode: TsExprNode; AData: Pointer): Boolean;
var
colIndex: Cardinal;
rng: TsCellRange;
begin
Result := false;
colIndex := PtrInt(AData);
if AExprNode is TsCellExprNode then
begin
if not TsCellExprNode(AExprNode).Has3dLink then
if TsCellExprNode(AExprNode).Col > colIndex then begin
TsCellExprNode(AExprNode).Col := TsCellexprNode(AExprNode).Col - 1;
Result := true;
end else
if TsCellExprNode(AExprNode).Col = colIndex then begin
TsCellExprNode(AExprNode).Error := errIllegalRef;
Result := true;
end;
end else
if AExprNode is TsCellRangeExprNode then
begin
if not TsCellRangeExprNode(AExprNode).Has3dLink then begin
rng := TsCellRangeExprNode(AExprNode).Range;
if (rng.Col1 = colIndex) and (rng.Col2 = colIndex) then begin
TsCellRangeExprNode(AExprNode).Error := errIllegalRef;
Result := true;
end else begin
if rng.Col1 > colIndex then begin
dec(rng.Col1);
Result := true;
end;
if rng.Col2 >= colIndex then begin
dec(rng.Col2);
Result := true;
end;
TsCellRangeExprNode(AExprNode).Range := rng;
end;
end;
end;
end;
function FixDeletedRow(AExprNode: TsExprNode; AData: Pointer): Boolean;
var
rowIndex: Cardinal;
rng: TsCellRange;
begin
Result := false;
rowIndex := PtrInt(AData);
if AExprNode is TsCellExprNode then
begin
if not TsCellExprNode(AExprNode).Has3dLink then
if TsCellExprNode(AExprNode).Row > rowIndex then begin
TsCellExprNode(AExprNode).Row := TsCellExprNode(AExprNode).Row - 1;
Result := true;
end else
if TsCellExprNode(AExprNode).Row = rowIndex then begin
TsCelLExprNode(AExprNode).Error := errIllegalRef;
Result := true;
end;
end else
if AExprNode is TsCellRangeExprNode then
begin
if not TsCellRangeExprNode(AExprNode).Has3dLink then begin
rng := TsCellRangeExprNode(AExprNode).Range;
if (rng.Row1 = rowIndex) and (rng.Row2 = rowIndex) then begin
TsCellRangeExprNode(AExprNode).Error := errIllegalRef;
Result := true;
end else
begin
if rng.Row1 > rowIndex then begin
dec(rng.Row1);
Result := true;
end;
if rng.Row2 >= rowIndex then begin
dec(rng.Row2);
Result := true;
end;
TsCellRangeExprNode(AExprNode).Range := rng;
end;
end;
end;
end;
function FixInsertedCol(AExprNode: TsExprNode; AData: Pointer): Boolean;
var
colIndex: Cardinal;
rng: TsCellRange;
begin
Result := false;
colIndex := PtrInt(AData);
if AExprNode is TsCellExprNode then
begin
if not TsCellExprNode(AExprNode).Has3dLink then
if TsCellExprNode(AExprNode).Col >= colIndex then begin
TsCellExprNode(AExprNode).Col := TsCellexprNode(AExprNode).Col + 1;
Result := true;
end;
end else
if AExprNode is TsCellRangeExprNode then
begin
if not TsCellRangeExprNode(AExprNode).Has3dLink then begin
rng := TsCellRangeExprNode(AExprNode).Range;
if rng.Col1 >= colIndex then inc(rng.Col1);
if rng.Col2 >= colIndex then inc(rng.Col2);
TsCellRangeExprNode(AExprNode).Range := rng;
Result := true;
end;
end;
end;
function FixInsertedRow(AExprNode: TsExprNode; AData: Pointer): Boolean;
var
rowIndex: Cardinal;
rng: TsCellRange;
begin
Result := false;
rowIndex := PtrInt(AData);
if AExprNode is TsCellExprNode then
begin
if not TsCellexprNode(AExprNode).Has3dLink then
if TsCellExprNode(AExprNode).Row >= rowIndex then begin
TsCellExprNode(AExprNode).Row := TsCellExprNode(AExprNode).Row + 1;
Result := true;
end;
end else
if AExprNode is TsCellRangeExprNode then
begin
if not TsCellRangeExprNode(AExprNode).Has3dLink then begin
rng := TsCellRangeExprNode(AExprNode).Range;
if rng.Row1 >= rowIndex then inc(rng.Row1);
if rng.Row2 >= rowIndex then inc(rng.Row2);
TsCellRangeExprNode(AExprNode).Range := rng;
Result := true;
end;
end;
end;
{==============================================================================} {==============================================================================}
{ TsRowColEnumerator } { TsRowColEnumerator }
{ A specialized enumerator for TsRowColAVLTree using the pointers to the data } { A specialized enumerator for TsRowColAVLTree using the pointers to the data }
@ -608,20 +775,64 @@ begin
end; end;
end; end;
{@@ ----------------------------------------------------------------------------
This method moves the cell in the specified column (ACol) and at row AFromRow
along the row before the row with index AToRow.
-------------------------------------------------------------------------------}
procedure TsRowColAVLTree.MoveAlongCol(ARow, ACol, AToRow: Cardinal);
var
r: Cardinal;
node: TAvgLvlTreeNode;
item: PsRowCol;
begin
if ARow = AToRow then
exit;
if ARow < AToRow then
begin
node := FindLowest;
while Assigned(node) do
begin
item := PsRowCol(node.Data);
if item^.Col = ACol then break;
node := FindSuccessor(node);
end;
r := ARow;
while r < AToRow do begin
Exchange(r, ACol, r+1, ACol);
inc(r);
end;
end else
begin
node:= FindHighest;
while Assigned(node) do
begin
item := PsRowCol(node.Data);
if item^.Col = ACol then break;
node := FindPrecessor(node);
end;
r := ARow;
while r > AToRow do begin
Exchange(r, ACol, r-1, ACol);
dec(r);
end;
end;
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
This method moves the cell in the specified row (ARow) and at column AFromCol This method moves the cell in the specified row (ARow) and at column AFromCol
along the row before the column with index AToCol. along the row before the column with index AToCol.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsRowColAVLTree.MoveAlongRow(ARow, AFromCol, AToCol: Cardinal); procedure TsRowColAVLTree.MoveAlongRow(ARow, ACol, AToCol: Cardinal);
var var
c: Cardinal; c: Cardinal;
node: TAvgLvlTreeNode; node: TAvgLvlTreeNode;
item: PsRowCol; item: PsRowCol;
begin begin
if AFromCol = AToCol then if ACol = AToCol then
exit; exit;
if AFromCol < AToCol then if ACol < AToCol then
begin begin
node := FindLowest; node := FindLowest;
while Assigned(node) do while Assigned(node) do
@ -631,7 +842,7 @@ begin
if item^.Row = ARow then break; if item^.Row = ARow then break;
node := FindSuccessor(node); node := FindSuccessor(node);
end; end;
c := AFromCol; c := ACol;
while c < AToCol do begin while c < AToCol do begin
Exchange(ARow, c, ARow, c+1); Exchange(ARow, c, ARow, c+1);
inc(c); inc(c);
@ -646,7 +857,7 @@ begin
if item^.Row = ARow then break; if item^.Row = ARow then break;
node := FindPrecessor(node); node := FindPrecessor(node);
end; end;
c := AFromCol; c := ACol;
while c > AToCol do begin while c > AToCol do begin
Exchange(ARow, c, ARow, c-1); Exchange(ARow, c, ARow, c-1);
dec(c); dec(c);
@ -926,16 +1137,16 @@ end;
{ TsHyperlinkEnumerator: enumerator for the TsHyperlinks AVLTree } { TsHyperlinkEnumerator: enumerator for the TsHyperlinks AVLTree }
{==============================================================================} {==============================================================================}
function TsHyperlinkEnumerator.GetEnumerator: TsHyperlinkEnumerator;
begin
Result := self;
end;
function TsHyperlinkEnumerator.GetCurrent: PsHyperlink; function TsHyperlinkEnumerator.GetCurrent: PsHyperlink;
begin begin
Result := PsHyperlink(inherited GetCurrent); Result := PsHyperlink(inherited GetCurrent);
end; end;
function TsHyperlinkEnumerator.GetEnumerator: TsHyperlinkEnumerator;
begin
Result := self;
end;
{==============================================================================} {==============================================================================}
{ TsHyperlinks: an AVLTree to store hyperlink records for cells } { TsHyperlinks: an AVLTree to store hyperlink records for cells }
@ -1186,6 +1397,151 @@ begin
end; end;
{==============================================================================}
{ TsFormulaEnumerator }
{==============================================================================}
function TsFormulaEnumerator.GetCurrent: PsFormula;
begin
Result := PsFormula(inherited GetCurrent);
end;
function TsFormulaEnumerator.GetEnumerator: TsFormulaEnumerator;
begin
Result := self;
end;
{==============================================================================}
{ TsFormulas }
{==============================================================================}
function TsFormulas.AddFormula(ARow, ACol: Cardinal; AFormula: String = '';
AParsedFormula: TsExpressionParser = nil): PsFormula;
begin
Result := PsFormula(FindByRowCol(ARow, ACol));
if Result = nil then
Result := PsFormula(Add(ARow, ACol));
Result^.Text := AFormula; // unparsed formula
Result^.Parser := AParsedFormula; // if nil, will be parsed on next calculation
Result^.CalcState := csNotCalculated;
end;
procedure TsFormulas.DeleteFormula(ACell: PCell);
begin
if ACell <> nil then
Delete(ACell^.Row, ACell^.Col);
end;
procedure TsFormulas.DeleteFormula(ARow, ACol: Cardinal);
begin
Delete(ARow, ACol); // will release memory automatically
end;
procedure TsFormulas.DeleteRowOrCol(AIndex: Cardinal; IsRow: Boolean);
var
node, nextnode: TAvgLvlTreeNode;
formula: PsFormula;
changed: Boolean;
begin
node := FindLowest;
while Assigned(node) do
begin
changed := false;
nextnode := FindSuccessor(node);
formula := PsFormula(node.Data);
if IsRow then
begin
// Remove and destroy the formula record if it is in the deleted row
if formula^.Row = AIndex then
Delete(node)
else
if formula^.Row > AIndex then
dec(formula^.Row);
// Update all RowCol records at row indexes above the deleted row
changed := formula^.Parser.IterateNodes(@FixDeletedRow, Pointer(PtrInt(AIndex)));
end else
begin
// Remove and destroy the formula record if it is in the deleted column
if formula^.Col = AIndex then
Delete(node)
else begin
if formula^.Col > AIndex then
dec(formula^.Col);
// Update all RowCol records at column indexes above the deleted column
changed := formula^.Parser.IterateNodes(@FixDeletedCol, Pointer(PtrInt(AIndex)));
end;
end;
// Recreate the formula if required.
if changed then
formula^.Text := formula^.Parser.Expression;
node := nextnode;
end;
end;
procedure TsFormulas.DisposeData(var AData: Pointer);
begin
if AData <> nil then begin
PsFormula(AData)^.Text := '';
PsFormula(AData)^.Parser.Free;
Dispose(PsFormula(AData));
end;
AData := nil;
end;
function TsFormulas.FindFormula(ACell: PCell): PsFormula;
begin
if ACell <> nil then
Result := PsFormula(FindbyRowCol(ACell^.Row, ACell^.Col))
else
Result := nil;
end;
function TsFormulas.FindFormula(ARow, ACol: Cardinal): PsFormula;
begin
Result := PsFormula(FindByRowCol(ARow, ACol));
end;
// Formula enumerators (use in "for ... in" syntax)
function TsFormulas.GetEnumerator: TsFormulaEnumerator;
begin
Result := TsFormulaEnumerator.Create(self, 0, 0, $7FFFFFFF, $7FFFFFFF, false);
end;
procedure TsFormulas.InsertRowOrCol(AIndex: Cardinal; IsRow: Boolean);
var
node: TAvgLvlTreeNode;
formula: PsFormula;
changed: Boolean;
begin
node := FindLowest;
while Assigned(node) do begin
formula := PsFormula(node.Data);
if IsRow then
begin
if formula^.Row >= AIndex then inc(formula^.Row);
changed := formula^.Parser.IterateNodes(@FixInsertedRow, Pointer(PtrInt(AIndex)));
end else
begin
if formula^.Col >= AIndex then inc(formula^.Col);
changed := formula^.Parser.IterateNodes(@FixInsertedCol, Pointer(PtrInt(AIndex)));
end;
if changed then
formula^.Text := formula^.Parser.Expression;
node := FindSuccessor(node);
end;
end;
function TsFormulas.NewData: Pointer;
var
f: PsFormula;
begin
New(f);
f^.Text := '';
f^.Parser := nil;
f^.CalcState := csNotCalculated;
Result := f;
end;
{==============================================================================} {==============================================================================}
{ TsCellFormatList } { TsCellFormatList }
{==============================================================================} {==============================================================================}

235
components/fpspreadsheet/source/common/fpsexprparser.pas
View File

@ -45,7 +45,7 @@
// Keep spaces in formula // Keep spaces in formula
{$mode objfpc} {$mode objfpc}
{$h+} {$H+}
unit fpsExprParser; unit fpsExprParser;
interface interface
@ -78,8 +78,10 @@ const
]; ];
type type
// Forward declarations
TsExpressionParser = class; TsExpressionParser = class;
TsBuiltInExpressionManager = class; TsBuiltInExpressionManager = class;
TsExprNode = class;
TsResultType = (rtEmpty, rtBoolean, rtInteger, rtFloat, rtDateTime, rtString, TsResultType = (rtEmpty, rtBoolean, rtInteger, rtFloat, rtDateTime, rtString,
rtCell, rtCellRange, rtHyperlink, rtError, rtMissingArg, rtAny); rtCell, rtCellRange, rtHyperlink, rtError, rtMissingArg, rtAny);
@ -104,6 +106,10 @@ type
PsExpressionResult = ^TsExpressionResult; PsExpressionResult = ^TsExpressionResult;
TsExprParameterArray = array of TsExpressionResult; TsExprParameterArray = array of TsExpressionResult;
{ Function executed when iterating through all nodes (Parser.IterateNodes).
The function returns true if the text formula has to be rebuilt. }
TsExprNodeFunc = function(ANode: TsExprNode; AData: Pointer): Boolean;
{ TsExprNode } { TsExprNode }
TsExprNode = class(TObject) TsExprNode = class(TObject)
private private
@ -116,6 +122,7 @@ type
function AsString: string; virtual; abstract; function AsString: string; virtual; abstract;
procedure Check; virtual; //abstract; procedure Check; virtual; //abstract;
function Has3DLink: Boolean; virtual; function Has3DLink: Boolean; virtual;
function IterateNodes(AFunc: TsExprNodeFunc; AData: Pointer): Boolean; virtual;
function NodeType: TsResultType; virtual; abstract; function NodeType: TsResultType; virtual; abstract;
function NodeValue: TsExpressionResult; function NodeValue: TsExpressionResult;
property Parser: TsExpressionParser read FParser; property Parser: TsExpressionParser read FParser;
@ -134,6 +141,7 @@ type
constructor Create(AParser: TsExpressionParser; ALeft, ARight: TsExprNode); constructor Create(AParser: TsExpressionParser; ALeft, ARight: TsExprNode);
destructor Destroy; override; destructor Destroy; override;
function Has3DLink: Boolean; override; function Has3DLink: Boolean; override;
function IterateNodes(AFunc: TsExprNodeFunc; AData: Pointer): boolean; override;
property Left: TsExprNode read FLeft; property Left: TsExprNode read FLeft;
property Right: TsExprNode read FRight; property Right: TsExprNode read FRight;
end; end;
@ -555,6 +563,7 @@ type
function AsString: String; override; function AsString: String; override;
procedure Check; override; procedure Check; override;
function Has3DLink: Boolean; override; function Has3DLink: Boolean; override;
function IterateNodes(AFunc: TsExprNodeFunc; AData: Pointer): Boolean; override;
property ArgumentNodes: TsExprArgumentArray read FArgumentNodes; property ArgumentNodes: TsExprArgumentArray read FArgumentNodes;
property ArgumentParams: TsExprParameterArray read FArgumentParams; property ArgumentParams: TsExprParameterArray read FArgumentParams;
end; end;
@ -592,12 +601,11 @@ type
FCell: PCell; FCell: PCell;
FSheetName: String; FSheetName: String;
FIsRef: Boolean; FIsRef: Boolean;
FError: TsErrorValue;
protected protected
function GetCol: Cardinal; function GetCol: Cardinal;
function GetRow: Cardinal; function GetRow: Cardinal;
function GetSheet: TsBasicWorksheet; function GetSheet: TsBasicWorksheet;
function GetSheetIndex: Integer;
function GetSheetName: String;
function GetWorkbook: TsBasicWorkbook; function GetWorkbook: TsBasicWorkbook;
procedure GetNodeValue(out AResult: TsExpressionResult); override; procedure GetNodeValue(out AResult: TsExpressionResult); override;
public public
@ -606,8 +614,14 @@ type
function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: string; override; function AsString: string; override;
procedure Check; override; procedure Check; override;
function GetSheetIndex: Integer;
function GetSheetName: String;
function Has3DLink: Boolean; override; function Has3DLink: Boolean; override;
function IterateNodes(AFunc: TsExprNodeFunc; AData: Pointer): Boolean; override;
function NodeType: TsResultType; override; function NodeType: TsResultType; override;
property Col: Cardinal read FCol write FCol; // Be careful when modifying Col and Row
property Row: Cardinal read FRow write FRow;
property Error: TsErrorValue read FError write FError;
property Worksheet: TsBasicWorksheet read FWorksheet; property Worksheet: TsBasicWorksheet read FWorksheet;
end; end;
@ -622,10 +636,13 @@ type
FSheetIndex: array[TsCellRangeIndex] of Integer; FSheetIndex: array[TsCellRangeIndex] of Integer;
FFlags: TsRelFlags; FFlags: TsRelFlags;
F3dRange: Boolean; F3dRange: Boolean;
FError: TsErrorValue;
function GetRange: TsCellRange;
procedure SetRange(const ARange: TsCellRange);
protected protected
function GetCol(AIndex: TsCellRangeIndex): Cardinal; function GetCol(AIndex: TsCellRangeIndex): Cardinal;
function GetRow(AIndex: TsCellRangeIndex): Cardinal; function GetRow(AIndex: TsCellRangeIndex): Cardinal;
procedure GetNodeValue(out Result: TsExpressionResult); override; procedure GetNodeValue(out AResult: TsExpressionResult); override;
function GetWorkbook: TsBasicWorkbook; function GetWorkbook: TsBasicWorkbook;
public public
constructor Create(AParser: TsExpressionParser; AWorksheet: TsBasicWorksheet; constructor Create(AParser: TsExpressionParser; AWorksheet: TsBasicWorksheet;
@ -633,8 +650,12 @@ type
function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: String; override; function AsString: String; override;
procedure Check; override; procedure Check; override;
function GetSheetIndex(AIndex: TsCellRangeIndex): Integer;
function Has3DLink: Boolean; override; function Has3DLink: Boolean; override;
function IterateNodes(AFunc: TsExprNodeFunc; AData: Pointer): Boolean; override;
function NodeType: TsResultType; override; function NodeType: TsResultType; override;
property Error: TsErrorValue read FError write FError;
property Range: TsCellRange read GetRange write SetRange; // Be careful!
property Workbook: TsBasicWorkbook read GetWorkbook; property Workbook: TsBasicWorkbook read GetWorkbook;
property Worksheet: TsBasicWorksheet read FWorksheet; property Worksheet: TsBasicWorksheet read FWorksheet;
end; end;
@ -744,8 +765,8 @@ type
function TokenType: TsTokenType; function TokenType: TsTokenType;
procedure CreateHashList; procedure CreateHashList;
property Scanner: TsExpressionScanner read FScanner; property Scanner: TsExpressionScanner read FScanner;
property ExprNode: TsExprNode read FExprNode;
property Dirty: Boolean read FDirty; property Dirty: Boolean read FDirty;
property ExprNode: TsExprNode read FExprNode;
public public
constructor Create(AWorksheet: TsBasicWorksheet); virtual; constructor Create(AWorksheet: TsBasicWorksheet); virtual;
@ -756,6 +777,7 @@ type
function Evaluate: TsExpressionResult; function Evaluate: TsExpressionResult;
procedure EvaluateExpression(out AResult: TsExpressionResult); procedure EvaluateExpression(out AResult: TsExpressionResult);
function Has3DLinks: Boolean; function Has3DLinks: Boolean;
function IterateNodes(AFunc: TsExprNodeFunc; AData: Pointer): boolean;
procedure PrepareCopyMode(ASourceCell, ADestCell: PCell); procedure PrepareCopyMode(ASourceCell, ADestCell: PCell);
function ResultType: TsResultType; function ResultType: TsResultType;
@ -820,6 +842,16 @@ type
property Identifiers[AIndex: Integer]: TsBuiltInExprIdentifierDef read GetI; property Identifiers[AIndex: Integer]: TsBuiltInExprIdentifierDef read GetI;
end; end;
{ TsFormula }
TsFormula = record
Row, Col: Cardinal;
Text: String;
Parser: TsExpressionParser;
CalcState: TsCalcState;
end;
PsFormula = ^TsFormula;
{ Exception classes }
EExprParser = class(Exception); EExprParser = class(Exception);
ECalcEngine = class(Exception); ECalcEngine = class(Exception);
@ -1494,8 +1526,10 @@ end;
procedure TsExpressionParser.EvaluateExpression(out AResult: TsExpressionResult); procedure TsExpressionParser.EvaluateExpression(out AResult: TsExpressionResult);
begin begin
{ // Not needed. May be missing after copying formulas
if (FExpression = '') then if (FExpression = '') then
ParserError(rsExpressionEmpty); ParserError(rsExpressionEmpty);
}
if not Assigned(FExprNode) then if not Assigned(FExprNode) then
ParserError(rsErrorInExpression); ParserError(rsErrorInExpression);
FExprNode.GetNodeValue(AResult); FExprNode.GetNodeValue(AResult);
@ -1941,6 +1975,12 @@ begin
Result := FExprNode.Has3DLink; Result := FExprNode.Has3DLink;
end; end;
function TsExpressionParser.IterateNodes(AFunc: TsExprNodeFunc;
AData: Pointer): Boolean;
begin
Result := FExprNode.IterateNodes(AFunc, AData);
end;
procedure TsExpressionParser.SetDialect(const AValue: TsFormulaDialect); procedure TsExpressionParser.SetDialect(const AValue: TsFormulaDialect);
begin begin
if FDialect = AValue then exit; if FDialect = AValue then exit;
@ -2723,6 +2763,12 @@ begin
Result := false; Result := false;
end; end;
function TsExprNode.IterateNodes(AFunc: TsExprNodeFunc; AData: Pointer): Boolean;
begin
Unused(AFunc, AData);
// to be overridden by descendant classes
end;
function TsExprNode.NodeValue: TsExpressionResult; function TsExprNode.NodeValue: TsExpressionResult;
begin begin
GetNodeValue(Result); GetNodeValue(Result);
@ -2773,6 +2819,12 @@ begin
Result := FLeft.Has3DLink or FRight.Has3DLink; Result := FLeft.Has3DLink or FRight.Has3DLink;
end; end;
function TsBinaryOperationExprNode.IterateNodes(AFunc: TsExprNodeFunc;
AData: Pointer): Boolean;
begin
Result := FLeft.IterateNodes(AFunc, AData) or FRight.IterateNodes(AFunc, AData);
end;
function TsBinaryOperationExprNode.HasError(out AResult: TsExpressionResult): Boolean; function TsBinaryOperationExprNode.HasError(out AResult: TsExpressionResult): Boolean;
begin begin
Result := Left.HasError(AResult) or Right.HasError(AResult); Result := Left.HasError(AResult) or Right.HasError(AResult);
@ -3724,6 +3776,16 @@ begin
Result := false; Result := false;
end; end;
function TsFunctionExprNode.IterateNodes(AFunc: TsExprNodeFunc;
AData: Pointer): Boolean;
var
i: Integer;
begin
Result := false;
for i:=0 to High(FArgumentParams) do
Result := Result or FArgumentNodes[i].IterateNodes(AFunc, AData);
end;
{ TsFunctionCallBackExprNode } { TsFunctionCallBackExprNode }
@ -3773,12 +3835,16 @@ begin
FRow := ARow; FRow := ARow;
FCol := ACol; FCol := ACol;
FFlags := AFlags; FFlags := AFlags;
FError := errOK;
FCell := (GetSheet as TsWorksheet).FindCell(FRow, FCol); FCell := (GetSheet as TsWorksheet).FindCell(FRow, FCol);
if Has3DLink then FParser.FContains3DRef := true; if Has3DLink then FParser.FContains3DRef := true;
end; end;
function TsCellExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem; function TsCellExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin begin
if FError <> errOK then
Result := RPNErr(FError, ANext)
else
if FIsRef then if FIsRef then
begin begin
if Has3dLink then if Has3dLink then
@ -3798,6 +3864,11 @@ function TsCellExprNode.AsString: string;
var var
r, c: Cardinal; r, c: Cardinal;
begin begin
if FError <> errOK then begin
Result := GetErrorValueStr(FError);
exit;
end;
r := Getrow; r := Getrow;
c := GetCol; c := GetCol;
if Has3dLink then if Has3dLink then
@ -3843,6 +3914,46 @@ begin
Result := FCol - FParser.FSourceCell^.Col + FParser.FDestCell^.Col; Result := FCol - FParser.FSourceCell^.Col + FParser.FDestCell^.Col;
end; end;
procedure TsCellExprNode.GetNodeValue(out AResult: TsExpressionResult);
var
cell: PCell;
formula: PsFormula;
sheet: TsWorksheet;
begin
if FError <> errOK then begin
AResult.ResultType := rtError;
AResult.ResError := FError;
{
AResult.ResRow := GetRow;
AResult.ResCol := GetCol;
AResult.Worksheet := GetSheet;
}
exit;
end;
if Parser.CopyMode then
cell := (FWorksheet as TsWorksheet).FindCell(GetRow, GetCol)
else
cell := FCell;
if (cell <> nil) and HasFormula(cell) then begin
sheet := TsWorksheet(cell^.Worksheet);
formula := sheet.Formulas.FindFormula(cell^.Row, cell^.Col);
case formula^.CalcState of
csNotCalculated:
sheet.CalcFormula(formula);
csCalculating:
raise ECalcEngine.CreateFmt(rsCircularReference, [GetCellString(cell^.Row, cell^.Col)]);
end;
end;
AResult.ResultType := rtCell;
AResult.ResRow := GetRow;
AResult.ResCol := GetCol;
AResult.Worksheet := GetSheet;
end;
(*
procedure TsCellExprNode.GetNodeValue(out AResult: TsExpressionResult); procedure TsCellExprNode.GetNodeValue(out AResult: TsExpressionResult);
var var
cell: PCell; cell: PCell;
@ -3865,6 +3976,7 @@ begin
AResult.ResCol := GetCol; AResult.ResCol := GetCol;
AResult.Worksheet := GetSheet; AResult.Worksheet := GetSheet;
end; end;
*)
{ See: GetCol } { See: GetCol }
function TsCellExprNode.GetRow: Cardinal; function TsCellExprNode.GetRow: Cardinal;
@ -3878,8 +3990,10 @@ function TsCellExprNode.GetSheet: TsBasicWorksheet;
begin begin
if FSheetName = '' then if FSheetName = '' then
Result := FWorksheet Result := FWorksheet
else else begin
Result := (GetWorkbook as TsWorkbook).GetWorksheetByName(FSheetName); Result := (GetWorkbook as TsWorkbook).GetWorksheetByName(FSheetName);
if Result = nil then FError := errIllegalREF;
end;
end; end;
function TsCellExprNode.GetSheetIndex: Integer; function TsCellExprNode.GetSheetIndex: Integer;
@ -3916,6 +4030,12 @@ begin
Result := rtCell; Result := rtCell;
end; end;
function TsCellExprNode.IterateNodes(AFunc: TsExprNodeFunc;
AData: Pointer): Boolean;
begin
Result := AFunc(self, AData);
end;
{ TsCellRangeExprNode } { TsCellRangeExprNode }
@ -3932,15 +4052,25 @@ begin
FParser := AParser; FParser := AParser;
FWorksheet := AWorksheet; FWorksheet := AWorksheet;
FFlags := []; FFlags := [];
FError := errOK;
book := TsWorkbook(GetWorkbook); book := TsWorkbook(GetWorkbook);
F3dRange := ((ASheet1 <> '') and (ASheet2 <> '') { and (ASheet1 <> ASheet2)}) or F3dRange := ((ASheet1 <> '') and (ASheet2 <> '') { and (ASheet1 <> ASheet2)}) or
((ASheet1 <> '') and (ASheet2 = '')); ((ASheet1 <> '') and (ASheet2 = ''));
FSheetIndex[1] := book.GetWorksheetIndex(ASheet1); FSheetIndex[1] := book.GetWorksheetIndex(ASheet1);
if ASheet2 <> '' then {
FSheetIndex[2] := book.GetWorksheetIndex(ASheet2) if FSheetIndex[1] = -1 then
FError := errIllegalREF
else else
}
if ASheet2 <> '' then begin
FSheetIndex[2] := book.GetWorksheetIndex(ASheet2);
{
if FSheetIndex[2] = -1 then
FError := errIllegalREF;
}
end else
FSheetIndex[2] := FSheetIndex[1]; FSheetIndex[2] := FSheetIndex[1];
EnsureOrder(FSheetIndex[1], FSheetIndex[2]); EnsureOrder(FSheetIndex[1], FSheetIndex[2]);
@ -3982,6 +4112,9 @@ end;
function TsCellRangeExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem; function TsCellRangeExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin begin
if FError <> errOK then
Result := RPNErr(FError, ANext)
else
if F3dRange then if F3dRange then
Result := RPNCellRange3D( Result := RPNCellRange3D(
FSheetIndex[1], GetRow(1), Integer(GetCol(1)), FSheetIndex[1], GetRow(1), Integer(GetCol(1)),
@ -4001,6 +4134,11 @@ var
r1, c1, r2, c2: Cardinal; r1, c1, r2, c2: Cardinal;
s1, s2: String; s1, s2: String;
begin begin
if FError <> errOK then begin
Result := GetErrorValueStr(FError);
exit;
end;
if FSheetIndex[1] = -1 then if FSheetIndex[1] = -1 then
s1 := FWorksheet.Name s1 := FWorksheet.Name
else else
@ -4058,7 +4196,7 @@ begin
Result := FCol[AIndex] - FParser.FSourceCell^.Col + FParser.FDestCell^.Col; Result := FCol[AIndex] - FParser.FSourceCell^.Col + FParser.FDestCell^.Col;
end; end;
procedure TsCellRangeExprNode.GetNodeValue(out Result: TsExpressionResult); procedure TsCellRangeExprNode.GetNodeValue(out AResult: TsExpressionResult);
var var
r, c, s: Array[TsCellRangeIndex] of Integer; r, c, s: Array[TsCellRangeIndex] of Integer;
rr, cc, ss: Integer; rr, cc, ss: Integer;
@ -4066,7 +4204,14 @@ var
cell: PCell; cell: PCell;
book: TsWorkbook; book: TsWorkbook;
sheet: TsWorksheet; sheet: TsWorksheet;
formula: PsFormula;
begin begin
if FError <> errOK then begin
AResult.ResultType := rtError;
AResult.ResError := FError;
exit;
end;
for i in TsCellRangeIndex do for i in TsCellRangeIndex do
begin begin
r[i] := GetRow(i); r[i] := GetRow(i);
@ -4081,29 +4226,35 @@ begin
for ss := s[1] to s[2] do begin for ss := s[1] to s[2] do begin
sheet := (Workbook as TsWorkbook).GetWorksheetByIndex(ss); sheet := (Workbook as TsWorkbook).GetWorksheetByIndex(ss);
for rr := r[1] to r[2] do for formula in sheet.Formulas do
for cc := c[1] to c[2] do if (formula^.Row >= r[1]) and (formula^.Row <= r[2]) and
begin (formula^.Col >= c[1]) and (formula^.Col <= c[2])
cell := sheet.FindCell(rr, cc); then
if HasFormula(cell) then case formula^.CalcState of
case sheet.GetCalcState(cell) of csNotCalculated:
csNotCalculated: sheet.CalcFormula(formula);
sheet.CalcFormula(cell); csCalculating:
csCalculating: raise ECalcEngine.Create(rsCircularReference);
raise ECalcEngine.Create(rsCircularReference); end;
end;
end;
end; end;
Result.ResultType := rtCellRange; AResult.ResultType := rtCellRange;
Result.ResCellRange.Row1 := r[1]; AResult.ResCellRange.Row1 := r[1];
Result.ResCellRange.Col1 := c[1]; AResult.ResCellRange.Col1 := c[1];
Result.ResCellRange.Row2 := r[2]; AResult.ResCellRange.Row2 := r[2];
Result.ResCellRange.Col2 := c[2]; AResult.ResCellRange.Col2 := c[2];
Result.ResCellRange.Sheet1 := s[1]; AResult.ResCellRange.Sheet1 := s[1];
Result.ResCellRange.Sheet2 := s[2]; AResult.ResCellRange.Sheet2 := s[2];
Result.Worksheet := FWorksheet; AResult.Worksheet := FWorksheet;
// Result.Worksheet2 := FWorksheet2; end;
// Be careful when modifying GetRange - it may break everything
function TsCellRangeExprNode.GetRange: TsCellRange;
begin
Result.Row1 := FRow[1];
Result.Col1 := FCol[1];
Result.Row2 := FRow[2];
Result.Col2 := FCol[2];
end; end;
function TsCellRangeExprNode.GetRow(AIndex: TsCellRangeIndex): Cardinal; function TsCellRangeExprNode.GetRow(AIndex: TsCellRangeIndex): Cardinal;
@ -4115,7 +4266,15 @@ end;
function TsCellRangeExprNode.GetWorkbook: TsBasicWorkbook; function TsCellRangeExprNode.GetWorkbook: TsBasicWorkbook;
begin begin
Result := (FWorksheet as TsWorksheet).Workbook; if FWorksheet = nil then
Result := nil
else
Result := (FWorksheet as TsWorksheet).Workbook;
end;
function TsCellRangeExprNode.GetSheetIndex(AIndex: TsCellRangeIndex): Integer;
begin
Result := FSheetIndex[AIndex];
end; end;
function TsCellRangeExprNode.Has3DLink: Boolean; function TsCellRangeExprNode.Has3DLink: Boolean;
@ -4123,11 +4282,25 @@ begin
Result := F3dRange; Result := F3dRange;
end; end;
function TsCellRangeExprNode.IterateNodes(AFunc: TsExprNodeFunc;
AData: Pointer): Boolean;
begin
Result := AFunc(self, AData);
end;
function TsCellRangeExprNode.NodeType: TsResultType; function TsCellRangeExprNode.NodeType: TsResultType;
begin begin
Result := rtCellRange; Result := rtCellRange;
end; end;
procedure TsCellRangeExprNode.SetRange(const ARange: TsCellRange);
begin
FRow[1] := ARange.Row1;
FCol[1] := ARange.Col1;
FRow[2] := ARange.Row2;
FCol[2] := ARange.Col2;
end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
{ Conversion of arguments to simple data types } { Conversion of arguments to simple data types }

96
components/fpspreadsheet/source/common/fpsopendocument.pas
View File

@ -112,7 +112,7 @@ type
function FindNumFormatByName(ANumFmtName: String): Integer; function FindNumFormatByName(ANumFmtName: String): Integer;
function FindRowStyleByName(AStyleName: String): Integer; function FindRowStyleByName(AStyleName: String): Integer;
function FindTableStyleByName(AStyleName: String): Integer; function FindTableStyleByName(AStyleName: String): Integer;
procedure FixFormulas; // procedure FixFormulas;
procedure ReadCell(ANode: TDOMNode; ARow, ACol: Integer; procedure ReadCell(ANode: TDOMNode; ARow, ACol: Integer;
AFormatIndex: Integer; out AColsRepeated: Integer); AFormatIndex: Integer; out AColsRepeated: Integer);
procedure ReadColumns(ATableNode: TDOMNode); procedure ReadColumns(ATableNode: TDOMNode);
@ -134,6 +134,7 @@ type
procedure ReadRowStyle(AStyleNode: TDOMNode); procedure ReadRowStyle(AStyleNode: TDOMNode);
procedure ReadShapes(ATableNode: TDOMNode); procedure ReadShapes(ATableNode: TDOMNode);
procedure ReadSheetProtection(ANode: TDOMNode; ASheet: TsBasicWorksheet); procedure ReadSheetProtection(ANode: TDOMNode; ASheet: TsBasicWorksheet);
procedure ReadSheets(ANode: TDOMNode);
procedure ReadTableStyle(AStyleNode: TDOMNode); procedure ReadTableStyle(AStyleNode: TDOMNode);
protected protected
@ -1435,7 +1436,7 @@ begin
exit; exit;
Result := -1; Result := -1;
end; end;
(*
procedure TsSpreadOpenDocReader.FixFormulas; procedure TsSpreadOpenDocReader.FixFormulas;
procedure FixCell(ACell: PCell); procedure FixCell(ACell: PCell);
@ -1480,7 +1481,7 @@ begin
for cell in sheet.Cells do for cell in sheet.Cells do
if HasFormula(cell) then FixCell(cell); if HasFormula(cell) then FixCell(cell);
end; end;
end; end; *)
procedure TsSpreadOpenDocReader.ReadAutomaticStyles(AStylesNode: TDOMNode); procedure TsSpreadOpenDocReader.ReadAutomaticStyles(AStylesNode: TDOMNode);
var var
@ -2387,7 +2388,8 @@ procedure TsSpreadOpenDocReader.ReadFormula(ARow, ACol: Cardinal;
AStyleIndex: Integer; ACellNode: TDOMNode); AStyleIndex: Integer; ACellNode: TDOMNode);
var var
cell: PCell; cell: PCell;
formula: String; formula: PsFormula;
formulaStr: String;
// stylename: String; // stylename: String;
floatValue: Double; floatValue: Double;
boolValue: Boolean; boolValue: Boolean;
@ -2418,31 +2420,38 @@ begin
} }
fmt := TsWorkbook(Workbook).GetPointerToCellFormat(cell^.FormatIndex); fmt := TsWorkbook(Workbook).GetPointerToCellFormat(cell^.FormatIndex);
formula := ''; formulaStr := '';
if (boReadFormulas in FWorkbook.Options) then if (boReadFormulas in FWorkbook.Options) then
begin begin
// Read formula, trim it, ... // Read formula, trim it, ...
formula := GetAttrValue(ACellNode, 'table:formula'); formulaStr := GetAttrValue(ACellNode, 'table:formula');
if formula <> '' then if formulaStr <> '' then
begin begin
// Formulas written by Spread begin with 'of:=', by Excel with 'msof:='. // Formulas written by Spread begin with 'of:=', by Excel with 'msof:='.
// Remove that. And both use different list separators. // Remove that. And both use different list separators.
p := pos('=', formula); p := pos('=', formulaStr);
ns := Copy(formula, 1, p-2); ns := Copy(formulaStr, 1, p-2);
case ns of case ns of
'of' : FPointSeparatorSettings.ListSeparator := ';'; 'of' : FPointSeparatorSettings.ListSeparator := ';';
'msoxl': FPointSeparatorSettings.ListSeparator := ','; 'msoxl': FPointSeparatorSettings.ListSeparator := ',';
end; end;
Delete(formula, 1, p); Delete(formulaStr, 1, p);
end; end;
// ... and store in cell's FormulaValue field. // ... and store in cell's FormulaValue field.
formula := TsWorksheet(FWorksheet).Formulas.AddFormula(ARow, ACol);
formula^.Parser := TsSpreadsheetParser.Create(FWorksheet);
formula^.Parser.Dialect := fdOpenDocument; // Parse in ODS dialect
formula^.Parser.Expression := formulaStr;
formula^.Parser.Dialect := fdExcelA1; // Convert formula to Excel A1 dialect
formula^.Text := formula^.Parser.Expression;
{
cell^.FormulaValue := formula; cell^.FormulaValue := formula;
// Note: This formula is still in OpenDocument dialect. Conversion to // Note: This formula is still in OpenDocument dialect. Conversion to
// ExcelA1 dialect (used by fps) is postponed until all sheets have beeon // ExcelA1 dialect (used by fps) is postponed until all sheets have beeon
// read (--> FixFormulas) because of possible references to other sheets // read (--> FixFormulas) because of possible references to other sheets
// which might not have been loaded yet at this moment. // which might not have been loaded yet at this moment.
}
{$IFDEF FPSpreadDebug} {$IFDEF FPSpreadDebug}
DebugLn(' Formula found: ' + formula); DebugLn(' Formula found: ' + formula);
{$ENDIF} {$ENDIF}
@ -2587,6 +2596,7 @@ begin
if not Assigned(SpreadSheetNode) then if not Assigned(SpreadSheetNode) then
raise EFPSpreadsheet.Create('[TsSpreadOpenDocReader.ReadFromStream] Node "office:spreadsheet" not found.'); raise EFPSpreadsheet.Create('[TsSpreadOpenDocReader.ReadFromStream] Node "office:spreadsheet" not found.');
ReadSheets(SpreadsheetNode);
ReadDocumentProtection(SpreadsheetNode); ReadDocumentProtection(SpreadsheetNode);
ReadDateMode(SpreadSheetNode); ReadDateMode(SpreadSheetNode);
@ -2613,7 +2623,8 @@ begin
end; end;
sheetName := GetAttrValue(TableNode, 'table:name'); sheetName := GetAttrValue(TableNode, 'table:name');
FWorkSheet := TsWorkbook(FWorkbook).AddWorksheet(sheetName, true); FWorksheet := TsWorkbook(FWorkbook).GetWorksheetByName(sheetName);
// FWorkSheet := TsWorkbook(FWorkbook).AddWorksheet(sheetName, true);
tablestyleName := GetAttrValue(TableNode, 'table:style-name'); tablestyleName := GetAttrValue(TableNode, 'table:style-name');
// Read protection // Read protection
ReadSheetProtection(TableNode, FWorksheet); ReadSheetProtection(TableNode, FWorksheet);
@ -2660,7 +2671,7 @@ begin
end; end;
// Convert formulas from OpenDocument to ExcelA1 dialect // Convert formulas from OpenDocument to ExcelA1 dialect
FixFormulas; // FixFormulas;
// Active sheet // Active sheet
if FActiveSheet <> '' then if FActiveSheet <> '' then
@ -4085,6 +4096,24 @@ begin
(ASheet as TsWorksheet).Protect(false); (ASheet as TsWorksheet).Protect(false);
end; end;
procedure TsSpreadOpenDocReader.ReadSheets(ANode: TDOMNode);
var
nodename: String;
sheetName: String;
begin
ANode := ANode.FirstChild;
while ANode <> nil do begin
nodeName := ANode.NodeName;
if nodeName = 'table:table' then begin
sheetName := GetAttrValue(ANode, 'table:name');
if sheetName <> '' then
// Create worksheet immediately because it may be needed for 3d formulas
(FWorkbook as TsWorkbook).AddWorksheet(sheetname, true);
end;
ANode := ANode.NextSibling;
end;
end;
procedure TsSpreadOpenDocReader.ReadStyles(AStylesNode: TDOMNode); procedure TsSpreadOpenDocReader.ReadStyles(AStylesNode: TDOMNode);
var var
styleNode: TDOMNode; styleNode: TDOMNode;
@ -7564,8 +7593,9 @@ procedure TsSpreadOpenDocWriter.WriteFormula(AStream: TStream; const ARow,
ACol: Cardinal; ACell: PCell); ACol: Cardinal; ACell: PCell);
var var
lStyle: String = ''; lStyle: String = '';
formula: PsFormula;
formulaStr: String;
parser: TsExpressionParser; parser: TsExpressionParser;
formula: String;
valuetype: String; valuetype: String;
value: string; value: string;
valueStr: String; valueStr: String;
@ -7577,6 +7607,7 @@ var
fmt: TsCellFormat; fmt: TsCellFormat;
ignoreFormulas: Boolean; ignoreFormulas: Boolean;
sheet: TsWorksheet; sheet: TsWorksheet;
oldDialect: TsFormulaDialect;
begin begin
Unused(ARow, ACol); Unused(ARow, ACol);
ignoreFormulas := (boIgnoreFormulas in FWorkbook.Options); ignoreFormulas := (boIgnoreFormulas in FWorkbook.Options);
@ -7608,16 +7639,32 @@ begin
FWorkbook.AddErrorMsg(rsODSHyperlinksOfTextCellsOnly, [GetCellString(ARow, ACol)]); FWorkbook.AddErrorMsg(rsODSHyperlinksOfTextCellsOnly, [GetCellString(ARow, ACol)]);
// Formula string // Formula string
formula := sheet.Formulas.FindFormula(ACell);
if ignoreFormulas then begin if ignoreFormulas then begin
formula := ACell^.FormulaValue; formulaStr := formula^.Text;
if (formula <> '') then begin if (formulaStr <> '') then begin
if not ((pos('of:=', formula) = 1) or (pos('=', formula) = 1)) then if not ((pos('of:=', formulaStr) = 1) or (pos('=', formulaStr) = 1)) then
formula := 'of:=' + formula; formulaStr := 'of:=' + formulaStr;
end; end;
end else end else
begin begin
valueStr := ''; valueStr := '';
// Convert string formula to the format needed by ods: semicolon list separators! if formula^.Parser = nil then begin
formula^.Parser := TsSpreadsheetParser.Create(FWorksheet);
formula^.Parser.Expression := formula^.Text;
end;
// Convert string formula to the format needed by ods
oldDialect := formula^.Parser.Dialect;
try
formula^.Parser.Dialect := fdOpenDocument;
formulaStr := formula^.Parser.Expression; // Formula converted to ODS dialect
if (formulaStr <> '') and (formulastr[1] <> '=') then
formulaStr := '=' + formulaStr;
finally
formula^.Parser.Dialect := oldDialect;
end;
{
parser := TsSpreadsheetParser.Create(FWorksheet); parser := TsSpreadsheetParser.Create(FWorksheet);
try try
parser.Expression := ACell^.FormulaValue; // Formula still in Excel dialect parser.Expression := ACell^.FormulaValue; // Formula still in Excel dialect
@ -7628,7 +7675,7 @@ begin
finally finally
parser.Free; parser.Free;
end; end;
}
case ACell^.ContentType of case ACell^.ContentType of
cctNumber: cctNumber:
begin begin
@ -7675,23 +7722,24 @@ begin
end; end;
{ Fix special xml characters } { Fix special xml characters }
formula := UTF8TextToXMLText(formula); formulaStr := UTF8TextToXMLText(formulaStr);
{ We are writing a very rudimentary formula here without result and result { We are writing a very rudimentary formula here without result and result
data type. Seems to work... } data type. Seems to work... }
if not ignoreFormulas or (sheet.GetCalcState(ACell) = csCalculated) then // if not ignoreFormulas or (sheet.GetCalcState(ACell) = csCalculated) then
if not ignoreFormulas or (formula^.CalcState = csCalculated) then // LOOKS STRANGE - IS THIS CORRECT?
AppendToStream(AStream, Format( AppendToStream(AStream, Format(
'<table:table-cell table:formula="%s" office:value-type="%s"%s%s%s>' + '<table:table-cell table:formula="%s" office:value-type="%s"%s%s%s>' +
comment + comment +
valueStr + valueStr +
'</table:table-cell>', [ '</table:table-cell>', [
formula, valuetype, value, lStyle, spannedStr formulaStr, valuetype, value, lStyle, spannedStr
])) ]))
else else
begin begin
AppendToStream(AStream, Format( AppendToStream(AStream, Format(
'<table:table-cell table:formula="%s"%s%s', [ '<table:table-cell table:formula="%s"%s%s', [
formula, lStyle, spannedStr])); formulaStr, lStyle, spannedStr]));
if comment <> '' then if comment <> '' then
AppendToStream(AStream, '>' + comment + '</table:table-cell>') AppendToStream(AStream, '>' + comment + '</table:table-cell>')
else else

1223
components/fpspreadsheet/source/common/fpspreadsheet.pas
View File

File diff suppressed because it is too large Load Diff

9
components/fpspreadsheet/source/common/fpstypes.pas
View File

@ -205,6 +205,9 @@ const
SHEETSEPARATOR = '!'; SHEETSEPARATOR = '!';
type type
TsFormulaFlag = (ffCalculating, ffCalculated);
TsFormulaFlags = set of TsFormulaFlag;
{@@ Elements of an expanded formula. {@@ Elements of an expanded formula.
Note: If ElementKind is fekCellOffset, "Row" and "Col" have to be cast to signed integers! } Note: If ElementKind is fekCellOffset, "Row" and "Col" have to be cast to signed integers! }
TsFormulaElement = record TsFormulaElement = record
@ -589,8 +592,8 @@ type
TsCalcState = (csNotCalculated, csCalculating, csCalculated); TsCalcState = (csNotCalculated, csCalculating, csCalculated);
{@@ Cell flag } {@@ Cell flag }
TsCellFlag = (cfCalculating, cfCalculated, cfHasComment, cfHyperlink, cfMerged, TsCellFlag = ({cfCalculating, cfCalculated, }cfHasComment, cfHyperlink, cfMerged,
cf3dFormula); cfHasFormula, cf3dFormula);
{@@ Set of cell flags } {@@ Set of cell flags }
TsCellFlags = set of TsCellFlag; TsCellFlags = set of TsCellFlag;
@ -744,7 +747,7 @@ type
{ Cell content } { Cell content }
UTF8StringValue: String; // Strings cannot be part of a variant record UTF8StringValue: String; // Strings cannot be part of a variant record
RichTextParams: TsRichTextParams; // Formatting of individual text ranges RichTextParams: TsRichTextParams; // Formatting of individual text ranges
FormulaValue: String; // Formula for calculation of cell content // FormulaValue: String; // Formula for calculation of cell content
case ContentType: TCellContentType of // variant part must be at the end case ContentType: TCellContentType of // variant part must be at the end
cctEmpty : (); // has no data at all cctEmpty : (); // has no data at all
cctFormula : (); // FormulaValue is outside the variant record cctFormula : (); // FormulaValue is outside the variant record

36
components/fpspreadsheet/source/common/fpsutils.pas
View File

@ -202,8 +202,9 @@ procedure InitImageRecord(out AValue: TsImage; ARow, ACol: Cardinal;
AOffsetX, AOffsetY, AScaleX, AScaleY: Double); AOffsetX, AOffsetY, AScaleX, AScaleY: Double);
procedure InitHeaderFooterImageRecord(out AImage: TsHeaderFooterImage); procedure InitHeaderFooterImageRecord(out AImage: TsHeaderFooterImage);
procedure CopyCellValue(AFromCell, AToCell: PCell); //procedure CopyCellValue(AFromCell, AToCell: PCell);
function HasFormula(ACell: PCell): Boolean; function HasFormula(ACell: PCell): Boolean;
function Has3dFormula(ACell: PCell): Boolean;
function SameCellBorders(AFormat1, AFormat2: PsCellFormat): Boolean; function SameCellBorders(AFormat1, AFormat2: PsCellFormat): Boolean;
function SameFont(AFont1, AFont2: TsFont): Boolean; overload; function SameFont(AFont1, AFont2: TsFont): Boolean; overload;
function SameFont(AFont: TsFont; AFontName: String; AFontSize: Single; function SameFont(AFont: TsFont; AFontName: String; AFontSize: Single;
@ -2334,7 +2335,6 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure InitCell(out ACell: TCell); procedure InitCell(out ACell: TCell);
begin begin
ACell.FormulaValue := '';
ACell.UTF8StringValue := ''; ACell.UTF8StringValue := '';
FillChar(ACell, SizeOf(ACell), 0); FillChar(ACell, SizeOf(ACell), 0);
end; end;
@ -2418,7 +2418,7 @@ begin
Index := -1; Index := -1;
end; end;
end; end;
(*
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Copies the value of a cell to another one. Does not copy the formula, erases Copies the value of a cell to another one. Does not copy the formula, erases
the formula of the destination cell if there is one! the formula of the destination cell if there is one!
@ -2428,18 +2428,20 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure CopyCellValue(AFromCell, AToCell: PCell); procedure CopyCellValue(AFromCell, AToCell: PCell);
begin begin
Assert(AFromCell <> nil);
Assert(AToCell <> nil); Assert(AToCell <> nil);
AToCell^.ContentType := AFromCell^.ContentType; if AFromCell <> nil then begin
AToCell^.NumberValue := AFromCell^.NumberValue; AToCell^.ContentType := AFromCell^.ContentType;
AToCell^.DateTimeValue := AFromCell^.DateTimeValue; AToCell^.NumberValue := AFromCell^.NumberValue;
AToCell^.BoolValue := AFromCell^.BoolValue; AToCell^.DateTimeValue := AFromCell^.DateTimeValue;
AToCell^.ErrorValue := AFromCell^.ErrorValue; AToCell^.BoolValue := AFromCell^.BoolValue;
AToCell^.UTF8StringValue := AFromCell^.UTF8StringValue; AToCell^.ErrorValue := AFromCell^.ErrorValue;
AToCell^.FormulaValue := ''; // This is confirmed with Excel AToCell^.UTF8StringValue := AFromCell^.UTF8StringValue;
// Note: As confirmed with Excel, the formula is not to be copied here.
// Note: The calling routine must erase the formula if the destination cell has one.
end;
end; end;
*)
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Returns TRUE if the cell contains a formula. Returns TRUE if the cell contains a formula.
@ -2447,7 +2449,15 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function HasFormula(ACell: PCell): Boolean; function HasFormula(ACell: PCell): Boolean;
begin begin
Result := Assigned(ACell) and (Length(ACell^.FormulaValue) > 0); Result := Assigned(ACell) and (cfHasFormula in ACell^.Flags);
end;
{@@ ----------------------------------------------------------------------------
Returns TRUE if the cell has a 3D formula (i.e. reference to another sheet)
-------------------------------------------------------------------------------}
function Has3dFormula(ACell: PCell): Boolean;
begin
Result := HasFormula(ACell) and (cf3dFormula in ACell^.Flags);
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------

33
components/fpspreadsheet/source/common/xlsbiff8.pas
View File

@ -2554,6 +2554,29 @@ begin
AStream.WriteWord(0); AStream.WriteWord(0);
end; end;
function DoCollectSheetsWith3dRefs(ANode: TsExprNode; AData: Pointer): Boolean;
var
sheetlist: TsBIFF8ExternSheetList;
sheetIdx, sheetIdx1, sheetIdx2: Integer;
workbook: TsWorkbook;
begin
sheetlist := TsBIFF8ExternSheetList(AData);
if (ANode is TsCellExprNode) and TsCellExprNode(ANode).Has3DLink then
begin
sheetIdx := TsCellExprNode(ANode).GetSheetIndex;
sheetList.AddSheets('', nil, sheetIdx, sheetIdx);
end else
if (ANode is TsCellRangeExprNode) and TsCellRangeExprNode(ANode).Has3DLink then
begin
workbook := TsCellRangeExprNode(ANode).Workbook as TsWorkbook;
sheetIdx1 := TsCellRangeExprNode(ANode).GetSheetIndex(1);
sheetIdx2 := TsCellRangeExprNode(ANode).GetSheetIndex(2);
for sheetIdx := sheetIdx1 to sheetIdx2 do
sheetList.AddSheets('', nil, sheetIdx1, sheetIdx2);
end;
Result := false;
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Collects the data for out-of-sheet links found in the specified worksheet Collects the data for out-of-sheet links found in the specified worksheet
(or all worksheets if the parameter is omitted). (or all worksheets if the parameter is omitted).
@ -2561,6 +2584,14 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.CollectExternData; procedure TsSpreadBIFF8Writer.CollectExternData;
procedure DoCollectForSheet(ASheet: TsWorksheet);
var
formula: PsFormula;
begin
for formula in ASheet.Formulas do
formula^.Parser.IterateNodes(@DoCollectSheetsWith3dRefs, FBiff8ExternSheets);
end;
{
procedure DoCollectForSheet(ASheet: TsWorksheet); procedure DoCollectForSheet(ASheet: TsWorksheet);
var var
cell: PCell; cell: PCell;
@ -2593,7 +2624,7 @@ procedure TsSpreadBIFF8Writer.CollectExternData;
end; end;
end; end;
end; end;
}
var var
book: TsWorkbook; book: TsWorkbook;
sheet: TsWorksheet; sheet: TsWorksheet;

55
components/fpspreadsheet/source/common/xlscommon.pas
View File

@ -2872,13 +2872,35 @@ var
n: Word; n: Word;
rpnFormula: TsRPNformula; rpnFormula: TsRPNformula;
strFormula: String; strFormula: String;
formula: PsFormula;
begin begin
n := ReadRPNTokenArraySize(AStream); n := ReadRPNTokenArraySize(AStream);
if n = 0 then
exit(false);
Result := ReadRPNTokenArray(AStream, n, rpnFormula, ACell, ASharedFormulaBase); Result := ReadRPNTokenArray(AStream, n, rpnFormula, ACell, ASharedFormulaBase);
if Result then begin if Result then begin
formula := TsWorksheet(FWorksheet).Formulas.FindFormula(ACell);
if formula = nil then begin
formula := TsWorksheet(FWorksheet).Formulas.AddFormula(ACell^.Row, ACell^.Col);
formula^.Parser := TsSpreadsheetParser.Create(FWorksheet);
end;
formula^.Parser.RPNFormula := rpnFormula;
formula^.Text := formula^.Parser.Expression;
if formula^.Parser.Has3dLinks then
ACell^.Flags := ACell^.Flags + [cfHasFormula, cf3dFormula]
else
ACell^.Flags := ACell^.Flags + [cfHasFormula];
{
strFormula := tsWorksheet(FWorksheet).ConvertRPNFormulaToStringFormula(rpnFormula); strFormula := tsWorksheet(FWorksheet).ConvertRPNFormulaToStringFormula(rpnFormula);
if strFormula <> '' then if strFormula <> '' then begin
ACell^.FormulaValue := strFormula; formula := TsWorksheet(FWorksheet).Formulas.AddFormula(ACell^.Row, ACell^.Col, strFormula);
if formula^.Parsed.Has3dLinks then
ACell^.Flags := ACell^.Flags + [cfHasFormula, cf3dFormula]
else
ACell^.Flags := ACell^.Flags + [cfHasFormula];
end;
}
end; end;
end; end;
@ -3441,6 +3463,27 @@ begin
end; end;
end; end;
function DoCollectSheetsWith3dRefs(ANode: TsExprNode; AData: Pointer): Boolean;
var
sheetlist: TsBIFFExternSheetList;
sheetIdx, sheetIdx1, sheetIdx2: Integer;
workbook: TsWorkbook;
begin
sheetlist := TsBIFFExternSheetList(AData);
if (ANode is TsCellExprNode) and TsCellExprNode(ANode).Has3DLink then
sheetList.AddSheet(TsCellExprNode(ANode).GetSheetName, ebkInternal)
else
if (ANode is TsCellRangeExprNode) and TsCellRangeExprNode(ANode).Has3DLink then
begin
workbook := TsCellRangeExprNode(ANode).Workbook as TsWorkbook;
sheetIdx1 := TsCellRangeExprNode(ANode).GetSheetIndex(1);
sheetIdx2 := TsCellRangeExprNode(ANode).GetSheetIndex(2);
for sheetIdx := sheetIdx1 to sheetIdx2 do
sheetList.AddSheet(workbook.GetWorksheetByIndex(sheetIdx).Name, ebkInternal);
end;
Result := false; // No need to rebuild the text formula
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Collects the data for out-of-sheet links found in the specified worksheet Collects the data for out-of-sheet links found in the specified worksheet
(or all worksheets if the parameter is omitted). (or all worksheets if the parameter is omitted).
@ -3450,6 +3493,13 @@ end;
function TsSpreadBIFFWriter.CollectExternData(AWorksheet: TsBasicWorksheet = nil): Integer; function TsSpreadBIFFWriter.CollectExternData(AWorksheet: TsBasicWorksheet = nil): Integer;
procedure DoCollectForSheet(ASheet: TsWorksheet; ASheetList: TsBIFFExternSheetList); procedure DoCollectForSheet(ASheet: TsWorksheet; ASheetList: TsBIFFExternSheetList);
var
formula: PsFormula;
begin
for formula in ASheet.Formulas do
formula^.Parser.IterateNodes(@DoCollectSheetsWith3dRefs, ASheetList);
end;
{
var var
cell: PCell; cell: PCell;
workbook: TsWorkbook; workbook: TsWorkbook;
@ -3496,6 +3546,7 @@ function TsSpreadBIFFWriter.CollectExternData(AWorksheet: TsBasicWorksheet = nil
end; end;
end; end;
end; end;
}
var var
sheet: TsWorksheet; sheet: TsWorksheet;

36
components/fpspreadsheet/source/common/xlsxooxml.pas
View File

@ -641,6 +641,7 @@ var
datanode, tnode: TDOMNode; datanode, tnode: TDOMNode;
dataStr: String; dataStr: String;
formulaStr: String; formulaStr: String;
formula: PsFormula;
nodeName: String; nodeName: String;
sstIndex: Integer; sstIndex: Integer;
number: Double; number: Double;
@ -731,8 +732,11 @@ begin
sharedformulabase := TSharedFormulaData(FSharedFormulaBaseList[StrToInt(s)]); sharedformulabase := TSharedFormulaData(FSharedFormulaBaseList[StrToInt(s)]);
// ... and copy shared formula to destination cell // ... and copy shared formula to destination cell
InitCell(FWorksheet, sharedformulabase.Row, sharedformulabase.Col, lCell); InitCell(FWorksheet, sharedformulabase.Row, sharedformulabase.Col, lCell);
lCell.Formulavalue := sharedformulabase.Formula; formula := sharedFormulaBase.Worksheet.Formulas.AddFormula(
lCell.Worksheet := sharedformulabase.Worksheet; sharedFormulabase.Row, sharedFormulaBase.Col, sharedformulabase.Formula
);
// lCell.Formulavalue := sharedformulabase.Formula;
// lCell.Worksheet := sharedformulabase.Worksheet;
sheet.CopyFormula(@lCell, cell); sheet.CopyFormula(@lCell, cell);
cell^.ContentType := cctFormula; cell^.ContentType := cctFormula;
end; end;
@ -740,8 +744,8 @@ begin
end end
else else
// "Normal" formula // "Normal" formula
cell^.FormulaValue := formulaStr; sheet.WriteFormula(cell, formulaStr);
// AWorksheet.WriteFormula(cell, formulaStr); // cell^.FormulaValue := formulaStr;
except except
on E:EExprParser do begin on E:EExprParser do begin
FWorkbook.AddErrorMsg(E.Message); FWorkbook.AddErrorMsg(E.Message);
@ -759,11 +763,8 @@ begin
// get data type // get data type
s := GetAttrValue(ANode, 't'); // "t" = data type s := GetAttrValue(ANode, 't'); // "t" = data type
if (s = '') and (dataStr = '') then if (s = '') and (dataStr = '') then
begin sheet.WriteBlank(cell, true) // true --> do not erase the formula!!!
formulaStr := cell^.FormulaValue; else
sheet.WriteBlank(cell); // this erases the formula!!!
cell^.FormulaValue := formulaStr;
end else
if (s = '') or (s = 'n') then begin if (s = '') or (s = 'n') then begin
// Number or date/time, depending on format // Number or date/time, depending on format
number := StrToFloat(dataStr, FPointSeparatorSettings); number := StrToFloat(dataStr, FPointSeparatorSettings);
@ -795,9 +796,9 @@ begin
end else end else
if (s = 'str') or (s = 'inlineStr') then begin if (s = 'str') or (s = 'inlineStr') then begin
// literal string // literal string
formulaStr := cell^.FormulaValue; // formulaStr := cell^.FormulaValue;
sheet.WriteText(cell, datastr); sheet.WriteText(cell, datastr);
cell^.FormulaValue := formulaStr; // cell^.FormulaValue := formulaStr;
end else end else
if s = 'b' then if s = 'b' then
// boolean // boolean
@ -2068,6 +2069,8 @@ begin
sheetData.ID := GetAttrvalue(node, 'sheetID'); sheetData.ID := GetAttrvalue(node, 'sheetID');
sheetData.Hidden := GetAttrValue(node, 'state') = 'hidden'; sheetData.Hidden := GetAttrValue(node, 'state') = 'hidden';
FSheetList.Add(sheetData); FSheetList.Add(sheetData);
// Create worksheet - needed because of 3d references
(FWorkbook as TsWorkbook).AddWorksheet(sheetData.Name, true);
end; end;
node := node.NextSibling; node := node.NextSibling;
end; end;
@ -2520,8 +2523,12 @@ begin
// read worksheets // read worksheets
for i:=0 to FSheetList.Count-1 do begin for i:=0 to FSheetList.Count-1 do begin
{
// Create worksheet // Create worksheet
FWorksheet := (FWorkbook as TsWorkbook).AddWorksheet(TSheetData(FSheetList[i]).Name, true); FWorksheet := (FWorkbook as TsWorkbook).AddWorksheet(TSheetData(FSheetList[i]).Name, true);
}
// Worksheets are already created...
FWorksheet := (FWorkbook as TsWorkbook).GetWorksheetByName(TSheetData(FSheetList[i]).Name);
if TSheetData(FSheetList[i]).Hidden then if TSheetData(FSheetList[i]).Hidden then
FWorksheet.Options := FWorksheet.Options + [soHidden]; FWorksheet.Options := FWorksheet.Options + [soHidden];
@ -5219,10 +5226,15 @@ var
cellPosText: String; cellPosText: String;
lStyleIndex: Integer; lStyleIndex: Integer;
t, v: String; t, v: String;
formula: PsFormula;
formulaStr: String;
begin begin
cellPosText := TsWorksheet.CellPosToText(ARow, ACol); cellPosText := TsWorksheet.CellPosToText(ARow, ACol);
lStyleIndex := GetStyleIndex(ACell); lStyleIndex := GetStyleIndex(ACell);
formula := TsWorksheet(FWorksheet).Formulas.FindFormula(ARow, ACol);
formulaStr := PrepareFormula(formula^.Text);
case ACell^.ContentType of case ACell^.ContentType of
cctFormula: cctFormula:
begin begin
@ -5265,7 +5277,7 @@ begin
'%s' + '%s' +
'</c>', [ '</c>', [
CellPosText, lStyleIndex, t, CellPosText, lStyleIndex, t,
PrepareFormula(ACell^.FormulaValue), formulaStr,
v v
])); ]));
end; end;

7
components/fpspreadsheet/source/visual/fpspreadsheetctrls.pas
View File

@ -162,12 +162,12 @@ type
published published
{@@ Automatically detects the fileformat when loading the spreadsheet file {@@ Automatically detects the fileformat when loading the spreadsheet file
specified by FileName } specified by FileName }
property AutoDetectFormat: Boolean read FAutoDetectFormat write FAutoDetectFormat; property AutoDetectFormat: Boolean read FAutoDetectFormat write FAutoDetectFormat default true;
{@@ File format of the next spreadsheet file to be loaded by means of the {@@ File format of the next spreadsheet file to be loaded by means of the
Filename property. Not used when AutoDetectFormat is TRUE. Filename property. Not used when AutoDetectFormat is TRUE.
Note that if FileFormat is sfUser then the format ID must be specified at Note that if FileFormat is sfUser then the format ID must be specified at
runtime. } runtime. }
property FileFormat: TsSpreadsheetFormat read GetFileFormat write SetFileFormat; property FileFormat: TsSpreadsheetFormat read GetFileFormat write SetFileFormat default sfOOXML;
{@@ Name of the loaded spreadsheet file which is loaded by assigning a file name {@@ Name of the loaded spreadsheet file which is loaded by assigning a file name
to this property. Format detection is determined by the properties to this property. Format detection is determined by the properties
AutoDetectFormat and FileFormat. Using this property loads the file at AutoDetectFormat and FileFormat. Using this property loads the file at
@ -752,7 +752,8 @@ constructor TsWorkbookSource.Create(AOwner: TComponent);
begin begin
inherited Create(AOwner); inherited Create(AOwner);
FListeners := TFPList.Create; FListeners := TFPList.Create;
FFileFormatID := ord(sfExcel8); FFileFormatID := ord(sfOOXML);
FAutoDetectFormat := True;
CreateNewWorkbook; CreateNewWorkbook;
end; end;

3
components/fpspreadsheet/source/visual/fpspreadsheetgrid.pas
View File

@ -6587,7 +6587,8 @@ begin
// If the cell already exists and contains a formula then the formula must be // If the cell already exists and contains a formula then the formula must be
// removed. The formula would dominate over the data value. // removed. The formula would dominate over the data value.
cell := Worksheet.FindCell(r, c); cell := Worksheet.FindCell(r, c);
if HasFormula(cell) then cell^.FormulaValue := ''; if HasFormula(cell) then
Worksheet.UseformulaInCell(cell, nil); //cell^.FormulaValue := '';
if VarIsNull(AValue) then if VarIsNull(AValue) then
Worksheet.WriteBlank(r, c) Worksheet.WriteBlank(r, c)

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

@ -161,13 +161,14 @@ var
i, row, col: Integer; i, row, col: Integer;
cell: PCell; cell: PCell;
expectedFormula: String; expectedFormula: String;
expectedStr, actualStr: String;
begin begin
TempFile := GetTempFileName; TempFile := GetTempFileName;
MyWorkbook := TsWorkbook.Create; MyWorkbook := TsWorkbook.Create;
try try
// MyWorkbook.Options := MyWorkbook.Options + [boCalcBeforeSaving]; //boAutoCalc]; MyWorkbook.Options := MyWorkbook.Options + [boCalcBeforeSaving]; //boAutoCalc];
MyWorkSheet:= MyWorkBook.AddWorksheet(CopyTestSheet); MyWorkSheet:= MyWorkBook.AddWorksheet(CopyTestSheet);
@ -212,6 +213,7 @@ begin
begin begin
cell := Myworksheet.FindCell(row, 0); cell := Myworksheet.FindCell(row, 0);
case ATestKind of case ATestKind of
// 0: ; // don't copy, just write the original file for debugging
1: MyWorksheet.CopyValue(cell, row, 2); 1: MyWorksheet.CopyValue(cell, row, 2);
2: MyWorksheet.CopyValue(cell, row, 1); 2: MyWorksheet.CopyValue(cell, row, 1);
3: MyWorksheet.CopyFormat(cell, row, 2); 3: MyWorksheet.CopyFormat(cell, row, 2);
@ -233,6 +235,7 @@ begin
// Read spreadsheet file... // Read spreadsheet file...
MyWorkbook.ReadFromFile(TempFile, AFormat); MyWorkbook.ReadFromFile(TempFile, AFormat);
MyWorksheet := MyWorkbook.GetFirstWorksheet; MyWorksheet := MyWorkbook.GetFirstWorksheet;
MyWorksheet.CalcFormulas;
if odd(ATestKind) then col := 2 else col := 1; if odd(ATestKind) then col := 2 else col := 1;
@ -335,9 +338,12 @@ begin
) )
else else
begin begin
expectedStr := SetToString(PTypeInfo(TypeInfo(TsUsedFormattingFields)),
integer(Sourcecells[i+col-2].UsedformattingFields), true);
actualStr := SetToString(PTypeInfo(TypeInfo(TsUsedFormattingFields)),
integer(MyWorksheet.ReadUsedFormatting(cell)), true);
CheckEquals( CheckEquals(
true, expectedStr, actualStr,
SourceCells[i+(col-2)].UsedFormattingFields = MyWorksheet.ReadUsedFormatting(cell),
'Used formatting fields mismatch, cell ' + CellNotation(myWorksheet, row, col) 'Used formatting fields mismatch, cell ' + CellNotation(myWorksheet, row, col)
); );
if (uffBackground in SourceCells[i+(col-2)].UsedFormattingFields) then if (uffBackground in SourceCells[i+(col-2)].UsedFormattingFields) then
@ -390,7 +396,8 @@ begin
else else
CheckEquals( CheckEquals(
SourceCells[i+col-2].FormulaValue, SourceCells[i+col-2].FormulaValue,
cell^.Formulavalue, MyWorksheet.ReadFormula(cell),
// cell^.Formulavalue,
'Formula mismatch, cell ' + CellNotation(MyWorksheet, row, col) 'Formula mismatch, cell ' + CellNotation(MyWorksheet, row, col)
); );
5: 5:
@ -403,7 +410,8 @@ begin
end; end;
CheckEquals( CheckEquals(
expectedFormula, expectedFormula,
cell^.FormulaValue, MyWorksheet.ReadFormula(cell),
// cell^.FormulaValue,
'Formula mismatch, cell ' + Cellnotation(Myworksheet, row, col) 'Formula mismatch, cell ' + Cellnotation(Myworksheet, row, col)
); );
end; end;
@ -421,7 +429,8 @@ begin
end; end;
CheckEquals( CheckEquals(
expectedFormula, expectedFormula,
cell^.FormulaValue, MyWorksheet.ReadFormula(cell),
// cell^.FormulaValue,
'Formula mismatch, cell ' + Cellnotation(Myworksheet, row, col) 'Formula mismatch, cell ' + Cellnotation(Myworksheet, row, col)
); );
end; end;

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

@ -763,7 +763,7 @@ begin
cctEmpty : actual := EmptyResult; cctEmpty : actual := EmptyResult;
else fail('ContentType not supported'); else fail('ContentType not supported');
end; end;
actualformula := cell^.FormulaValue; actualformula := sheet1.Formulas.FindFormula(cell)^.Text; //cell^.FormulaValue;
expected := SollValues[row]; expected := SollValues[row];
// Cell does not store integers! // Cell does not store integers!

7
components/fpspreadsheet/tests/insertdeletetests.pas
View File

@ -565,10 +565,10 @@ begin
'67890123'; '67890123';
DeleteCol := 2; DeleteCol := 2;
Formula := 'C3'; Formula := 'C3';
SollFormula := '#REF!'; // col index unchanged due to deletion after cell SollFormula := '#REF!'; // cell needec by formula does not exist any more
SollLayout := '1245678|'+ SollLayout := '1245678|'+
'2356789|'+ '2356789|'+
'346E890|'+ // "E" = error '346E890|'+ // "E" = error
'4578901|'+ '4578901|'+
'5689012|'+ '5689012|'+
'6790123'; '6790123';
@ -617,7 +617,7 @@ begin
Layout := '12345678|'+ Layout := '12345678|'+
'23456789|'+ '23456789|'+
'3456F890|'+ // "F" = Formula in row 2, col 4 '3456F890|'+ // "F" = Formula in row 2, col 4
'45678901|'+ '45678901|'+ // delete this row
'56789012|'+ '56789012|'+
'67890123'; '67890123';
DeleteRow := 3; DeleteRow := 3;
@ -1010,6 +1010,7 @@ begin
if InsDelTestData[ATestIndex].DeleteRow >= 0 then if InsDelTestData[ATestIndex].DeleteRow >= 0 then
MyWorksheet.DeleteRow(InsDelTestData[ATestIndex].DeleteRow); MyWorksheet.DeleteRow(InsDelTestData[ATestIndex].DeleteRow);
MyWorkbook.CalcFormulas;
MyWorkBook.WriteToFile(TempFile, AFormat, true); MyWorkBook.WriteToFile(TempFile, AFormat, true);
finally finally
MyWorkbook.Free; MyWorkbook.Free;

20
components/fpspreadsheet/tests/singleformulatests.pas
View File

@ -140,8 +140,8 @@ begin
cell := worksheet.WriteFormula(TESTCELL_ROW, TESTCELL_COL, AFormula); cell := worksheet.WriteFormula(TESTCELL_ROW, TESTCELL_COL, AFormula);
// Read formula before saving // Read formula before saving
actualFormula := cell^.Formulavalue; actualFormula := worksheet.ReadFormula(cell);
CheckEquals(AFormula, actualFormula, 'Unsaved formula text mismatch'); CheckEquals(AExpectedFormula, actualFormula, 'Unsaved formula text mismatch');
// Read calculated value before saving // Read calculated value before saving
actualvalue := worksheet.ReadAsNumber(TESTCELL_ROW, TESTCELL_COL); actualvalue := worksheet.ReadAsNumber(TESTCELL_ROW, TESTCELL_COL);
@ -165,7 +165,8 @@ begin
CheckEquals(AExpected, actualValue, 'Saved calculated value mismatch'); CheckEquals(AExpected, actualValue, 'Saved calculated value mismatch');
cell := worksheet.FindCell(TESTCELL_ROW, TESTCELL_COL); cell := worksheet.FindCell(TESTCELL_ROW, TESTCELL_COL);
actualformula := cell^.FormulaValue; actualformula := worksheet.Formulas.FindFormula(cell)^.Text;
// actualformula := cell^.FormulaValue;
// When writing ranges are reconstructed in correct order. // When writing ranges are reconstructed in correct order.
CheckEquals(AExpectedFormula, actualformula, 'Saved formula text mismatch.'); CheckEquals(AExpectedFormula, actualformula, 'Saved formula text mismatch.');
finally finally
@ -302,15 +303,16 @@ end;
{ --- } { --- }
{ Range formulas in which the parts are not ordered. They will be put into the
correct order when then formula is written to the worksheet. --> the
expected range must be in correct order. }
procedure TSpreadSingleFormulaTests.SumMultiSheetRange_FlippedSheetsAndCells_OOXML; procedure TSpreadSingleFormulaTests.SumMultiSheetRange_FlippedSheetsAndCells_OOXML;
begin begin
// In OOXML the range is written literally. TestFloatFormula('SUM(Sheet3:Sheet2!C5:C3)', 55.0, ftkCellRangeSheetRange, sfOOXML, 'SUM(Sheet2:Sheet3!C3:C5)');
TestFloatFormula('SUM(Sheet3:Sheet2!C5:C3)', 55.0, ftkCellRangeSheetRange, sfOOXML);
end; end;
procedure TSpreadSingleFormulaTests.SumMultiSheetRange_FlippedSheetsAndCells_ODS; procedure TSpreadSingleFormulaTests.SumMultiSheetRange_FlippedSheetsAndCells_ODS;
begin begin
// ODS requires conversion of the formula which results in reordering of ranges.
TestFloatFormula('SUM(Sheet3:Sheet2!C5:C3)', 55.0, ftkCellRangeSheetRange, sfOpenDocument, 'SUM(Sheet2:Sheet3!C3:C5)'); TestFloatFormula('SUM(Sheet3:Sheet2!C5:C3)', 55.0, ftkCellRangeSheetRange, sfOpenDocument, 'SUM(Sheet2:Sheet3!C3:C5)');
end; end;
@ -322,14 +324,12 @@ end;
procedure TSpreadSingleFormulaTests.SumMultiSheetRange_FlippedCells_OOXML; procedure TSpreadSingleFormulaTests.SumMultiSheetRange_FlippedCells_OOXML;
begin begin
// In OOXML the range is written literally. TestFloatFormula('SUM(Sheet2:Sheet3!C5:C3)', 55.0, ftkCellRangeSheetRange, sfOOXML, 'SUM(Sheet2:Sheet3!C3:C5)');
TestFloatFormula('SUM(Sheet2:Sheet3!C5:C3)', 55.0, ftkCellRangeSheetRange, sfOOXML);
end; end;
procedure TSpreadSingleFormulaTests.SumMultiSheetRange_FlippedSheets_OOXML; procedure TSpreadSingleFormulaTests.SumMultiSheetRange_FlippedSheets_OOXML;
begin begin
// In OOXML the range is written literally. TestFloatFormula('SUM(Sheet3:Sheet2!C3:C5)', 55.0, ftkCellRangeSheetRange, sfOOXML, 'SUM(Sheet2:Sheet3!C3:C5)');
TestFloatFormula('SUM(Sheet3:Sheet2!C3:C5)', 55.0, ftkCellRangeSheetRange, sfOOXML);
end; end;

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

@ -1026,7 +1026,10 @@
else else
Myworksheet.WriteFormula(Row, 1, formula); Myworksheet.WriteFormula(Row, 1, formula);
SetLength(sollValues, Row+1); SetLength(sollValues, Row+1);
sollValues[Row] := FloatResult(arccosh(number)); if AFormat = sfExcel2 then
sollValues[Row] := ErrorResult(errFormulaNotSupported)
else
sollValues[Row] := FloatResult(arccosh(number));
MyWorksheet.WriteNumber(Row, 2, sollValues[Row].ResFloat); MyWorksheet.WriteNumber(Row, 2, sollValues[Row].ResFloat);
// ACOSH - error result (arccos is not defined below 1 // ACOSH - error result (arccos is not defined below 1
@ -1043,6 +1046,9 @@
SetLength(sollValues, Row+1); SetLength(sollValues, Row+1);
if AFormat = sfOpenDocument then if AFormat = sfOpenDocument then
sollValues[Row] := FloatResult(0) sollValues[Row] := FloatResult(0)
else
if AFormat = sfExcel2 then
sollValues[Row] := ErrorResult(errFormulaNotSupported)
else else
sollValues[Row] := ErrorResult(errOverFlow); sollValues[Row] := ErrorResult(errOverFlow);
@ -1090,7 +1096,10 @@
else else
MyWorksheet.WriteFormula(Row, 1, formula); MyWorksheet.WriteFormula(Row, 1, formula);
SetLength(sollValues, Row+1); SetLength(sollValues, Row+1);
sollValues[Row] := FloatResult(arcsinh(number)); if AFormat = sfExcel2 then
sollValues[Row] := ErrorResult(errFormulaNotSupported)
else
sollValues[Row] := FloatResult(arcsinh(number));
MyWorksheet.WriteNumber(Row, 2, sollValues[Row].ResFloat); MyWorksheet.WriteNumber(Row, 2, sollValues[Row].ResFloat);
// ATAN // ATAN
@ -1120,7 +1129,10 @@
else else
MyWorksheet.WriteFormula(Row, 1, formula); MyWorksheet.WriteFormula(Row, 1, formula);
SetLength(sollValues, Row+1); SetLength(sollValues, Row+1);
sollValues[Row] := FloatResult(arctanh(number)); if AFormat = sfExcel2 then
sollValues[Row] := ErrorResult(errFormulaNotSupported)
else
sollValues[Row] := FloatResult(arctanh(number));
MyWorksheet.WriteNumber(Row, 2, sollValues[Row].ResFloat); MyWorksheet.WriteNumber(Row, 2, sollValues[Row].ResFloat);
// ATANH - error result (arctan is only defined within ]-1,1[ // ATANH - error result (arctan is only defined within ]-1,1[
@ -1137,6 +1149,9 @@
SetLength(sollValues, Row+1); SetLength(sollValues, Row+1);
if AFormat = sfOpenDocument then if AFormat = sfOpenDocument then
sollValues[Row] := FloatResult(0) sollValues[Row] := FloatResult(0)
else
if AFormat = sfExcel2 then
sollValues[Row] := ErrorResult(errFormulaNotSupported)
else else
sollValues[Row] := ErrorResult(errOverFlow); sollValues[Row] := ErrorResult(errOverFlow);
@ -1185,8 +1200,12 @@
else else
MyWorksheet.WriteFormula(Row, 1, formula); MyWorksheet.WriteFormula(Row, 1, formula);
SetLength(sollValues, Row+1); SetLength(sollValues, Row+1);
sollValues[Row] := FloatResult(cosh(number)); if AFormat = sfExcel2 then
MyWorksheet.WriteNumber(Row, 2, sollValues[Row].ResFloat); sollValues[Row] := ErrorResult(errFormulaNotSupported)
else begin
sollValues[Row] := FloatResult(cosh(number));
MyWorksheet.WriteNumber(Row, 2, sollValues[Row].ResFloat);
end;
// DEGREES // DEGREES
if AFormat <> sfExcel2 then if AFormat <> sfExcel2 then
@ -1678,7 +1697,10 @@
MyWorksheet.WriteFormula(Row, 1, formula); MyWorksheet.WriteFormula(Row, 1, formula);
MyWorksheet.WriteNumber(Row, 2, sinh(number)); MyWorksheet.WriteNumber(Row, 2, sinh(number));
SetLength(sollValues, Row+1); SetLength(sollValues, Row+1);
sollValues[Row] := FloatResult(sinh(number)); if AFormat = sfExcel2 then
sollValues[Row] := ErrorResult(errFormulaNotSupported)
else
sollValues[Row] := FloatResult(sinh(number));
// SINH of cell value // SINH of cell value
inc(Row); inc(Row);
@ -1692,7 +1714,10 @@
MyWorksheet.WriteFormula(Row, 1, formula); MyWorksheet.WriteFormula(Row, 1, formula);
MyWorksheet.WriteNumber(Row, 2, sinh(cellB1)); MyWorksheet.WriteNumber(Row, 2, sinh(cellB1));
SetLength(sollValues, Row+1); SetLength(sollValues, Row+1);
sollValues[Row] := FloatResult(sinh(cellB1)); if AFormat = sfExcel2 then
sollValues[Row] := ErrorResult(errFormulaNotSupported)
else
sollValues[Row] := FloatResult(sinh(cellB1));
// SQRT - valid result // SQRT - valid result
inc(Row); inc(Row);
@ -1785,7 +1810,10 @@
MyWorksheet.WriteFormula(Row, 1, formula); MyWorksheet.WriteFormula(Row, 1, formula);
MyWorksheet.WriteNumber(Row, 2, tanh(number)); MyWorksheet.WriteNumber(Row, 2, tanh(number));
SetLength(sollValues, Row+1); SetLength(sollValues, Row+1);
sollValues[Row] := FloatResult(tanh(number)); if AFormat = sfExcel2 then
sollValues[Row] := ErrorResult(errFormulaNotSupported)
else
sollValues[Row] := FloatResult(tanh(number));
// TANH of cell value // TANH of cell value
inc(Row); inc(Row);
@ -1799,7 +1827,11 @@
MyWorksheet.WriteFormula(Row, 1, formula); MyWorksheet.WriteFormula(Row, 1, formula);
MyWorksheet.WriteNumber(Row, 2, tanh(cellB1)); MyWorksheet.WriteNumber(Row, 2, tanh(cellB1));
SetLength(sollValues, Row+1); SetLength(sollValues, Row+1);
sollValues[Row] := FloatResult(tanh(cellB1)); if AFormat = sfExcel2 then
sollValues[Row] := ErrorResult(errFormulaNotSupported)
else
sollValues[Row] := FloatResult(tanh(cellB1));
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
{ Date/time functions } { Date/time functions }
@ -2087,7 +2119,10 @@
Myworksheet.WriteDateTimeFormat(Row, 1, nfShortDate); Myworksheet.WriteDateTimeFormat(Row, 1, nfShortDate);
Myworksheet.WriteDateTime(Row, 2, Date(), nfShortDate); Myworksheet.WriteDateTime(Row, 2, Date(), nfShortDate);
SetLength(sollValues, Row+1); SetLength(sollValues, Row+1);
sollValues[Row] := DateTimeResult(Date()); if AFormat = sfExcel2 then
sollValues[Row] := ErrorResult(errFormulaNotSupported)
else
sollValues[Row] := DateTimeResult(Date());
// WEEKDAY / argument number // WEEKDAY / argument number
inc(Row); inc(Row);