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

fpspreadsheet: Reduce support for shared formulas (too many problems...), only reading from xls and xlsx files supported.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3998 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-03-06 12:12:45 +00:00
parent 1af6c4c6f1
commit 9365a1dff2
14 changed files with 260 additions and 1650 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -63,16 +63,6 @@ begin
RPNNumber(5.0,
RPNFunc(fekAdd,
nil)))));
(*
// Write a shared formula "=E1+100" to the cell range F1:F5
// Please note that shared formulas are not written by sfOOXML and sfOpenDocument formats.
MyCell := MyWorksheet.WriteRPNFormula(0, 5, CreateRPNFormula(
RPNCellOffset(0, -1, [rfRelRow, rfRelCol],
RPNNumber(100,
RPNFunc(fekAdd,
nil)))));
MyWorksheet.UseSharedFormula('F1:F5', MyCell);
*)
end;
procedure WriteSecondWorksheet();

8
components/fpspreadsheet/fpsclasses.pas
View File

@ -5,7 +5,7 @@ unit fpsclasses;
interface
uses
Classes, SysUtils, AVL_Tree, avglvltree,
Classes, SysUtils, AVL_Tree, //avglvltree,
fpstypes;
type
@ -175,7 +175,8 @@ type
implementation
uses
Math, fpsUtils;
{%H-}Math,
fpsUtils;
{ Helper function for sorting }
@ -233,9 +234,6 @@ begin
end;
function TsRowColEnumerator.MoveNext: Boolean;
var
r1,c1,r2,c2: Cardinal;
item: TsRowCol;
begin
if FCurrentNode <> nil then begin
if FReverse then

15
components/fpspreadsheet/fpscsv.pas
View File

@ -602,8 +602,8 @@ end;
procedure TsCSVWriter.WriteSheet(AStream: TStream; AWorksheet: TsWorksheet);
var
r, c: Cardinal;
LastRow, LastCol: Cardinal;
r: Cardinal;
LastRow: Cardinal;
cell: PCell;
begin
FWorksheet := AWorksheet;
@ -616,23 +616,12 @@ begin
FCSVBuilder.SetOutput(AStream);
LastRow := FWorksheet.GetLastOccupiedRowIndex;
LastCol := FWorksheet.GetLastOccupiedColIndex;
for r := 0 to LastRow do
begin
for cell in FWorksheet.Cells.GetRowEnumerator(r) do
WriteCellToStream(AStream, cell);
FCSVBuilder.AppendRow;
end;
{
for c := 0 to LastCol do
begin
Cell := FWorksheet.FindCell(r, c);
if Cell <> nil then
WriteCellCallback(Cell, AStream);
if c = LastCol then
FCSVBuilder.AppendRow;
end;
}
finally
FreeAndNil(FCSVBuilder);
end;

72
components/fpspreadsheet/fpsexprparser.pas
View File

@ -682,7 +682,9 @@ type
FDirty: Boolean;
FWorksheet: TsWorksheet;
FDialect: TsFormulaDialect;
FActiveCell: PCell;
FSourceCell: PCell;
FDestCell: PCell;
// FActiveCell: PCell;
procedure CheckEOF;
procedure CheckNodes(var ALeft, ARight: TsExprNode);
function ConvertNode(Todo: TsExprNode; ToType: TsResultType): TsExprNode;
@ -730,10 +732,11 @@ type
destructor Destroy; override;
function IdentifierByName(AName: ShortString): TsExprIdentifierDef; virtual;
procedure Clear;
function CopyMode: Boolean;
function Evaluate: TsExpressionResult;
procedure EvaluateExpression(out Result: TsExpressionResult);
procedure PrepareCopyMode(ASourceCell, ADestCell: PCell);
function ResultType: TsResultType;
function SharedFormulaMode: Boolean;
property AsFloat: TsExprFloat read GetAsFloat;
property AsInteger: Int64 read GetAsInteger;
@ -747,7 +750,7 @@ type
property RPNFormula: TsRPNFormula read GetRPNFormula write SetRPNFormula;
property Identifiers: TsExprIdentifierDefs read FIdentifiers write SetIdentifiers;
property BuiltIns: TsBuiltInExprCategories read FBuiltIns write SetBuiltIns;
property ActiveCell: PCell read FActiveCell write FActiveCell;
// property ActiveCell: PCell read FActiveCell write FActiveCell;
property Worksheet: TsWorksheet read FWorksheet;
property Dialect: TsFormulaDialect read FDialect write FDialect;
end;
@ -1299,6 +1302,22 @@ begin
end;
end;
{ Prepares copy mode: The formula is contained in ASourceCell and will be
modified such as seen from ADestCell. }
procedure TsExpressionParser.PrepareCopyMode(ASourceCell, ADestCell: PCell);
begin
FSourceCell := ASourceCell;
FDestCell := ADestCell;
end;
{ Signals that the parser is in "CopyMode", i.e. there is are source and
destination cells. All relative references in the formula of the source cell
habe to be adapted as seen from the destination cell. }
function TsExpressionParser.CopyMode: Boolean;
begin
Result := (FDestCell <> nil) and (FSourceCell <> nil);
end;
procedure TsExpressionParser.CreateHashList;
var
ID: TsExprIdentifierDef;
@ -1975,14 +1994,14 @@ begin
CreateNodeFromRPN(FExprNode, index);
if Assigned(FExprNode) then FExprNode.Check;
end;
(*
{ Signals that the parser is in SharedFormulaMode, i.e. there is an active cell
to which all relative addresses have to be adapted. }
function TsExpressionParser.SharedFormulaMode: Boolean;
begin
Result := (ActiveCell <> nil) and (ActiveCell^.SharedFormulaBase <> nil);
end;
*)
function TsExpressionParser.TokenType: TsTokenType;
begin
Result := FScanner.TokenType;
@ -3811,37 +3830,27 @@ begin
end;
{ Calculates the row address of the node's cell for various cases:
(1) SharedFormula mode:
The "ActiveCell" of the parser is the cell for which the formula is
calculated. If the formula contains a relative address in the cell node
the function calculates the row address of the cell represented by the
node as seen from the active cell.
(1) Copy mode:
The "DestCell" of the parser is the cell for which the formula is
calculated. The "SourceCell" contains the formula. If the formula contains
a relative address in the cell node the function calculates the row
address of the cell represented by the node as seen from the DestCell.
If the formula contains an absolute address the function returns the row
address of the SharedFormulaBase of the ActiveCell.
address of the SourceCell.
(2) Normal mode:
Returns the "true" row address of the cell assigned to the formula node. }
function TsCellExprNode.GetCol: Cardinal;
begin
if FParser.SharedFormulaMode then
begin
// A shared formula is stored in the SharedFormulaBase cell of the ActiveCell
// Since the cell data stored in the node are those used by the formula in
// the SharedFormula, the current node is relative to the SharedFormulaBase
if rfRelCol in FFlags then
Result := FCol - FParser.ActiveCell^.SharedFormulaBase^.Col + FParser.ActiveCell^.Col
else
Result := FCol; //FParser.ActiveCell^.SharedFormulaBase^.Col;
end
else
// Normal mode
Result := FCol;
Result := FCol;
if FParser.CopyMode and (rfRelCol in FFlags) then
Result := FCol - FParser.FSourceCell^.Col + FParser.FDestCell^.Col;
end;
procedure TsCellExprNode.GetNodeValue(out Result: TsExpressionResult);
var
cell: PCell;
begin
if Parser.SharedFormulaMode then
if Parser.CopyMode then
cell := FWorksheet.FindCell(GetRow, GetCol)
else
cell := FCell;
@ -3863,15 +3872,9 @@ end;
{ See GetCol }
function TsCellExprNode.GetRow: Cardinal;
begin
if Parser.SharedFormulaMode then
begin
if rfRelRow in FFlags then
Result := FRow - FParser.ActiveCell^.SharedFormulaBase^.Row + FParser.ActiveCell^.Row
else
Result := FRow; //FParser.ActiveCell^.SharedFormulaBase^.Row;
end
else
Result := FRow;
Result := FRow;
if Parser.CopyMode and (rfRelRow in FFlags) then
Result := FRow - FParser.FSourceCell^.Row + FParser.FDestCell^.Row;
end;
function TsCellExprNode.NodeType: TsResultType;
@ -3998,7 +4001,6 @@ end;
function ArgToInt(Arg: TsExpressionResult): Integer;
var
cell: PCell;
s: String;
begin
Result := 0;
case Arg.ResultType of

