fpspreadsheet: Add writing of shared formulas for OOXML.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3493 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-08-18 13:48:46 +00:00
parent f2338f41bb
commit 4bafc57020
5 changed files with 157 additions and 47 deletions

View File

@ -678,7 +678,8 @@ type
{ Formulas } { Formulas }
procedure CalcFormulas; procedure CalcFormulas;
function ReadRPNFormulaAsString(ACell: PCell): String; function ReadRPNFormulaAsString(ACell: PCell): String;
function UseSharedFormula(ARow, ACol: Cardinal; ASharedFormulaBase: PCell): PCell; function UseSharedFormula(ARow, ACol: Cardinal; ASharedFormulaBase: PCell): PCell; overload;
procedure UseSharedFormula(ACellRangeStr: String; ASharedFormulaBase: PCell); overload;
{ Data manipulation methods - For Cells } { Data manipulation methods - For Cells }
procedure CopyCell(AFromRow, AFromCol, AToRow, AToCol: Cardinal; AFromWorksheet: TsWorksheet); procedure CopyCell(AFromRow, AFromCol, AToRow, AToCol: Cardinal; AFromWorksheet: TsWorksheet);
@ -2956,6 +2957,33 @@ begin
[GetCellString(ARow, ACol)]); [GetCellString(ARow, ACol)]);
end; end;
{@@
Uses the formula defined in cell "ASharedFormulaBase" as a shared formula in
all cells of the given cell range.
@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 ASharedFormulaBase Cell containing the formula to be shared
}
procedure TsWorksheet.UseSharedFormula(ACellRangeStr: String; ASharedFormulaBase: PCell);
var
r, c, r1, c1, r2, c2: Cardinal;
ok: Boolean;
begin
if pos(':', ACellRangeStr) = 0 then
begin
ok := ParseCellString(ACellRangeStr, r1, c1);
r2 := r1;
c2 := c1;
end else
ok := ParseCellRangeString(ACellRangeStr, r1, c1, r2, c2);
if ok then
for r := r1 to r2 do
for c := c1 to c2 do
UseSharedFormula(r, c, ASharedFormulaBase);
end;
{@@ {@@
Writes UTF-8 encoded text to a cell. Writes UTF-8 encoded text to a cell.

View File

@ -64,7 +64,9 @@ function ParseIntervalString(const AStr: string;
out ADirection: TsSelectionDirection): Boolean; out ADirection: TsSelectionDirection): Boolean;
function ParseCellRangeString(const AStr: string; function ParseCellRangeString(const AStr: string;
out AFirstCellRow, AFirstCellCol, ALastCellRow, ALastCellCol: Cardinal; out AFirstCellRow, AFirstCellCol, ALastCellRow, ALastCellCol: Cardinal;
out AFlags: TsRelFlags): Boolean; out AFlags: TsRelFlags): Boolean; overload;
function ParseCellRangeString(const AStr: string;
out AFirstCellRow, AFirstCellCol, ALastCellRow, ALastCellCol: Cardinal): Boolean; overload;
function ParseCellString(const AStr: string; function ParseCellString(const AStr: string;
out ACellRow, ACellCol: Cardinal; out AFlags: TsRelFlags): Boolean; overload; out ACellRow, ACellCol: Cardinal; out AFlags: TsRelFlags): Boolean; overload;
function ParseCellString(const AStr: string; function ParseCellString(const AStr: string;
@ -76,7 +78,8 @@ function ParseCellColString(const AStr: string;
function GetColString(AColIndex: Integer): String; function GetColString(AColIndex: Integer): String;
function GetCellString(ARow,ACol: Cardinal; AFlags: TsRelFlags = [rfRelRow, rfRelCol]): String; function GetCellString(ARow,ACol: Cardinal; AFlags: TsRelFlags = [rfRelRow, rfRelCol]): String;
function GetCellRangeString(ARow1, ACol1, ARow2, ACol2: Cardinal; AFlags: TsRelFlags): String; function GetCellRangeString(ARow1, ACol1, ARow2, ACol2: Cardinal;
AFlags: TsRelFlags = [rfRelRow, rfRelCol, rfRelRow2, rfRelCol2]): String;
function GetErrorValueStr(AErrorValue: TsErrorValue): String; function GetErrorValueStr(AErrorValue: TsErrorValue): String;
@ -427,6 +430,26 @@ begin
end; end;
{@@
Parses strings like A5:C10 into a range selection information.
Information on relative/absolute cells is ignored.
@param AStr Cell range string, such as A5:C10
@param AFirstCellRow Row index of the top/left cell of the range (output)
@param AFirstCellCol Column index of the top/left cell of the range (output)
@param ALastCellRow Row index of the bottom/right cell of the range (output)
@param ALastCellCol Column index of the bottom/right cell of the range (output)
@return false if the string is not a valid cell range
}
function ParseCellRangeString(const AStr: string;
out AFirstCellRow, AFirstCellCol, ALastCellRow, ALastCellCol: Cardinal): Boolean;
var
flags: TsRelFlags;
begin
Result := ParseCellRangeString(AStr, AFirstCellRow, AFirstCellCol, ALastCellRow, ALastCellCol, flags);
end;
{@@ {@@
Parses a cell string, like 'A1' into zero-based column and row numbers Parses a cell string, like 'A1' into zero-based column and row numbers
Note that there can be several letters to address for more than 26 columns. Note that there can be several letters to address for more than 26 columns.
@ -647,7 +670,8 @@ end;
@example ARow1 = 0, ACol1 = 0, ARow = 2, ACol = 1, AFlags = [rfRelRow, rfRelRow2] @example ARow1 = 0, ACol1 = 0, ARow = 2, ACol = 1, AFlags = [rfRelRow, rfRelRow2]
--> $A1:$B3 --> $A1:$B3
} }
function GetCellRangeString(ARow1, ACol1, ARow2, ACol2: Cardinal; AFlags: TsRelFlags): String; function GetCellRangeString(ARow1, ACol1, ARow2, ACol2: Cardinal;
AFlags: TsRelFlags = [rfRelRow, rfRelCol, rfRelRow2, rfRelCol2]): String;
begin begin
Result := Format('%s%s%s%d:%s%s%s%d', [ Result := Format('%s%s%s%d:%s%s%s%d', [
RELCHAR[rfRelCol in AFlags], GetColString(ACol1), RELCHAR[rfRelCol in AFlags], GetColString(ACol1),

View File

@ -790,7 +790,9 @@ end;
{ Reads the cell coordiantes of the top/left cell of a range using a shared formula. { Reads the cell coordiantes of the top/left cell of a range using a shared formula.
This cell contains the rpn token sequence of the formula. This cell contains the rpn token sequence of the formula.
Is overridden because BIFF2 has 1 byte for column. } Is overridden because BIFF2 has 1 byte for column.
Code is not called for shared formulas (which are not supported by BIFF2), but
maybe for array formulas. }
procedure TsSpreadBIFF2Reader.ReadRPNSharedFormulaBase(AStream: TStream; procedure TsSpreadBIFF2Reader.ReadRPNSharedFormulaBase(AStream: TStream;
out ARow, ACol: Cardinal); out ARow, ACol: Cardinal);
begin begin

View File

@ -535,7 +535,8 @@ type
procedure WriteSelections(AStream: TStream; ASheet: TsWorksheet); procedure WriteSelections(AStream: TStream; ASheet: TsWorksheet);
// Writes out a shared formula // Writes out a shared formula
procedure WriteSharedFormula(AStream: TStream; ACell: PCell); virtual; procedure WriteSharedFormula(AStream: TStream; ACell: PCell); virtual;
procedure WriteSharedFormulaRange(AStream: TStream; const ARange: TRect); virtual; procedure WriteSharedFormulaRange(AStream: TStream;
AFirstRow, AFirstCol, ALastRow, ALastCol: Cardinal); virtual;
procedure WriteSheetPR(AStream: TStream); procedure WriteSheetPR(AStream: TStream);
procedure WriteStringRecord(AStream: TStream; AString: String); virtual; procedure WriteStringRecord(AStream: TStream; AString: String); virtual;
// Writes cell content received by workbook in OnNeedCellData event // Writes cell content received by workbook in OnNeedCellData event
@ -2882,8 +2883,7 @@ end;
the formulas in each cell. In BIFF2 WriteSharedFormula must not do anything. } the formulas in each cell. In BIFF2 WriteSharedFormula must not do anything. }
procedure TsSpreadBIFFWriter.WriteSharedFormula(AStream: TStream; ACell: PCell); procedure TsSpreadBIFFWriter.WriteSharedFormula(AStream: TStream; ACell: PCell);
var var
range: TRect; r, c, r1, r2, c1, c2: Cardinal;
node: TAVLTreeNode;
cell: PCell; cell: PCell;
RPNLength: word; RPNLength: word;
recordSizePos: Int64; recordSizePos: Int64;
@ -2892,32 +2892,29 @@ var
i: Integer; i: Integer;
begin begin
// Determine cell range covered by the shared formula in ACell. // Determine cell range covered by the shared formula in ACell.
range := Rect(-1, -1, -1, -1); // Find range of cells using this shared formula
node := FWorksheet.Cells.FindLowest; r1 := ACell^.Row; r2 := r1;
while Assigned(node) do begin c1 := ACell^.Col; c2 := c1;
cell := PCell(node.Data); r := r1;
if cell.SharedFormulaBase = ACell then begin c := c1;
// Nodes are ordered along rows --> the first cell met must be the left border of the range while c <= FWorksheet.GetLastColIndex do
if range.Left = -1 then begin
range.Left := cell.Col cell := FWorksheet.FindCell(r, c);
else if (cell <> nil) and (cell^.SharedFormulaBase = ACell^.SharedFormulaBase) then
if cell.Col < range.Left then begin c2 := c
FWorkbook.AddErrorMsg('Non-rectangular cell range covered by shared formula in cell %s', else
[GetCellString(ACell^.Row, ACell^.Col)]); break;
exit; inc(c);
end; end;
// The right border of the range must have the max col index c := c1;
if range.Right = -1 then while r <= FWorksheet.GetLastRowIndex do
range.Right := cell.Col begin
else if cell.Col > range.Right then cell := FWorksheet.FindCell(r, c);
range.Right := cell.Col; if (cell <> nil) and (cell^.SharedFormulaBase <> ACell^.SharedFormulaBase) then
// The first cell met must be the top border of the range r2 := r
if range.Top = -1 then else
range.Top := Cell.Row; break;
// dto. with bottom border inc(r);
range.Bottom := Cell.Row;
end;
node := FWorksheet.Cells.FindSuccessor(node);
end; end;
// Write BIFF record ID and size // Write BIFF record ID and size
@ -2927,13 +2924,13 @@ begin
startPos := AStream.Position; startPos := AStream.Position;
// Write borders of cell range covered by the formula // Write borders of cell range covered by the formula
WriteSharedFormulaRange(AStream, range); WriteSharedFormulaRange(AStream, r1, c1, r2, c2);
// Not used // Not used
AStream.WriteByte(0); AStream.WriteByte(0);
// Number of existing formula records // Number of existing formula records
AStream.WriteByte((range.Right-range.Left+1)*(range.Bottom-range.Top+1)); AStream.WriteByte((r2-r1+1) * (c2-c1+1));
// Copy the formula (we don't want to overwrite the cell formulas) // Copy the formula (we don't want to overwrite the cell formulas)
// and adjust relative references // and adjust relative references
@ -2956,16 +2953,20 @@ end;
Valid for BIFF5 and BIFF8 - BIFF8 writes 8-bit column index as well. Valid for BIFF5 and BIFF8 - BIFF8 writes 8-bit column index as well.
No need for BIFF2 which does not support shared formulas. } No need for BIFF2 which does not support shared formulas. }
procedure TsSpreadBIFFWriter.WriteSharedFormulaRange(AStream: TStream; procedure TsSpreadBIFFWriter.WriteSharedFormulaRange(AStream: TStream;
const ARange: TRect); AFirstRow, AFirstCol, ALastRow, ALastCol: Cardinal);
var
c: Word;
begin begin
// Index to first row // Index to first row
AStream.WriteWord(WordToLE(ARange.Top)); AStream.WriteWord(WordToLE(AFirstRow));
// Index to last row // Index to last row
AStream.WriteWord(WordToLE(ARange.Bottom)); AStream.WriteWord(WordToLE(ALastRow));
// Index to first column // Index to first column
AStream.WriteByte(Lo(ARange.Left)); c := Lo(AFirstCol);
AStream.WriteByte(Lo(c));
// Index to last rcolumn // Index to last rcolumn
AStream.WriteByte(Lo(ARange.Right)); c := Lo(ALastCol);
AStream.WriteByte(Lo(c));
end; end;

View File

@ -2266,6 +2266,8 @@ end;
procedure TsSpreadOOXMLWriter.WriteWorksheet(AWorksheet: TsWorksheet); procedure TsSpreadOOXMLWriter.WriteWorksheet(AWorksheet: TsWorksheet);
begin begin
FWorksheet := AWorksheet;
FCurSheetNum := Length(FSSheets); FCurSheetNum := Length(FSSheets);
SetLength(FSSheets, FCurSheetNum + 1); SetLength(FSSheets, FCurSheetNum + 1);
@ -2499,16 +2501,69 @@ procedure TsSpreadOOXMLWriter.WriteFormula(AStream: TStream;
var var
cellPosText: String; cellPosText: String;
lStyleIndex: Integer; lStyleIndex: Integer;
r, c, r2, c2: Cardinal;
cell: PCell;
id: Cardinal;
begin begin
cellPosText := TsWorksheet.CellPosToText(ARow, ACol); cellPosText := TsWorksheet.CellPosToText(ARow, ACol);
lStyleIndex := GetStyleIndex(ACell); lStyleIndex := GetStyleIndex(ACell);
AppendToStream(AStream, Format( // Cell uses a shared formula
'<c r="%s" s="%d">' + if Assigned(ACell^.SharedFormulaBase) then begin
'<f>%s</f>' + // Cell is base of the shared formula, i.e. contains the shared formula
'</c>', [ if (ACell = ACell^.SharedFormulaBase) then
CellPosText, lStyleIndex, begin
PrepareFormula(ACell^.FormulaValue) // Find range of cells using this shared formula
r2 := ACell^.Row;
c2 := ACell^.Col;
c := c2;
r := r2;
while c <= FWorksheet.GetLastColIndex do
begin
cell := FWorksheet.FindCell(r, c);
if (cell <> nil) and (cell^.SharedFormulaBase = ACell^.SharedFormulaBase) then
c2 := c
else
break;
inc(c);
end;
c := ACell^.Col;
while r <= FWorksheet.GetLastRowIndex do
begin
cell := FWorksheet.FindCell(r, c);
if (cell <> nil) and (cell^.SharedFormulaBase <> ACell^.SharedFormulaBase) then
r2 := r
else
break;
inc(r);
end;
AppendToStream(AStream, Format(
'<c r="%s" s="%d">' +
'<f t="shared" ref="%s" si="%d">%s</f>' +
'</c>', [
CellPosText, lStyleIndex,
GetCellRangeString(ACell^.Row, ACell^.Col, r2, c2),
PtrInt(ACell), // Use the cell pointer as ID of the shared formula
PrepareFormula(ACell^.FormulaValue)
]));
end else
// Cell uses the shared formula
AppendToStream(AStream, Format(
'<c r="%s" s="%d">' +
'<f t="shared" si="%d" />' +
'</c>', [
CellPosText, lStyleIndex,
PtrInt(ACell^.SharedFormulaBase) // ID of the shared formula
]));
end else
// "normal" formula
AppendToStream(AStream, Format(
'<c r="%s" s="%d">' +
'<f>%s</f>' +
'</c>', [
CellPosText, lStyleIndex,
PrepareFormula(ACell^.FormulaValue)
])); ]));
end; end;