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

fpspreadsheet: Add writing of shared formulas for OOXML.

Browse Source 
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
Download Patch File Download Diff File Expand all files Collapse all files

30
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -678,7 +678,8 @@ type
{ Formulas }
procedure CalcFormulas;
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 }
procedure CopyCell(AFromRow, AFromCol, AToRow, AToCol: Cardinal; AFromWorksheet: TsWorksheet);
@ -2956,6 +2957,33 @@ begin
[GetCellString(ARow, ACol)]);
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.

30
components/fpspreadsheet/fpsutils.pas
View File

@ -64,7 +64,9 @@ function ParseIntervalString(const AStr: string;
out ADirection: TsSelectionDirection): Boolean;
function ParseCellRangeString(const AStr: string;
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;
out ACellRow, ACellCol: Cardinal; out AFlags: TsRelFlags): Boolean; overload;
function ParseCellString(const AStr: string;
@ -76,7 +78,8 @@ function ParseCellColString(const AStr: string;
function GetColString(AColIndex: Integer): 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;
@ -427,6 +430,26 @@ begin
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
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]
--> $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
Result := Format('%s%s%s%d:%s%s%s%d', [
RELCHAR[rfRelCol in AFlags], GetColString(ACol1),

4
components/fpspreadsheet/xlsbiff2.pas
View File

@ -790,7 +790,9 @@ end;
{ 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.
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;
out ARow, ACol: Cardinal);
begin

69
components/fpspreadsheet/xlscommon.pas
View File

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

55
components/fpspreadsheet/xlsxooxml.pas
View File

@ -2266,6 +2266,8 @@ end;
procedure TsSpreadOOXMLWriter.WriteWorksheet(AWorksheet: TsWorksheet);
begin
FWorksheet := AWorksheet;
FCurSheetNum := Length(FSSheets);
SetLength(FSSheets, FCurSheetNum + 1);
@ -2499,10 +2501,63 @@ procedure TsSpreadOOXMLWriter.WriteFormula(AStream: TStream;
var
cellPosText: String;
lStyleIndex: Integer;
r, c, r2, c2: Cardinal;
cell: PCell;
id: Cardinal;
begin
cellPosText := TsWorksheet.CellPosToText(ARow, ACol);
lStyleIndex := GetStyleIndex(ACell);
// 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
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>' +