2
components/fpspreadsheet/fpsopendocument.pas
View File

@ -4058,11 +4058,13 @@ begin
parser := TsSpreadsheetParser.Create(FWorksheet);
try
parser.Dialect := fdOpenDocument;
{
if ACell^.SharedFormulaBase <> nil then
begin
parser.ActiveCell := ACell;
parser.Expression := ACell^.SharedFormulaBase^.FormulaValue;
end else
}
parser.Expression := ACell^.FormulaValue;
formula := Parser.LocalizedExpression[FPointSeparatorSettings];
finally

481
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -234,11 +234,6 @@ type
procedure WriteRPNFormula(ACell: PCell;
AFormula: TsRPNFormula); overload;
procedure WriteSharedFormula(ARow1, ACol1, ARow2, ACol2: Cardinal;
const AFormula: String); overload;
procedure WriteSharedFormula(ACellRange: String;
const AFormula: String); overload;
function WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring): PCell; overload;
procedure WriteUTF8Text(ACell: PCell; AText: ansistring); overload;
@ -330,15 +325,10 @@ type
procedure WriteWordwrap(ACell: PCell; AValue: boolean); overload;
{ Formulas }
function BuildRPNFormula(ACell: PCell): TsRPNFormula;
function BuildRPNFormula(ACell: PCell; ADestCell: PCell = nil): TsRPNFormula;
procedure CalcFormula(ACell: PCell);
procedure CalcFormulas;
function ConvertRPNFormulaToStringFormula(const AFormula: TsRPNFormula): String;
function FindSharedFormulaBase(ACell: PCell): PCell;
function FindSharedFormulaRange(ACell: PCell; out ARow1, ACol1, ARow2, ACol2: Cardinal): Boolean;
procedure FixSharedFormulas;
procedure SplitSharedFormula(ACell: PCell);
function UseSharedFormula(ARow, ACol: Cardinal; ASharedFormulaBase: PCell): PCell;
function GetCalcState(ACell: PCell): TsCalcState;
procedure SetCalcState(ACell: PCell; AValue: TsCalcState);
@ -586,7 +576,6 @@ type
FFontList: TFPList;
{ Internal methods }
procedure FixSharedFormulas;
procedure GetLastRowColIndex(out ALastRow, ALastCol: Cardinal);
procedure PrepareBeforeReading;
procedure PrepareBeforeSaving;
@ -979,15 +968,13 @@ begin
end;
{@@ ----------------------------------------------------------------------------
Returns TRUE if the cell contains a formula (direct or shared, does not matter).
Returns TRUE if the cell contains a formula.
@param ACell Pointer to the cell checked
-------------------------------------------------------------------------------}
function HasFormula(ACell: PCell): Boolean;
begin
Result := Assigned(ACell) and (
(ACell^.SharedFormulaBase <> nil) or (Length(ACell^.FormulaValue) > 0)
);
Result := Assigned(ACell) and (Length(ACell^.FormulaValue) > 0);
end;
function CompareCells(Item1, Item2: Pointer): Integer;
@ -1108,11 +1095,14 @@ end;
Helper function which constructs an rpn formula from the cell's string
formula. This is needed, for example, when writing a formula to xls biff
file format.
If the cell belongs to a shared formula the formula is taken from the
shared formula base cell, cell references are adapted accordingly to the
location of the cell.
The formula is stored in ACell.
If ADestCell is not nil then the relative references are adjusted as seen
from ADestCell. This means that this function returns the formula that
would be created if ACell is copied to the location of ADestCell.
Needed for copying formulas and for splitting shared formulas.
-------------------------------------------------------------------------------}
function TsWorksheet.BuildRPNFormula(ACell: PCell): TsRPNFormula;
function TsWorksheet.BuildRPNFormula(ACell: PCell;
ADestCell: PCell = nil): TsRPNFormula;
var
parser: TsSpreadsheetParser;
begin
@ -1122,11 +1112,9 @@ begin
end;
parser := TsSpreadsheetParser.Create(self);
try
if (ACell^.SharedFormulaBase <> nil) then begin
parser.ActiveCell := ACell;
parser.Expression := ACell^.SharedFormulaBase^.FormulaValue;
end else
parser.Expression := ACell^.FormulaValue;
if ADestCell <> nil then
parser.PrepareCopyMode(ACell, ADestCell);
parser.Expression := ACell^.FormulaValue;
Result := parser.RPNFormula;
finally
parser.Free;
@ -1145,27 +1133,16 @@ procedure TsWorksheet.CalcFormula(ACell: PCell);
var
parser: TsSpreadsheetParser;
res: TsExpressionResult;
formula: String;
cell: PCell;
p: Integer;
link, txt: String;
cell: PCell;
begin
ACell^.Flags := ACell^.Flags + [cfCalculating] - [cfCalculated];
parser := TsSpreadsheetParser.Create(self);
try
if ACell^.SharedFormulaBase = nil then
begin
formula := ACell^.FormulaValue;
parser.ActiveCell := nil;
end else
begin
formula := ACell^.SharedFormulaBase^.FormulaValue;
parser.ActiveCell := ACell;
end;
try
parser.Expression := formula;
parser.Expression := ACell^.FormulaValue;
res := parser.Evaluate;
except
on E:ECalcEngine do
@ -1248,9 +1225,7 @@ begin
node := FCells.FindLowest;
while Assigned(node) do begin
cell := PCell(node.Data);
if (cell^.ContentType <> cctError) and
(HasFormula(cell) or HasFormula(cell^.SharedFormulaBase))
then
if (cell^.ContentType <> cctError) and HasFormula(cell) then
CalcFormula(cell);
node := FCells.FindSuccessor(node);
end;
@ -1496,7 +1471,6 @@ end;
function TsWorksheet.ValidHyperlink(AValue: String; out AErrMsg: String): Boolean;
var
uri: TUri;
mark: String;
sheet: TsWorksheet;
r, c: Cardinal;
begin
@ -1664,7 +1638,7 @@ begin
if IsMergeBase(AFromCell) then
begin
FindMergedRange(AFromCell, row1, col1, row2, col2);
MergeCells(toRow, toCol, toRow + row2 - row1, toCol + col2 - col1);
MergeCells(toRow, toCol, toRow + LongInt(row2) - LongInt(row1), toCol + LongInt(col2) - LongInt(col1));
end;
// Copy comment
@ -1743,7 +1717,6 @@ end;
procedure TsWorksheet.CopyFormula(AFromCell, AToCell: PCell);
var
rpnFormula: TsRPNFormula;
lCell: TCell;
begin
if (AFromCell = nil) or (AToCell = nil) then
exit;
@ -1753,11 +1726,7 @@ begin
else
begin
// Here we convert the formula to an rpn formula as seen from source...
// (The mechanism needs the ActiveCell of the parser which is only
// valid if the cell contains a shared formula)
lCell := AToCell^;
lCell.SharedFormulaBase := AFromCell;
rpnFormula := BuildRPNFormula(@lCell);
rpnFormula := BuildRPNFormula(AFromCell, AToCell);
// ... and here we reconstruct the string formula as seen from destination cell.
AToCell^.FormulaValue := ConvertRPNFormulaToStringFormula(rpnFormula);
end;
@ -1811,7 +1780,7 @@ end;
{@@ ----------------------------------------------------------------------------
Deletes a specified cell. If the cell belongs to a merged block its content
and formatting is erased. Otherwise the cell is destroyed, its memory is
and formatting is erased. Otherwise the cell is destroyed and its memory is
released.
-------------------------------------------------------------------------------}
procedure TsWorksheet.DeleteCell(ACell: PCell);
@ -1831,12 +1800,6 @@ begin
exit;
end;
// Is base of shared formula block? Recreate individual formulas
if ACell^.SharedFormulaBase = ACell then
SplitSharedFormula(ACell);
// Belongs to shared formula block? --> nothing to do
// Destroy the cell, and remove it from the tree
RemoveAndFreeCell(ACell^.Row, ACell^.Col);
end;
@ -2619,7 +2582,6 @@ end;
{@@ ----------------------------------------------------------------------------
If a cell contains a formula (string formula or RPN formula) the formula
is returned as a string in Excel syntax.
If the cell belongs to a shared formula the adapted shared formula is returned.
@param ACell Pointer to the cell considered
@param ALocalized If true, the formula is returned with decimal and list
@ -2636,40 +2598,19 @@ begin
if ACell = nil then
exit;
if HasFormula(ACell) then begin
// case (1): Formula is localized and has to be converted to default syntax
if ALocalized then
begin
// case (1): Formula is localized and has to be converted to default syntax // !!!! Is this comment correct?
parser := TsSpreadsheetParser.Create(self);
try
if ACell^.SharedFormulaBase <> nil then begin
// case (1a): shared formula
parser.ActiveCell := ACell;
parser.Expression := ACell^.SharedFormulaBase^.FormulaValue;
end else begin
// case (1b): normal formula
parser.ActiveCell := nil;
parser.Expression := ACell^.FormulaValue;
end;
parser.Expression := ACell^.FormulaValue;
Result := parser.LocalizedExpression[Workbook.FormatSettings];
finally
parser.Free;
end;
end
else
// case (2): Formula is in default syntax
if ACell^.SharedFormulaBase <> nil then
begin
// case (2a): shared formula
parser := TsSpreadsheetParser.Create(self);
try
parser.ActiveCell := ACell;
parser.Expression := ACell^.SharedFormulaBase^.FormulaValue;
Result := parser.Expression;
finally
parser.Free;
end;
end else
// case (2b): normal formula
// case (2): Formula is already in default syntax
Result := ACell^.FormulaValue;
end;
end;
@ -3121,7 +3062,6 @@ end;
procedure TsWorksheet.UnmergeCells(ARow, ACol: Cardinal);
var
rng: PsCellRange;
r, c: Cardinal;
cell: PCell;
begin
rng := FMergedCells.FindRangeWithCell(ARow, ACol);
@ -3155,23 +3095,6 @@ begin
UnmergeCells(rng.Row1, rng.Col1);
end;
{@@ ----------------------------------------------------------------------------
Finds the upper left cell of a shared formula block to which the specified
cell belongs. This is the "shared formula base".
@param ACell Cell under investigation
@return A pointer to the cell in the upper left corner of the shared formula
block to which ACell belongs. If ACell is not part of a shared formula
block then the function returns NIL.
-------------------------------------------------------------------------------}
function TsWorksheet.FindSharedFormulaBase(ACell: PCell): PCell;
begin
if ACell = nil then
Result := nil
else
Result := ACell^.SharedFormulaBase;
end;
{@@ ----------------------------------------------------------------------------
Determines the merged cell block to which a particular cell belongs
@ -3244,90 +3167,6 @@ begin
end;
{ Shared formulas }
{@@ ----------------------------------------------------------------------------
Determines the cell block sharing the same formula which is used by a given cell
Note: the block may not be contiguous. The function returns the outer edges
of the range.
@param ACell Pointer to the cell being investigated
@param ARow1 (output) Top row index of the shared formula block
@param ACol1 (outout) Left column index of the shared formula block
@param ARow2 (output) Bottom row index of the shared formula block
@param ACol2 (output) Right column index of the shared formula block
@return True if the cell belongs to a shared formula block, False if not or
if the cell does not exist at all.
-------------------------------------------------------------------------------}
function TsWorksheet.FindSharedFormulaRange(ACell: PCell;
out ARow1, ACol1, ARow2, ACol2: Cardinal): Boolean;
var
r, c: Cardinal;
cell: PCell;
base: PCell;
lastCol, lastRow: Cardinal;
begin
base := FindSharedFormulaBase(ACell);
if base = nil then begin
Result := false;
exit;
end;
// Assuming that the shared formula block is rectangular, we start at the base...
ARow1 := base^.Row;
ARow2 := ARow1;
ACol1 := base^.Col;
ACol2 := ACol1;
lastCol := GetLastOccupiedColIndex;
lastRow := GetLastOccupiedRowIndex;
// ... and go along first COLUMN to find the end of the shared formula block, ...
for c := ACol1+1 to lastCol do
begin
cell := FindCell(ARow1, c);
if (cell <> nil) and (cell^.SharedFormulaBase = base) then
ACol2 := c;
end;
// ... and go along first ROW to find the end of the shared formula block
for r := ARow1 + 1 to lastRow do
begin
cell := FindCell(r, ACol1);
if (cell <> nil) and (cell^.SharedFormulaBase = base) then
ARow2 := r;
end;
Result := true;
end;
{@@ ----------------------------------------------------------------------------
A shared formula must contain at least two cells. If there is only a single
cell then the shared formula is converted to a regular one.
Is called before writing to stream.
-------------------------------------------------------------------------------}
procedure TsWorksheet.FixSharedFormulas;
var
r,c, r1,c1, r2,c2: Cardinal;
cell: PCell;
// firstRow, firstCol, lastRow, lastCol: Cardinal;
begin
for cell in Cells do
if FindSharedFormulaRange(cell, r1, c1, r2, c2) and (r1 = r2) and (c1 = c2) then
cell^.SharedFormulaBase := nil;
{
firstRow := GetFirstRowIndex;
firstCol := GetFirstColIndex;
lastRow := GetLastOccupiedRowIndex;
lastCol := GetLastOccupiedColIndex;
for r := firstRow to lastRow do
for c := firstCol to lastCol do
begin
cell := FindCell(r, c);
if FindSharedFormulaRange(cell, r1, c1, r2, c2) and (r1 = r2) and (c1 = c2) then
cell^.SharedFormulaBase := nil;
end;
}
end;
{@@ ----------------------------------------------------------------------------
Removes the comment from a cell and releases the memory occupied by the node.
-------------------------------------------------------------------------------}
@ -3745,72 +3584,6 @@ begin
FLastRowIndex := GetLastRowIndex(true);
end;
{@@ ----------------------------------------------------------------------------
Splits a shared formula range to which the specified cell belongs into
individual cells. Each cell gets the same formula as it had in the block.
This is required because insertion and deletion of columns/rows make shared
formulas very complicated.
-------------------------------------------------------------------------------}
procedure TsWorksheet.SplitSharedFormula(ACell: PCell);
var
r, c: Cardinal;
baseRow, baseCol: Cardinal;
lastRow, lastCol: Cardinal;
cell: PCell;
rpnFormula: TsRPNFormula;
begin
if (ACell = nil) or (ACell^.SharedFormulaBase = nil) then
exit;
lastRow := GetLastOccupiedRowIndex;
lastCol := GetLastOccupiedColIndex;
baseRow := ACell^.SharedFormulaBase^.Row;
baseCol := ACell^.SharedFormulaBase^.Col;
for r := baseRow to lastRow do
for c := baseCol to lastCol do
begin
cell := FindCell(r, c);
if (cell = nil) or (cell^.SharedFormulaBase = nil) then
continue;
if (cell^.SharedFormulaBase^.Row = baseRow) and
(cell^.SharedFormulaBase^.Col = baseCol) then
begin
// This method converts the shared formula to an rpn formula as seen from cell...
rpnFormula := BuildRPNFormula(cell);
// ... and this reconstructs the string formula, again as seen from cell.
cell^.FormulaValue := ConvertRPNFormulaToStringFormula(rpnFormula);
// Remove the SharedFormulaBase information --> cell is isolated.
cell^.SharedFormulaBase := nil;
end;
end;
end;
{@@ ----------------------------------------------------------------------------
Defines a cell range sharing the "same" formula. Note that relative cell
references are updated for each cell in the range.
@param ARow Row of the cell
@param ACol Column index of the cell
@param ASharedFormulaBase Cell containing the shared formula
Note: An exception is raised if the cell already contains a formula (and is
different from the ASharedFormulaBase cell).
-------------------------------------------------------------------------------}
function TsWorksheet.UseSharedFormula(ARow, ACol: Cardinal;
ASharedFormulaBase: PCell): PCell;
begin
if ASharedFormulaBase = nil then begin
Result := nil;
exit;
end;
Result := GetCell(ARow, ACol);
Result.SharedFormulaBase := ASharedFormulaBase;
if (Result^.FormulaValue <> '') and
((ASharedFormulaBase.Row <> ARow) and (ASharedFormulaBase.Col <> ACol))
then
raise Exception.CreateFmt('[TsWorksheet.UseSharedFormula] Cell %s uses a shared formula, but contains an own formula.',
[GetCellString(ARow, ACol)]);
end;
{@@ ----------------------------------------------------------------------------
Writes UTF-8 encoded text to a cell.
@ -3855,7 +3628,6 @@ begin
begin
if (Workbook.GetCellFormat(ACell^.FormatIndex).UsedFormattingFields = []) and
(ACell^.Flags * [cfHyperlink, cfHasComment, cfMerged] = []) and
(ACell^.SharedFormulaBase = nil) and
(ACell^.FormulaValue = '')
then
begin
@ -4052,8 +3824,6 @@ end;
along a range of cells including empty cells.
-------------------------------------------------------------------------------}
procedure TsWorksheet.WriteBlank(ACell: PCell);
var
hyperlink: TsHyperlink;
begin
if ACell <> nil then begin
if HasHyperlink(ACell) then
@ -4818,57 +4588,6 @@ begin
ChangedCell(ACell^.Row, ACell^.Col);
end;
{@@ ----------------------------------------------------------------------------
Writes a formula to a cell and shares it with other cells.
@param ARow1, ACol1 Row and column index of the top left corner of
the range sharing the formula. The cell in this
cell stores the formula.
@param ARow2, ACol2 Row and column of the bottom right corner of the
range sharing the formula.
@param AFormula Formula in Excel notation
-------------------------------------------------------------------------------}
procedure TsWorksheet.WriteSharedFormula(ARow1, ACol1, ARow2, ACol2: Cardinal;
const AFormula: String);
var
cell: PCell;
r, c: Cardinal;
begin
if (ARow1 > ARow2) or (ACol1 > ACol2) then
raise Exception.Create('[TsWorksheet.WriteSharedFormula] Rows/cols not ordered correctly: ARow1 <= ARow2, ACol1 <= ACol2.');
if (ARow1 = ARow2) and (ACol1 = ACol2) then
raise Exception.Create('[TsWorksheet.WriteSharedFormula] A shared formula range must contain at least two cells.');
// The cell at the top/left corner of the cell range is the "SharedFormulaBase".
// It is the only cell which stores the formula.
cell := WriteFormula(ARow1, ACol1, AFormula);
for r := ARow1 to ARow2 do
for c := ACol1 to ACol2 do
UseSharedFormula(r, c, cell);
end;
{@@ ----------------------------------------------------------------------------
Writes a formula to a cell and shares it with other cells.
@param ACellRangeStr Range of cells which will use the shared formula.
The range is given as a string in Excel notation,
such as A1:B5, or A1
@param AFormula Formula (in Excel notation) to be shared. The cell
addresses are relative to the top/left cell of the
range.
-------------------------------------------------------------------------------}
procedure TsWorksheet.WriteSharedFormula(ACellRange: String;
const AFormula: String);
var
r1,r2, c1,c2: Cardinal;
begin
if ParseCellRangeString(ACellRange, r1, c1, r2, c2) then
WriteSharedFormula(r1, c1, r2, c2, AFormula)
else
raise Exception.Create('[TsWorksheet.WriteSharedFormula] No valid cell range string.');
end;
{@@ ----------------------------------------------------------------------------
Adds font specification to the formatting of a cell. Looks in the workbook's
FontList and creates an new entry if the font is not used so far. Returns the
@ -5699,20 +5418,12 @@ end;
function TsWorksheet.CalcAutoRowHeight(ARow: Cardinal): Single;
var
cell: PCell;
col: Integer;
h0: Single;
begin
Result := 0;
h0 := Workbook.GetDefaultFontSize;
for cell in Cells.GetRowEnumerator(ARow) do
Result := Max(Result, ReadCellFont(cell).Size / h0);
{
for col := GetFirstColIndex to GetLastColIndex do begin
cell := FindCell(ARow, col);
if cell <> nil then
Result := Max(Result, ReadCellFont(cell).Size / h0);
end;
}
end;
{@@ ----------------------------------------------------------------------------
@ -5901,43 +5612,13 @@ procedure TsWorksheet.DeleteCol(ACol: Cardinal);
var
col: PCol;
i: Integer;
r, rr, cc: Cardinal;
cell, basecell, nextcell: PCell;
firstRow, lastCol, lastRow: Cardinal;
r: Cardinal;
cell: PCell;
firstRow, lastRow: Cardinal;
begin
lastCol := GetLastColIndex;
lastRow := GetLastOccupiedRowIndex;
firstRow := GetFirstRowIndex;
// Loop along the column to be deleted and fix shared formulas
for r := firstRow to lastRow do
begin
cell := FindCell(r, ACol);
// Fix shared formulas: if the deleted column contains the shared formula base
// of a shared formula block then the shared formula has to be moved to the
// next column
if (cell <> nil) and (cell^.SharedFormulaBase = cell) then begin
basecell := cell;
nextcell := FindCell(r, ACol+1); // cell in next column and same row
// Next cell in col at the right does not share this formula --> done with this formula
if (nextcell = nil) or (nextcell^.SharedFormulaBase <> cell) then
continue;
// Write adapted formula to the cell below.
WriteFormula(nextcell, basecell^.Formulavalue); //ReadFormulaAsString(nextcell));
// Have all cells sharing the formula use the new formula base
for rr := r to lastRow do
for cc := ACol+1 to lastCol do
begin
cell := FindCell(rr, cc);
if (cell <> nil) and (cell^.SharedFormulaBase = basecell) then
cell^.SharedFormulaBase := nextcell
else
break;
end;
end;
end;
// Fix merged cells
FMergedCells.DeleteRowOrCol(ACol, false);
@ -5981,41 +5662,12 @@ procedure TsWorksheet.DeleteRow(ARow: Cardinal);
var
row: PRow;
i: Integer;
c, rr, cc: Cardinal;
firstCol, lastCol, lastRow: Cardinal;
cell, nextcell, basecell: PCell;
c: Cardinal;
firstCol, lastCol: Cardinal;
cell: PCell;
begin
firstCol := GetFirstColIndex;
lastCol := GetLastOccupiedColIndex;
lastRow := GetLastOccupiedRowIndex;
// Loop along the row to be deleted and fix shared formulas
for c := firstCol to lastCol do
begin
cell := FindCell(ARow, c);
// Fix shared formulas: if the deleted row contains the shared formula base
// of a shared formula block then the shared formula has to be moved to the
// next row
if (cell <> nil) and (cell^.SharedFormulaBase = cell) then begin
basecell := cell;
nextcell := FindCell(ARow+1, c); // cell in next row at same column
// Next cell in row below does not share this formula --> done with this formula
if (nextcell = nil) or (nextcell^.SharedFormulaBase <> cell) then
continue;
// Write adapted formula to the cell below.
WriteFormula(nextcell, basecell^.FormulaValue); //ReadFormulaAsString(nextcell));
// Have all cells sharing the formula use the new formula base
for rr := ARow+1 to lastRow do
for cc := c to lastCol do
begin
cell := FindCell(rr, cc);
if (cell <> nil) and (cell^.SharedFormulaBase = basecell) then
cell^.SharedFormulaBase := nextcell
else
break;
end;
end;
end;
// Fix merged cells
FMergedCells.DeleteRowOrCol(ARow, true);
@ -6027,7 +5679,7 @@ begin
FHyperlinks.DeleteRowOrCol(ARow, true);
// Delete cells
for c := lastCol downto 0 do
for c := lastCol downto firstCol do
RemoveAndFreeCell(ARow, c);
// Update row index of cell records
@ -6061,15 +5713,9 @@ procedure TsWorksheet.InsertCol(ACol: Cardinal);
var
col: PCol;
i: Integer;
r: Cardinal;
cell: PCell;
rng: PsCellRange;
begin
// Handling of shared formula references is too complicated for me...
// Split them into isolated cell formulas
for cell in FCells do
SplitSharedFormula(cell);
// Update column index of comments
FComments.InsertRowOrCol(ACol, false);
@ -6091,24 +5737,15 @@ begin
// Fix merged cells
for rng in FMergedCells do
// rng := PsCellRange(FMergedCells.GetFirst);
// while rng <> nil do
begin
// The new column is at the LEFT of the merged block
// --> Shift entire range to the right by 1 column
if (ACol < rng^.Col1) then
begin
// The former first column is no longer marged --> un-tag its cells
// The former first column is no longer merged --> un-tag its cells
for cell in Cells.GetColEnumerator(rng^.Col1, rng^.Row1, rng^.Row2) do
Exclude(cell^.Flags, cfMerged);
{
for r := rng^.Row1 to rng^.Row2 do
begin
cell := FindCell(r, rng^.Col1);
if cell <> nil then
Exclude(cell^.Flags, cfMerged);
end;
}
// Shift merged block to the right
// Don't call "MergeCells" here - this would add a new merged block
// because of the new merge base! --> infinite loop!
@ -6117,21 +5754,11 @@ begin
// The right column needs to be tagged
for cell in Cells.GetColEnumerator(rng^.Col2, rng^.Row1, rng^.Row2) do
Include(cell^.Flags, cfMerged);
{
for r := rng^.Row1 to rng^.Row2 do
begin
cell := FindCell(R, rng^.Col2);
if cell <> nil then
Include(cell^.Flags, cfMerged);
end;
}
end else
// The new column goes through this cell block --> Shift only the right
// column of the range to the right by 1
if (ACol >= rng^.Col1) and (ACol <= rng^.Col2) then
MergeCells(rng^.Row1, rng^.Col1, rng^.Row2, rng^.Col2+1);
// Continue with next merged block
// rng := PsCellRange(FMergedCells.GetNext);
end;
ChangedCell(0, ACol);
@ -6187,15 +5814,9 @@ procedure TsWorksheet.InsertRow(ARow: Cardinal);
var
row: PRow;
i: Integer;
c: Cardinal;
cell: PCell;
rng: PsCellRange;
begin
// Handling of shared formula references is too complicated for me...
// Splits them into isolated cell formulas
for cell in FCells do
SplitSharedFormula(cell);
// Update row index of cell comments
FComments.InsertRowOrCol(ARow, true);
@ -6217,8 +5838,6 @@ begin
// Fix merged cells
for rng in FMergedCells do
// rng := PsCellRange(FMergedCells.GetFirst);
// while rng <> nil do
begin
// The new row is ABOVE the merged block --> Shift entire range down by 1 row
if (ARow < rng^.Row1) then
@ -6226,14 +5845,7 @@ begin
// The formerly first row is no longer merged --> un-tag its cells
for cell in Cells.GetRowEnumerator(rng^.Row1, rng^.Col1, rng^.Col2) do
Exclude(cell^.Flags, cfMerged);
{
for c := rng^.Col1 to rng^.Col2 do
begin
cell := FindCell(rng^.Row1, c);
if cell <> nil then
Exclude(cell^.Flags, cfMerged);
end;
}
// Shift merged block down
// (Don't call "MergeCells" here - this would add a new merged block
// because of the new merge base! --> infinite loop!)
@ -6242,21 +5854,11 @@ begin
// The last row needs to be tagged
for cell in Cells.GetRowEnumerator(rng^.Row2, rng^.Col1, rng^.Col2) do
Include(cell^.Flags, cfMerged);
{
for c := rng^.Col1 to rng^.Col2 do
begin
cell := FindCell(rng^.Row2, c);
if cell <> nil then
Include(cell^.Flags, cfMerged);
end;
}
end else
// The new row goes through this cell block --> Shift only the bottom row
// of the range down by 1
if (ARow >= rng^.Row1) and (ARow <= rng^.Row2) then
MergeCells(rng^.Row1, rng^.Col1, rng^.Row2+1, rng^.Col2);
// Continue with next block
// rng := PsCellRange(FMergedCells.GetNext);
end;
ChangedCell(ARow, 0);
@ -6472,9 +6074,6 @@ begin
// Updates fist/last column/row index
UpdateCaches;
// Shared formulas must contain at least two cells
FixSharedFormulas;
// Calculated formulas (if requested)
if (boCalcBeforeSaving in FOptions) then
for sheet in FWorksheets do
@ -6717,22 +6316,6 @@ begin
raise Exception.Create(rsUnsupportedWriteFormat);
end;
{@@ ----------------------------------------------------------------------------
Shared formulas must contain at least two cells. If it's a single cell, then
the cell formula is converted to a standard one.
-------------------------------------------------------------------------------}
procedure TsWorkbook.FixSharedFormulas;
var
sheet: TsWorksheet;
i: Integer;
begin
for i := 0 to GetWorksheetCount-1 do
begin
sheet := GetWorksheetByIndex(i);
sheet.FixSharedFormulas
end;
end;
{@@ ----------------------------------------------------------------------------
Determines the maximum index of used columns and rows in all sheets of this
workbook. Respects VirtualMode.

2
components/fpspreadsheet/fpspreadsheetctrls.pas
View File

@ -2692,12 +2692,14 @@ begin
if ACell^.ContentType = cctError then
AStrings.Add(Format('ErrorValue=%s', [GetEnumName(TypeInfo(TsErrorValue), ord(ACell^.ErrorValue))]));
AStrings.Add(Format('FormulaValue=%s', [Worksheet.ReadFormulaAsString(ACell, true)]));
{
if ACell^.SharedFormulaBase = nil then
AStrings.Add('SharedFormulaBase=')
else
AStrings.Add(Format('SharedFormulaBase=%s', [GetCellString(
ACell^.SharedFormulaBase^.Row, ACell^.SharedFormulaBase^.Col)
]));
}
if (cfHyperlink in ACell^.Flags) then
begin
hyperlink := Worksheet.FindHyperlink(ACell);

4
components/fpspreadsheet/fpstypes.pas
View File

@ -548,13 +548,11 @@ type
{ Location of the cell }
Row: Cardinal; // zero-based
Col: Cardinal; // zero-based
Worksheet: Pointer; // Must be cast to TsWorksheet when used
Worksheet: Pointer; // Must be cast to TsWorksheet when used (avoids circular unit reference)
{ Status flags }
Flags: TsCellFlags;
{ Index of format record in the workbook's FCellFormatList }
FormatIndex: Integer;
{ Special information }
SharedFormulaBase: PCell; // Cell containing the shared formula
{ Cell content }
UTF8StringValue: String; // Strings cannot be part of a variant record
FormulaValue: String;

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

@ -33,13 +33,17 @@ type
// Test reconstruction of formula strings
procedure Test_Write_Read_FormulaStrings(AFormat: TsSpreadsheetFormat;
UseRPNFormula: Boolean);
{
// Test reconstruction of shared formula strings
procedure Test_Write_Read_SharedFormulaStrings(AFormat: TsSpreadsheetFormat);
// Test calculation of formulas
}
procedure Test_Write_Read_CalcFormulas(AFormat: TsSpreadsheetformat;
UseRPNFormula: Boolean);
{
// Test calculation of shared formulas
procedure Test_Write_Read_CalcSharedFormulas(AFormat: TsSpreadsheetformat);
}
published
// Writes out formulas & reads them back.
@ -54,6 +58,7 @@ type
{ ODS Tests }
procedure Test_Write_Read_FormulaStrings_ODS;
(*
// Writes out shared formulas & reads them back.
{ BIFF2 Tests }
procedure Test_Write_Read_SharedFormulaStrings_BIFF2;
@ -64,7 +69,7 @@ type
{ OOXML Tests }
procedure Test_Write_Read_SharedFormulaStrings_OOXML;
{ ODS Tests }
procedure Test_Write_Read_SharedFormulaStrings_ODS;
procedure Test_Write_Read_SharedFormulaStrings_ODS; *)
// Writes out and calculates rpn formulas, read back
{ BIFF2 Tests }
@ -89,7 +94,7 @@ type
procedure Test_Write_Read_CalcStringFormula_OOXML;
{ ODS Tests }
procedure Test_Write_Read_CalcStringFormula_ODS;
(*
// Writes out and calculates shared formulas, read back
{ BIFF2 Tests }
procedure Test_Write_Read_CalcSharedFormula_BIFF2;
@ -100,7 +105,7 @@ type
{ OOXML Tests }
procedure Test_Write_Read_CalcSharedFormula_OOXML;
{ ODS Tests }
procedure Test_Write_Read_CalcSharedFormula_ODS;
procedure Test_Write_Read_CalcSharedFormula_ODS; *)
end;
@ -227,7 +232,7 @@ end;
{ Test writing and reading (i.e. reconstruction) of shared formula strings }
(*
procedure TSpreadWriteReadFormulaTests.Test_Write_Read_SharedFormulaStrings(
AFormat: TsSpreadsheetFormat);
const
@ -352,7 +357,7 @@ procedure TSpreadWriteReadFormulaTests.Test_Write_Read_SharedFormulaStrings_ODS;
begin
Test_Write_Read_SharedFormulaStrings(sfOpenDocument);
end;
*)
{ Test calculation of formulas }
procedure TSpreadWriteReadFormulaTests.Test_Write_Read_CalcFormulas(
@ -550,6 +555,7 @@ end;
//------------------------------------------------------------------------------
// Calculation of shared formulas
//------------------------------------------------------------------------------
(*
procedure TSpreadWriteReadFormulaTests.Test_Write_Read_CalcSharedFormulas(
AFormat: TsSpreadsheetFormat);
const
@ -707,7 +713,7 @@ procedure TSpreadWriteReadFormulaTests.Test_Write_Read_CalcSharedFormula_ODS;
begin
Test_Write_Read_CalcSharedFormulas(sfOpenDocument);
end;
*)
initialization
// Register so these tests are included in a full run

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

File diff suppressed because it is too large Load Diff

19
components/fpspreadsheet/xlsbiff2.pas
View File

@ -128,10 +128,12 @@ type
procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal;
const AFormula: TsRPNFormula; ACell: PCell); override;
function WriteRPNFunc(AStream: TStream; AIdentifier: Word): Word; override;
{
procedure WriteRPNSharedFormulaLink(AStream: TStream; ACell: PCell;
var RPNLength: Word); override;
}
procedure WriteRPNTokenArraySize(AStream: TStream; ASize: Word); override;
procedure WriteSharedFormula(AStream: TStream; ACell: PCell); override;
// procedure WriteSharedFormula(AStream: TStream; ACell: PCell); override;
procedure WriteStringRecord(AStream: TStream; AString: String); override;
procedure WriteWindow1(AStream: TStream); override;
procedure WriteWindow2(AStream: TStream; ASheet: TsWorksheet);
@ -1670,10 +1672,11 @@ begin
AStream.WriteByte(1);
{ Formula data (RPN token array) }
{
if ACell^.SharedFormulaBase <> nil then
WriteRPNSharedFormulaLink(AStream, ACell, RPNLength)
else
WriteRPNTokenArray(AStream, ACell, AFormula, false, RPNLength);
else}
WriteRPNTokenArray(AStream, ACell, AFormula, false, RPNLength);
{ Finally write sizes after we know them }
FinalPos := AStream.Position;
@ -1683,7 +1686,7 @@ begin
{ Write following STRING record if formula result is a non-empty string }
if (ACell^.ContentType = cctUTF8String) and (ACell^.UTF8StringValue <> '') then
WriteStringRecord(AStream, ACell^.UTF8StringValue);
WriteSTRINGRecord(AStream, ACell^.UTF8StringValue);
end;
{@@ ----------------------------------------------------------------------------
@ -1696,7 +1699,7 @@ begin
AStream.WriteByte(Lo(AIdentifier));
Result := 1;
end;
(*
{@@ ----------------------------------------------------------------------------
This method is intended to write a link to the cell containing the shared
formula used by the cell. But since BIFF2 does not support shared formulas
@ -1721,7 +1724,7 @@ begin
// Clean up
SetLength(formula, 0);
end;
*)
{@@ ----------------------------------------------------------------------------
Writes the size of the RPN token array. Called from WriteRPNFormula.
Overrides xlscommon.
@ -1731,7 +1734,7 @@ procedure TsSpreadBIFF2Writer.WriteRPNTokenArraySize(AStream: TStream;
begin
AStream.WriteByte(ASize);
end;
(*
{@@ ----------------------------------------------------------------------------
Is intended to write the token array of a shared formula stored in ACell.
But since BIFF2 does not support shared formulas this method must not do
@ -1740,7 +1743,7 @@ end;
procedure TsSpreadBIFF2Writer.WriteSharedFormula(AStream: TStream; ACell: PCell);
begin
Unused(AStream, ACell);
end;
end; *)
{@@ ----------------------------------------------------------------------------
Writes an Excel 2 STRING record which immediately follows a FORMULA record

33
components/fpspreadsheet/xlsbiff8.pas
View File

@ -355,8 +355,8 @@ const
MASK_HLINK_ABSOLUTE = $00000002;
MASK_HLINK_DESCRIPTION = $00000014;
MASK_HLINK_TEXTMARK = $00000008;
MASK_HLINK_TARGETFRAME = $00000080;
MASK_HLINK_UNCPATH = $00000100;
{%H-}MASK_HLINK_TARGETFRAME = $00000080;
{%H-}MASK_HLINK_UNCPATH = $00000100;
SHAPEID_BASE = 1024;
@ -1446,7 +1446,7 @@ begin
col2 := WordLEToN(AStream.ReadWord);
{ GUID of standard link }
AStream.ReadBuffer(guid, SizeOf(guid));
AStream.ReadBuffer(guid{%H-}, SizeOf(guid));
{ unknown DWord }
AStream.ReadDWord;
@ -2648,7 +2648,7 @@ procedure TsSpreadBIFF8Writer.WriteMergedCells(AStream: TStream;
const
MAX_PER_RECORD = 1026;
var
n0, n, i: Integer;
n0, n: Integer;
rng: PsCellRange;
newRecord: Boolean;
begin
@ -2678,31 +2678,6 @@ begin
n := Min(n0, MAX_PER_RECORD);
end;
end;
(*
while n0 > 0 do begin
n := Min(n0, MAX_PER_RECORD);
// at most 1026 merged ranges per BIFF record, the rest goes into a new record
{ BIFF record header }
WriteBIFFHeader(AStream, INT_EXCEL_ID_MERGEDCELLS, 2 + n*8);
{ Number of cell ranges in this record }
AStream.WriteWord(WordToLE(n));
{ Loop for writing the merged cell ranges }
rng := PsCellRange(AWorksheet.MergedCells.GetFirst);
while (n > 0) do begin
AStream.WriteWord(WordToLE(rng^.Row1));
AStream.WriteWord(WordToLE(rng^.Row2));
AStream.WriteWord(WordToLE(rng^.Col1));
AStream.WriteWord(WordToLE(rng^.Col2));
dec(n);
rng := PsCellRange(AWorksheet.MergedCells.GetNext);
end;
dec(n0, MAX_PER_RECORD);
end;
*)
end;
{@@-----------------------------------------------------------------------------

70
components/fpspreadsheet/xlscommon.pas
View File

@ -313,7 +313,8 @@ type
out AFlags: TsRelFlags); virtual;
function ReadRPNFunc(AStream: TStream): Word; virtual;
procedure ReadRPNSharedFormulaBase(AStream: TStream; out ARow, ACol: Cardinal); virtual;
function ReadRPNTokenArray(AStream: TStream; ACell: PCell): Boolean;
function ReadRPNTokenArray(AStream: TStream; ACell: PCell;
ASharedFormulaBase: PCell = nil): Boolean;
function ReadRPNTokenArraySize(AStream: TStream): word; virtual;
procedure ReadSharedFormula(AStream: TStream);
@ -404,8 +405,10 @@ type
const AFormula: TsRPNFormula; ACell: PCell); virtual;
function WriteRPNFunc(AStream: TStream; AIdentifier: Word): Word; virtual;
procedure WriteRPNResult(AStream: TStream; ACell: PCell);
{
procedure WriteRPNSharedFormulaLink(AStream: TStream; ACell: PCell;
var RPNLength: Word); virtual;
}
procedure WriteRPNTokenArray(AStream: TStream; ACell: PCell;
const AFormula: TsRPNFormula; UseRelAddr: Boolean; var RPNLength: Word);
procedure WriteRPNTokenArraySize(AStream: TStream; ASize: Word); virtual;
@ -413,10 +416,12 @@ type
// Writes out a SELECTION record
procedure WriteSelection(AStream: TStream; ASheet: TsWorksheet; APane: Byte);
procedure WriteSelections(AStream: TStream; ASheet: TsWorksheet);
(*
// Writes out a shared formula
procedure WriteSharedFormula(AStream: TStream; ACell: PCell); virtual;
procedure WriteSharedFormulaRange(AStream: TStream;
AFirstRow, AFirstCol, ALastRow, ALastCol: Cardinal); virtual;
*)
procedure WriteSheetPR(AStream: TStream);
procedure WriteStringRecord(AStream: TStream; AString: String); virtual;
// Writes cell content received by workbook in OnNeedCellData event
@ -1591,7 +1596,7 @@ end;
rpn formula, converts it to a string formula and stores it in the cell.
-------------------------------------------------------------------------------}
function TsSpreadBIFFReader.ReadRPNTokenArray(AStream: TStream;
ACell: PCell): Boolean;
ACell: PCell; ASharedFormulaBase: PCell = nil): Boolean;
var
n: Word;
p0: Int64;
@ -1607,7 +1612,8 @@ var
funcCode: Word;
b: Byte;
found: Boolean;
formula: TsRPNformula;
rpnFormula: TsRPNformula;
strFormula: String;
begin
rpnItem := nil;
n := ReadRPNTokenArraySize(AStream);
@ -1652,16 +1658,16 @@ begin
// For compatibility with other formats, convert offsets back to regular indexes.
if (rfRelRow in flags)
then r := LongInt(ACell^.Row) + dr
else r := LongInt(ACell^.SharedFormulaBase^.Row) + dr;
else r := LongInt(ASharedFormulaBase^.Row) + dr;
if (rfRelRow2 in flags)
then r2 := LongInt(ACell^.Row) + dr2
else r2 := LongInt(ACell^.SharedFormulaBase^.Row) + dr2;
else r2 := LongInt(ASharedFormulaBase^.Row) + dr2;
if (rfRelCol in flags)
then c := LongInt(ACell^.Col) + dc
else c := LongInt(ACell^.SharedFormulaBase^.Col) + dc;
else c := LongInt(ASharedFormulaBase^.Col) + dc;
if (rfRelCol2 in flags)
then c2 := LongInt(ACell^.Col) + dc2
else c2 := LongInt(ACell^.SharedFormulaBase^.Col) + dc2;
else c2 := LongInt(ASharedFormulaBase^.Col) + dc2;
rpnItem := RPNCellRange(r, c, r2, c2, flags, rpnItem);
end;
INT_EXCEL_TOKEN_TMISSARG:
@ -1710,12 +1716,9 @@ begin
end;
INT_EXCEL_TOKEN_TEXP:
// Indicates that cell belongs to a shared or array formula. We determine
// the base cell of the shared formula and store it in the current cell.
begin
ReadRPNSharedFormulaBase(AStream, r, c);
ACell^.SharedFormulaBase := FWorksheet.FindCell(r, c);
end;
// Indicates that cell belongs to a shared or array formula.
// This information is not needed any more.
ReadRPNSharedFormulaBase(AStream, r, c);
else
found := false;
@ -1734,11 +1737,16 @@ begin
Result := false;
end
else begin
formula := CreateRPNFormula(rpnItem, true); // true --> we have to flip the order of items!
rpnFormula := CreateRPNFormula(rpnItem, true); // true --> we have to flip the order of items!
strFormula := FWorksheet.ConvertRPNFormulaToStringFormula(rpnFormula);
if strFormula <> '' then
ACell^.FormulaValue := strFormula;
{
if (ACell^.SharedFormulaBase = nil) or (ACell = ACell^.SharedFormulaBase) then
ACell^.FormulaValue := FWorksheet.ConvertRPNFormulaToStringFormula(formula)
else
ACell^.FormulaValue := '';
}
Result := true;
end;
end;
@ -1760,7 +1768,7 @@ end;
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFReader.ReadSharedFormula(AStream: TStream);
var
r1, {%H-}r2, c1, {%H-}c2: Cardinal;
r, r1, r2, c, c1, c2: Cardinal;
cell: PCell;
begin
// Cell range in which the formula is valid
@ -1769,12 +1777,12 @@ begin
c1 := AStream.ReadByte; // 8 bit, even for BIFF8
c2 := AStream.ReadByte;
{ Create cell }
{ Create cell - this is the "base" of the shared formula }
if FIsVirtualMode then begin // "Virtual" cell
InitCell(r1, c1, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(r1, c1); // "Real" cell
cell := FWorksheet.GetCell(r1, c1); // "Real" cell
// Unused
AStream.ReadByte;
@ -1783,7 +1791,12 @@ begin
AStream.ReadByte;
// RPN formula tokens
ReadRPNTokenArray(AStream, cell);
ReadRPNTokenArray(AStream, cell, cell); //base);
// Copy shared formula to individual cells in the specified range
for r := r1 to r2 do
for c := c1 to c2 do
FWorksheet.CopyFormula(cell, r, c);
end;
{@@ ----------------------------------------------------------------------------
@ -2534,8 +2547,12 @@ begin
if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then
exit;
if Length(AFormula) = 0 then
exit;
{
if not ((Length(AFormula) > 0) or (ACell^.SharedFormulaBase <> nil)) then
exit;
}
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_FORMULA));
@ -2560,18 +2577,19 @@ begin
AStream.WriteDWord(0);
{ Formula data (RPN token array) }
{
if ACell^.SharedFormulaBase <> nil then
WriteRPNSharedFormulaLink(AStream, ACell, RPNLength)
else
WriteRPNTokenArray(AStream, ACell, AFormula, false, RPNLength);
}
WriteRPNTokenArray(AStream, ACell, AFormula, false, RPNLength);
{ Write sizes in the end, after we known them }
FinalPos := AStream.Position;
AStream.Position := RecordSizePos;
AStream.WriteWord(WordToLE(FinalPos - StartPos));
// AStream.WriteWord(WordToLE(22 + RPNLength));
AStream.Position := FinalPos;
(*
{ If the cell is the first cell of a range with a shared formula write the
shared formula RECORD here. The shared formula RECORD must follow the
first FORMULA record referring to the shared formula}
@ -2580,10 +2598,11 @@ begin
(ACol = ACell^.SharedFormulaBase^.Col)
then
WriteSharedFormula(AStream, ACell^.SharedFormulaBase);
*)
{ Write following STRING record if formula result is a non-empty string. }
if (ACell^.ContentType = cctUTF8String) and (ACell^.UTF8StringValue <> '') then
WriteStringRecord(AStream, ACell^.UTF8StringValue);
WriteSTRINGRecord(AStream, ACell^.UTF8StringValue);
end;
{@@ ----------------------------------------------------------------------------
@ -2642,7 +2661,7 @@ begin
{ Write result of the formula, encoded above }
AStream.WriteBuffer(Data, 8);
end;
(*
{@@ ----------------------------------------------------------------------------
Is called from WriteRPNFormula in the case that the cell uses a shared
formula and writes the token "array" pointing to the shared formula base.
@ -2669,6 +2688,7 @@ begin
AStream.WriteBuffer(rec, SizeOf(rec));
RPNLength := SizeOf(rec);
end;
*)
{@@ ----------------------------------------------------------------------------
Writes the token array of the given RPN formula and returns its size
@ -3014,7 +3034,7 @@ begin
end;
end;
end;
(*
{@@ ----------------------------------------------------------------------------
Writes the token array of a shared formula stored in ACell.
Note: Relative cell addresses of a shared formula are defined by
@ -3083,7 +3103,7 @@ begin
AStream.WriteByte(AFirstCol);
// Index to last rcolumn
AStream.WriteByte(ALastCol);
end;
end; *)
{@@ ----------------------------------------------------------------------------
Writes a SHEETPR Record.

83
components/fpspreadsheet/xlsxooxml.pas
View File

@ -67,7 +67,7 @@ type
FBorderList: TFPList;
FHyperlinkList: TFPList;
FThemeColors: array of TsColorValue;
FSharedFormulas: TStringList;
// FSharedFormulas: TStringList;
FWrittenByFPS: Boolean;
procedure ApplyCellFormatting(ACell: PCell; XfIndex: Integer);
procedure ApplyHyperlinks(AWorksheet: TsWorksheet);
@ -467,7 +467,7 @@ begin
// Set up the default palette in order to have the default color names correct.
Workbook.UseDefaultPalette;
FSharedFormulas := TStringList.Create;
// FSharedFormulas := TStringList.Create;
FSharedStrings := TStringList.Create;
FFillList := TFPList.Create;
FBorderList := TFPList.Create;
@ -493,7 +493,7 @@ begin
FHyperlinkList.Free;
FSharedStrings.Free;
FSharedFormulas.Free;
// FSharedFormulas.Free;
// FCellFormatList is destroyed by ancestor
inherited Destroy;
@ -677,6 +677,8 @@ var
sstIndex: Integer;
number: Double;
fmt: TsCellFormat;
rng: TsCellRange;
r,c: Cardinal;
begin
if ANode = nil then
exit;
@ -720,14 +722,21 @@ begin
begin
// Shared formula
s := GetAttrValue(datanode, 'ref');
if (s <> '') then // This is the shared formula base
if (s <> '') then // This is the shared formula range
begin
// Split shared formula into single-cell formulas
ParseCellRangeString(s, rng);
for r := rng.Row1 to rng.Row2 do
for c := rng.Col1 to rng.Col2 do
FWorksheet.CopyFormula(cell, r, c);
(*
s := GetAttrValue(datanode, 'si');
if s <> '' then
FSharedFormulas.AddObject(addr, {%H-}Pointer(PtrInt(StrToInt(s))));
FWorksheet.WriteFormula(cell, formulaStr);
cell^.SharedFormulaBase := cell;
//AWorksheet.WriteSharedFormula(s, formulaStr);
AWorksheet.WriteSharedFormula(s, formulaStr);
end else
begin
s := GetAttrValue(datanode, 'si');
@ -736,6 +745,7 @@ begin
s := FSharedFormulas[FSharedFormulas.IndexOfObject({%H-}Pointer(PtrInt(StrToInt(s))))];
cell^.SharedFormulaBase := FWorksheet.FindCell(s);
end;
*)
end;
end
else
@ -3279,9 +3289,6 @@ procedure TsSpreadOOXMLWriter.WriteFormula(AStream: TStream;
var
cellPosText: String;
lStyleIndex: Integer;
r, r1, r2: Cardinal;
c, c1, c2: Cardinal;
cell: PCell;
t, v: String;
begin
cellPosText := TsWorksheet.CellPosToText(ARow, ACol);
@ -3323,62 +3330,7 @@ begin
end;
end;
// Cell uses a shared formula
if Assigned(ACell^.SharedFormulaBase) then begin
// Cell is base of the shared formula, i.e. contains the shared formula
if (ACell = ACell^.SharedFormulaBase) then
begin
// Find range of cells using this shared formula
// The base of the shared formula is the left/top edge of the range
r1 := ACell^.Row;
r2 := r1;
r := r1 + 1;
while r <= FWorksheet.GetLastRowIndex do
begin
cell := FWorksheet.FindCell(r, ACell^.Col);
if (cell <> nil) and (cell^.SharedFormulaBase = ACell^.SharedFormulaBase) then
r2 := r
else
break;
inc(r);
end;
c1 := ACell^.Col;
c2 := c1;
c := c1 + 1;
while c <= FWorksheet.GetLastColIndex do
begin
cell := FWorksheet.FindCell(ACell^.Row, c);
if (cell <> nil) and (cell^.SharedFormulaBase = ACell^.SharedFormulaBase) then
c2 := c
else
break;
inc(c);
end;
AppendToStream(AStream, Format(
'<c r="%s" s="%d"%s>' +
'<f t="shared" ref="%s" si="%d">%s</f>' +
'%s' +
'</c>', [
CellPosText, lStyleIndex, t,
GetCellRangeString(ACell^.Row, ACell^.Col, r2, c2),
{%H-}PtrInt(ACell), // Use the cell pointer as ID of the shared formula
PrepareFormula(ACell^.FormulaValue),
v
]));
end else
// Cell uses the shared formula
AppendToStream(AStream, Format(
'<c r="%s" s="%d"%s>' +
'<f t="shared" si="%d" />' +
'%s' +
'</c>', [
CellPosText, lStyleIndex, t,
{%H-}PtrInt(ACell^.SharedFormulaBase), // ID of the shared formula
v
]));
end else begin
// "normal" formula
AppendToStream(AStream, Format(
AppendToStream(AStream, Format(
'<c r="%s" s="%d"%s>' +
'<f>%s</f>' +
'%s' +
@ -3386,8 +3338,7 @@ begin
CellPosText, lStyleIndex, t,
PrepareFormula(ACell^.FormulaValue),
v
]));
end;
]));
end;
{@@ ----------------------------------------------------------------------------