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

fpspreadsheet: Initial implementation of writing shared formulas to BIFF files. BIFF2 working (using copies of master formula), BIFF8 faulty file.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3491 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-08-17 22:25:46 +00:00
parent 72ee090ef3
commit 87283fda5d
7 changed files with 426 additions and 356 deletions
Download Patch File Download Diff File Expand all files Collapse all files

25
components/fpspreadsheet/fpsopendocument.pas
View File

@ -173,7 +173,7 @@ type
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override;
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal;
const AFormula: TsFormula; ACell: PCell); override;
ACell: PCell); override;
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell); override;
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
@ -3571,15 +3571,13 @@ begin
end;
{ Writes a string formula }
procedure TsSpreadOpenDocWriter.WriteFormula(AStream: TStream; const ARow,
ACol: Cardinal; const AFormula: TsFormula; ACell: PCell);
ACol: Cardinal; ACell: PCell);
var
lStyle: String = '';
lIndex: Integer;
begin
Unused(AStream, ARow, ACol);
Unused(AFormula, ACell);
if ACell^.UsedFormattingFields <> [] then begin
lIndex := FindFormattingInList(ACell);
@ -3587,28 +3585,13 @@ begin
end else
lStyle := '';
// We are writing a very rudimentary formula here without result and result
// data type. Seems to work...
{ We are writing a very rudimentary formula here without result and result
data type. Seems to work... }
AppendToStream(AStream, Format(
'<table:table-cell table:formula="%s" %s>' +
'</table:table-cell>', [
ACell^.FormulaValue.FormulaStr, lStyle
]));
{
<table:table-cell table:formula="of:=[.A1]" office:value-type="time" office:time-value="PT982093H14M15.566999875S" calcext:value-type="time">
<text:p>982093:14:16</text:p>
</table:table-cell>
}
{ // The row should already be the correct one
FContent := FContent +
' <table:table-cell office:value-type="string">' + LineEnding +
' <text:p>' + AFormula.DoubleValue + '</text:p>' + LineEnding +
' </table:table-cell>' + LineEnding;
<table:table-cell table:formula="of:=[.A1]+[.B2]" office:value-type="float" office:value="1833">
<text:p>1833</text:p>
</table:table-cell>}
end;
{

131
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -677,8 +677,8 @@ type
{ Formulas }
procedure CalcFormulas;
function HasFormula(ACell: PCell): Boolean;
function ReadRPNFormulaAsString(ACell: PCell): String;
function UseSharedFormula(ARow, ACol: Cardinal; ASharedFormulaBase: PCell): PCell;
{ Data manipulation methods - For Cells }
procedure CopyCell(AFromRow, AFromCol, AToRow, AToCol: Cardinal; AFromWorksheet: TsWorksheet);
@ -1073,6 +1073,7 @@ type
procedure FixCellColors(ACell: PCell);
function FixColor(AColor: TsColor): TsColor; virtual;
procedure FixFormat(ACell: PCell); virtual;
procedure FixRelativeReferences(ACell: PCell; var AElement: TsFormulaElement);
procedure GetSheetDimensions(AWorksheet: TsWorksheet;
out AFirstRow, ALastRow, AFirstCol, ALastCol: Cardinal); virtual;
procedure ListAllFormattingStylesCallback(ACell: PCell; AStream: TStream);
@ -1088,10 +1089,12 @@ type
{@@ Abstract method for writing a date/time value to a cell. Must be overridden by descendent classes. }
procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); virtual; abstract;
{@@ Abstract method for writing a formula to a cell. Must be overridden by descendent classes. }
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal; const AFormula: TsFormula; ACell: PCell); virtual;
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal; ACell: PCell); virtual;
(*
{@@ Abstract method for writing an RPN formula to a cell. Must be overridden by descendent classes. }
procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal;
const AFormula: TsRPNFormula; ACell: PCell); virtual;
*)
{@@ Abstract method for writing a string to a cell. Must be overridden by descendent classes. }
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; const AValue: string; ACell: PCell); virtual; abstract;
{@@ Abstract method for writing a number value to a cell. Must be overridden by descendent classes. }
@ -1175,6 +1178,8 @@ function SameCellBorders(ACell1, ACell2: PCell): Boolean;
procedure InitCell(out ACell: TCell); overload;
procedure InitCell(ARow, ACol: Cardinal; out ACell: TCell); overload;
function HasFormula(ACell: PCell): Boolean;
implementation
@ -1605,6 +1610,7 @@ end;
{@@
Initalizes a new cell
@return New cell record
}
procedure InitCell(out ACell: TCell);
begin
@ -1615,6 +1621,14 @@ begin
FillChar(ACell, SizeOf(ACell), 0);
end;
{@@
Initalizes a new cell and presets the row and column fields of the cell record
to the parameters passesd to the procedure.
@param ARow Row index of the new cell
@param ACol Column index of the new cell
@return New cell record with row and column fields preset to passed parameters.
}
procedure InitCell(ARow, ACol: Cardinal; out ACell: TCell);
begin
InitCell(ACell);
@ -1622,6 +1636,19 @@ begin
ACell.Col := ACol;
end;
{@@
Returns TRUE if the cell contains a formula (direct or shared, does not matter).
}
function HasFormula(ACell: PCell): Boolean;
begin
Result := Assigned(ACell) and (
(ACell^.SharedFormulaBase <> nil) or
(Length(ACell^.RPNFormulaValue) > 0) or
(Length(ACell^.FormulaValue.FormulaStr) > 0)
);
end;
{ TsWorksheet }
@ -2445,18 +2472,6 @@ begin
Result := GetLastRowIndex;
end;
{@@
Returns TRUE if the cell contains a formula (direct or shared, does not matter).
}
function TsWorksheet.HasFormula(ACell: PCell): Boolean;
begin
Result := Assigned(ACell) and (
(ACell^.SharedFormulaBase <> nil) or
(Length(ACell^.RPNFormulaValue) > 0) or
(Length(ACell^.FormulaValue.FormulaStr) > 0)
);
end;
{@@
Reads the contents of a cell and returns an user readable text
representing the contents of the cell.
@ -2915,6 +2930,32 @@ begin
FLastRowIndex := GetLastRowIndex(true);
end;
{@@
Creates a link to a shared formula
@param ARow Row of the cell
@param ACol Column index of the cell
@param ASharedFormulaBase Cell containing the shared formula token array
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 ((Length(Result^.RPNFormulaValue) > 0) or (Length(Result^.FormulaValue.FormulaStr) > 0))
and ((ASharedFormulaBase.Row <> ARow) or (ASharedFormulaBase.Col <> ACol))
then
raise Exception.CreateFmt('Cell %s uses a shared formula, but contains an own formula.',
[GetCellString(ARow, ACol)]);
end;
{@@
Writes UTF-8 encoded text to a cell.
@ -6664,6 +6705,44 @@ begin
// to be overridden
end;
{@@
Adjusts relative references in the formula element to the position of cell
and the shared formula base. }
procedure TsCustomSpreadWriter.FixRelativeReferences(ACell: PCell;
var AElement: TsFormulaElement);
var
rowOffset: Integer;
colOffset: Integer;
begin
if (ACell = nil) or (ACell^.SharedFormulaBase = nil) then
exit;
case AElement.ElementKind of
fekCell:
begin
rowOffset := AElement.Row - ACell^.SharedFormulaBase^.Row;
colOffset := AElement.Col - ACell^.SharedFormulaBase^.Col;
if (rfRelRow in AElement.RelFlags) then
AElement.Row := Integer(ACell^.Row) + rowOffset;
if (rfRelCol in AElement.RelFlags) then
AElement.Col := Integer(ACell^.Col) + colOffset;
end;
fekCellRange:
begin
rowOffset := AElement.Row - ACell^.SharedFormulaBase^.Row;
colOffset := AElement.Col - ACell^.SharedFormulaBase^.Col;
if (rfRelRow in AElement.RelFlags) then
AElement.Row := Integer(ACell^.Row) + rowOffset;
if (rfRelCol in AElement.RelFlags) then
AElement.Col := Integer(ACell^.Col) + colOffset;
if (rfRelRow2 in AElement.RelFlags) then
AElement.Row2 := Integer(ACell^.Row) + rowOffset;
if (rfRelCol2 in AElement.RelFlags) then
AElement.Col2 := Integer(ACell^.Col) + colOffset;
end;
end;
end;
{@@
Determines the size of the worksheet to be written. VirtualMode is respected.
Is called when the writer needs the size for output. Column and row count
@ -6885,6 +6964,10 @@ end;
}
procedure TsCustomSpreadWriter.WriteCellCallback(ACell: PCell; AStream: TStream);
begin
if HasFormula(ACell) then
WriteFormula(AStream, ACell^.Row, ACell^.Col, ACell)
else
{
if Length(ACell^.RPNFormulaValue) > 0 then
// A non-calculated RPN formula has ContentType cctUTF8Formula, but after
// calculation it has the content type of the result. Both cases have in
@ -6892,12 +6975,13 @@ begin
// be written to file.
WriteRPNFormula(AStream, ACell^.Row, ACell^.Col, ACell^.RPNFormulaValue, ACell)
else
}
case ACell.ContentType of
cctEmpty : WriteBlank(AStream, ACell^.Row, ACell^.Col, ACell);
cctDateTime : WriteDateTime(AStream, ACell^.Row, ACell^.Col, ACell^.DateTimeValue, ACell);
cctNumber : WriteNumber(AStream, ACell^.Row, ACell^.Col, ACell^.NumberValue, ACell);
cctUTF8String : WriteLabel(AStream, ACell^.Row, ACell^.Col, ACell^.UTF8StringValue, ACell);
cctFormula : WriteFormula(AStream, ACell^.Row, ACell^.Col, ACell^.FormulaValue, ACell);
// cctFormula : WriteFormula(AStream, ACell^.Row, ACell^.Col, ACell^.FormulaValue, ACell);
end;
end;
@ -6998,24 +7082,22 @@ begin
end;
{@@
Basic method which is called when writing a string formula to a stream.
Basic method which is called when writing a formula to a stream. The formula
is already stored in the cell fields.
Present implementation does nothing. Needs to be overridden by descendants.
@param AStream Stream to be written
@param ARow Row index of the cell containing the formula
@param ACol Column index of the cell containing the formula
@param AFormula String formula given as an Excel-like string, such as '=A1+B1'
@param ACell Pointer to the cell containing the formula and being written
to the stream
}
procedure TsCustomSpreadWriter.WriteFormula(AStream: TStream; const ARow,
ACol: Cardinal; const AFormula: TsFormula; ACell: PCell);
procedure TsCustomSpreadWriter.WriteFormula(AStream: TStream;
const ARow, ACol: Cardinal; ACell: PCell);
begin
Unused(AStream, ARow, ACol);
Unused(AFormula, ACell);
// Silently dump the formula; child classes should implement their own support
end;
(*
{@@
Basic method which is called when writing an RPN formula to a stream.
Present implementation does nothing. Needs to be overridden by descendants.
@ -7036,6 +7118,7 @@ begin
Unused(AFormula, ACell);
// Silently dump the formula; child classes should implement their own support
end;
*)
{******************************************************************************}
@ -7216,8 +7299,8 @@ function RPNCellOffset(ARowOffset, AColOffset: Integer; AFlags: TsRelFlags;
begin
Result := NewRPNItem;
Result^.FE.ElementKind := fekCellOffset;
Result^.FE.Row := ARowOffset;
Result^.FE.Col := AColOffset;
Result^.FE.Row := Cardinal(ARowOffset);
Result^.FE.Col := Cardinal(AColOffset);
Result^.FE.RelFlags := AFlags;
Result^.Next := ANext;
end;

50
components/fpspreadsheet/xlsbiff2.pas
View File

@ -125,7 +125,10 @@ 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 WriteStringRecord(AStream: TStream; AString: String); override;
procedure WriteWindow1(AStream: TStream); override;
procedure WriteWindow2(AStream: TStream; ASheet: TsWorksheet);
@ -1566,7 +1569,7 @@ procedure TsSpreadBIFF2Writer.WriteRPNFormula(AStream: TStream;
const ARow, ACol: Cardinal; const AFormula: TsRPNFormula; ACell: PCell);
var
RPNLength: Word;
RecordSizePos, FinalPos: Cardinal;
RecordSizePos, StartPos, FinalPos: Cardinal;
xf: Word;
begin
if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then
@ -1581,7 +1584,8 @@ begin
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_FORMULA));
RecordSizePos := AStream.Position;
AStream.WriteWord(WordToLE(17 + RPNLength));
AStream.WriteWord(0); // We don't know the record size yet. It will be replaced at end.
StartPos := AStream.Position;
{ Row and column }
AStream.WriteWord(WordToLE(ARow));
@ -1598,7 +1602,15 @@ begin
AStream.WriteByte(1);
{ Formula data (RPN token array) }
WriteRPNTokenArray(AStream, AFormula, RPNLength);
if ACell^.SharedFormulaBase <> nil then
WriteRPNSharedFormulaLink(AStream, ACell, RPNLength)
else
WriteRPNTokenArray(AStream, AFormula, true, RPNLength);
(*
{ Formula data (RPN token array) }
WriteRPNTokenArray(AStream, AFormula, true, RPNLength);
*)
{ Finally write sizes after we know them }
FinalPos := AStream.Position;
@ -1620,6 +1632,31 @@ begin
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
the writer must copy the shared formula and adapt the relative
references. }
procedure TsSpreadBIFF2Writer.WriteRPNSharedFormulaLink(AStream: TStream;
ACell: PCell; var RPNLength: Word);
var
i: Integer;
formula: TsRPNFormula;
begin
SetLength(formula, Length(ACell^.SharedFormulaBase^.RPNFormulaValue));
for i:=0 to Length(formula)-1 do begin
// Copy formula
formula[i] := ACell^.SharedFormulaBase^.RPNFormulaValue[i];
// Adapt relative cell references
FixRelativeReferences(ACell, formula[i]);
end;
// Write adapted copy of shared formula to stream.
WriteRPNTokenArray(AStream, formula, true, RPNLength);
// Clean up
SetLength(formula, 0);
end;
{ Writes the size of the RPN token array. Called from WriteRPNFormula.
Overrides xlscommon. }
procedure TsSpreadBIFF2Writer.WriteRPNTokenArraySize(AStream: TStream;
@ -1628,6 +1665,13 @@ begin
AStream.WriteByte(Lo(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
anything. }
procedure TsSpreadBIFF2Writer.WriteSharedFormula(AStream: TStream; ACell: PCell);
begin
end;
{ Writes an Excel 2 STRING record which immediately follows a FORMULA record
when the formula result is a string. }
procedure TsSpreadBIFF2Writer.WriteStringRecord(AStream: TStream;

190
components/fpspreadsheet/xlsbiff5.pas
View File

@ -119,10 +119,7 @@ type
procedure WriteIndex(AStream: TStream);
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell); override;
{
procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal;
const AFormula: TsRPNFormula; ACell: PCell); override;
}
procedure WriteSharedFormulaRange(AStream: TStream; const ARange: TRect); override;
procedure WriteStringRecord(AStream: TStream; AString: String); override;
procedure WriteStyle(AStream: TStream);
procedure WriteWindow2(AStream: TStream; ASheet: TsWorksheet);
@ -724,181 +721,8 @@ begin
{ Clean up }
SetLength(buf, 0);
(*
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_FORMAT));
AStream.WriteWord(WordToLE(2 + 1 + len * SizeOf(AnsiChar)));
{ Format index }
AStream.WriteWord(WordToLE(AFormatData.Index));
{ Format string }
AStream.WriteByte(len); // AnsiString, char count in 1 byte
AStream.WriteBuffer(s[1], len * SizeOf(AnsiChar)); // String data
*)
end;
(*
{*******************************************************************
* TsSpreadBIFF5Writer.WriteRPNFormula ()
*
* DESCRIPTION: Writes an Excel 5 FORMULA record
*
* To input a formula to this method, first convert it
* to RPN, and then list all it's members in the
* AFormula array
*
*******************************************************************}
procedure TsSpreadBIFF5Writer.WriteRPNFormula(AStream: TStream;
const ARow, ACol: Cardinal; const AFormula: TsRPNFormula; ACell: PCell);
var
FormulaResult: double;
i: Integer;
RPNLength: Word;
TokenArraySizePos, RecordSizePos, FinalPos: Int64;
FormulaKind: Word;
ExtraInfo: Word;
r: Cardinal;
len: Integer;
s: ansistring;
begin
RPNLength := 0;
FormulaResult := 0.0;
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_FORMULA));
RecordSizePos := AStream.Position;
AStream.WriteWord(WordToLE(22 + RPNLength));
{ BIFF Record data }
AStream.WriteWord(WordToLE(ARow));
AStream.WriteWord(WordToLE(ACol));
{ Index to XF Record }
WriteXFIndex(AStream, ACell);
{ Result of the formula in IEEE 754 floating-point value }
AStream.WriteBuffer(FormulaResult, 8);
{ Options flags }
AStream.WriteWord(WordToLE(MASK_FORMULA_RECALCULATE_ALWAYS));
{ Not used }
AStream.WriteDWord(0);
{ Formula }
{ The size of the token array is written later,
because it's necessary to calculate if first,
and this is done at the same time it is written }
TokenArraySizePos := AStream.Position;
AStream.WriteWord(RPNLength);
{ Formula data (RPN token array) }
for i := 0 to Length(AFormula) - 1 do
begin
{ Token identifier }
FormulaKind := FormulaElementKindToExcelTokenID(AFormula[i].ElementKind, ExtraInfo);
AStream.WriteByte(FormulaKind);
Inc(RPNLength);
{ Additional data }
case FormulaKind of
{ binary operation tokens }
INT_EXCEL_TOKEN_TADD, INT_EXCEL_TOKEN_TSUB, INT_EXCEL_TOKEN_TMUL,
INT_EXCEL_TOKEN_TDIV, INT_EXCEL_TOKEN_TPOWER: begin end;
INT_EXCEL_TOKEN_TNUM:
begin
AStream.WriteBuffer(AFormula[i].DoubleValue, 8);
Inc(RPNLength, 8);
end;
INT_EXCEL_TOKEN_TSTR:
begin
s := ansistring(AFormula[i].StringValue);
len := Length(s);
AStream.WriteByte(len);
AStream.WriteBuffer(s[1], len);
Inc(RPNLength, len + 1);
end;
INT_EXCEL_TOKEN_TBOOL: { fekBool }
begin
AStream.WriteByte(ord(AFormula[i].DoubleValue <> 0.0));
inc(RPNLength, 1);
end;
INT_EXCEL_TOKEN_TREFR, INT_EXCEL_TOKEN_TREFV, INT_EXCEL_TOKEN_TREFA:
begin
r := AFormula[i].Row and MASK_EXCEL_ROW;
if (rfRelRow in AFormula[i].RelFlags) then r := r or MASK_EXCEL_RELATIVE_ROW;
if (rfRelCol in AFormula[i].RelFlags) then r := r or MASK_EXCEL_RELATIVE_COL;
AStream.WriteWord(r);
AStream.WriteByte(AFormula[i].Col);
Inc(RPNLength, 3);
end;
INT_EXCEL_TOKEN_TAREA_R: { fekCellRange }
begin
r := AFormula[i].Row and MASK_EXCEL_ROW;
if (rfRelRow in AFormula[i].RelFlags) then r := r or MASK_EXCEL_RELATIVE_ROW;
if (rfRelCol in AFormula[i].RelFlags) then r := r or MASK_EXCEL_RELATIVE_COL;
AStream.WriteWord(WordToLE(r));
r := AFormula[i].Row2 and MASK_EXCEL_ROW;
if (rfRelRow2 in AFormula[i].RelFlags) then r := r or MASK_EXCEL_RELATIVE_ROW;
if (rfRelCol2 in AFormula[i].RelFlags) then r := r or MASK_EXCEL_RELATIVE_COL;
AStream.WriteWord(WordToLE(r));
AStream.WriteByte(AFormula[i].Col);
AStream.WriteByte(AFormula[i].Col2);
Inc(RPNLength, 6);
end;
{
sOffset Size Contents
0 1 22H (tFuncVarR), 42H (tFuncVarV), 62H (tFuncVarA)
1 1 Number of arguments
Bit Mask Contents
6-0 7FH Number of arguments
7 80H 1 = User prompt for macro commands (shown by a question mark
following the command name)
2 2 Index to a sheet function
Bit Mask Contents
14-0 7FFFH Index to a built-in sheet function (➜3.11) or a macro command
15 8000H 0 = Built-in function; 1 = Macro command
}
// Functions
INT_EXCEL_TOKEN_FUNC_R, INT_EXCEL_TOKEN_FUNC_V, INT_EXCEL_TOKEN_FUNC_A:
begin
AStream.WriteWord(WordToLE(ExtraInfo));
Inc(RPNLength, 2);
end;
INT_EXCEL_TOKEN_FUNCVAR_V:
begin
AStream.WriteByte(AFormula[i].ParamsNum);
AStream.WriteWord(WordToLE(ExtraInfo));
Inc(RPNLength, 3);
end;
end;
end;
{ Write sizes in the end, after we known them }
FinalPos := AStream.Position;
AStream.position := TokenArraySizePos;
AStream.WriteByte(RPNLength);
AStream.Position := RecordSizePos;
AStream.WriteWord(WordToLE(22 + RPNLength));
AStream.position := FinalPos;
end;
*)
{*******************************************************************
* TsSpreadBIFF5Writer.WriteIndex ()
*
@ -1014,6 +838,18 @@ begin
SetLength(buf, 0);
end;
{ Writes the borders of the cell range covered by a shared formula.
Needs to be overridden to write the column data (2 bytes in case of BIFF8). }
procedure TsSpreadBIFF5Writer.WriteSharedFormulaRange(AStream: TStream;
const ARange: TRect);
begin
inherited WriteSharedFormulaRange(AStream, ARange);
// Index to first column
AStream.WriteByte(ARange.Left);
// Index to last rcolumn
AStream.WriteByte(ARange.Right);
end;
{ Writes an Excel 5 STRING record which immediately follows a FORMULA record
when the formula result is a string.
BIFF5 writes a byte-string, but uses a 16-bit length here! }

134
components/fpspreadsheet/xlsbiff8.pas
View File

@ -118,15 +118,16 @@ type
procedure WriteFonts(AStream: TStream);
procedure WriteFormat(AStream: TStream; AFormatData: TsNumFormatData;
AListIndex: Integer); override;
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal;
const AFormula: TsFormula; ACell: PCell); override;
procedure WriteIndex(AStream: TStream);
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell); override;
function WriteRPNCellAddress(AStream: TStream; ARow, ACol: Cardinal;
AFlags: TsRelFlags): word; override;
function WriteRPNCellOffset(AStream: TStream; ARowOffset, AColOffset: Integer;
AFlags: TsRelFlags): Word; override;
function WriteRPNCellRangeAddress(AStream: TStream; ARow1, ACol1, ARow2, ACol2: Cardinal;
AFlags: TsRelFlags): Word; override;
procedure WriteSharedFormulaRange(AStream: TStream; const ARange: TRect); override;
function WriteString_8bitLen(AStream: TStream; AString: String): Integer; override;
procedure WriteStringRecord(AStream: TStream; AString: string); override;
procedure WriteStyle(AStream: TStream);
@ -465,6 +466,7 @@ begin
for i := 0 to Workbook.GetWorksheetCount - 1 do
begin
sheet := Workbook.GetWorksheetByIndex(i);
FWorksheet := sheet;
{ First goes back and writes the position of the BOF of the
sheet on the respective BOUNDSHEET record }
@ -778,103 +780,6 @@ begin
*)
end;
{*******************************************************************
* TsSpreadBIFF8Writer.WriteFormula ()
*
* DESCRIPTION: Writes an Excel 5 FORMULA record
*
* To input a formula to this method, first convert it
* to RPN, and then list all it's members in the
* AFormula array
*
*******************************************************************}
procedure TsSpreadBIFF8Writer.WriteFormula(AStream: TStream; const ARow,
ACol: Cardinal; const AFormula: TsFormula; ACell: PCell);
{var
FormulaResult: double;
i: Integer;
RPNLength: Word;
TokenArraySizePos, RecordSizePos, FinalPos: Int64;}
begin
Unused(AStream);
Unused(ARow, ACol);
Unused(AFormula, ACell);
(*
if (ARow >= FLimitations.MaxRows) or (ACol >= FLimitations.MaxCols) then
exit;
RPNLength := 0;
FormulaResult := 0.0;
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_FORMULA));
RecordSizePos := AStream.Position;
AStream.WriteWord(WordToLE(22 + RPNLength));
{ BIFF Record data }
AStream.WriteWord(WordToLE(ARow));
AStream.WriteWord(WordToLE(ACol));
{ Index to XF Record }
AStream.WriteWord($0000);
{ Result of the formula in IEE 754 floating-point value }
AStream.WriteBuffer(FormulaResult, 8);
{ Options flags }
AStream.WriteWord(WordToLE(MASK_FORMULA_RECALCULATE_ALWAYS));
{ Not used }
AStream.WriteDWord(0);
{ Formula }
{ The size of the token array is written later,
because it's necessary to calculate if first,
and this is done at the same time it is written }
TokenArraySizePos := AStream.Position;
AStream.WriteWord(RPNLength);
{ Formula data (RPN token array) }
for i := 0 to Length(AFormula) - 1 do
begin
{ Token identifier }
AStream.WriteByte(AFormula[i].TokenID);
Inc(RPNLength);
{ Additional data }
case AFormula[i].TokenID of
{ binary operation tokens }
INT_EXCEL_TOKEN_TADD, INT_EXCEL_TOKEN_TSUB, INT_EXCEL_TOKEN_TMUL,
INT_EXCEL_TOKEN_TDIV, INT_EXCEL_TOKEN_TPOWER: begin end;
INT_EXCEL_TOKEN_TNUM:
begin
AStream.WriteBuffer(AFormula[i].DoubleValue, 8);
Inc(RPNLength, 8);
end;
INT_EXCEL_TOKEN_TREFR, INT_EXCEL_TOKEN_TREFV, INT_EXCEL_TOKEN_TREFA:
begin
AStream.WriteWord(AFormula[i].Row and MASK_EXCEL_ROW);
AStream.WriteByte(AFormula[i].Col);
Inc(RPNLength, 3);
end;
end;
end;
{ Write sizes in the end, after we known them }
FinalPos := AStream.Position;
AStream.position := TokenArraySizePos;
AStream.WriteByte(RPNLength);
AStream.Position := RecordSizePos;
AStream.WriteWord(WordToLE(22 + RPNLength));
AStream.position := FinalPos;*)
end;
{ Writes the address of a cell as used in an RPN formula and returns the
number of bytes written. }
function TsSpreadBIFF8Writer.WriteRPNCellAddress(AStream: TStream;
@ -890,6 +795,25 @@ begin
Result := 4;
end;
{ Writes row and column offset (unsigned integers!)
Valid for BIFF2-BIFF5. }
function TsSpreadBIFF8Writer.WriteRPNCellOffset(AStream: TStream;
ARowOffset, AColOffset: Integer; AFlags: TsRelFlags): Word;
var
c: Word;
begin
// row address
AStream.WriteWord(WordToLE(Word(Lo(ARowOffset))));
// Encoded column address
c := word(Lo(AColOffset)) and MASK_EXCEL_COL_BITS_BIFF8;
if (rfRelRow in AFlags) then c := c or MASK_EXCEL_RELATIVE_ROW_BIFF8;
if (rfRelCol in AFlags) then c := c or MASK_EXCEL_RELATIVE_COL_BIFF8;
AStream.WriteWord(WordToLE(c));
Result := 4;
end;
{ Writes the address of a cell range as used in an RPN formula and returns the
count of bytes written. }
function TsSpreadBIFF8Writer.WriteRPNCellRangeAddress(AStream: TStream;
@ -913,6 +837,18 @@ begin
Result := 8;
end;
{ Writes the borders of the cell range covered by a shared formula.
Needs to be overridden to write the column data (2 bytes in case of BIFF8). }
procedure TsSpreadBIFF8Writer.WriteSharedFormulaRange(AStream: TStream;
const ARange: TRect);
begin
inherited WriteSharedFormulaRange(AStream, ARange);
// Index to first column
AStream.WriteWord(WordToLE(ARange.Left));
// Index to last rcolumn
AStream.WriteWord(WordToLE(ARange.Right));
end;
{ Helper function for writing a string with 8-bit length. Overridden version
for BIFF8. Called for writing rpn formula string tokens.
Returns the count of bytes written}

230
components/fpspreadsheet/xlscommon.pas
View File

@ -497,6 +497,9 @@ type
AListIndex: Integer); virtual;
// Writes out all FORMAT records
procedure WriteFormats(AStream: TStream);
// Writes out a FORMULA record; formula is stored in cell already
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override;
// Writes out a floating point NUMBER record
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: Double; ACell: PCell); override;
@ -506,25 +509,33 @@ type
// Writes out a PANE record
procedure WritePane(AStream: TStream; ASheet: TsWorksheet; IsBiff58: Boolean;
out ActivePane: Byte);
function WriteRPNCellAddress(AStream: TStream; ARow, ACol: Cardinal;
AFlags: TsRelFlags): Word; virtual;
function WriteRPNCellRangeAddress(AStream: TStream; ARow1, ACol1, ARow2, ACol2: Cardinal;
AFlags: TsRelFlags): Word; virtual;
procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal;
const AFormula: TsRPNFormula; ACell: PCell); override;
function WriteRPNFunc(AStream: TStream; AIdentifier: Word): Word; virtual;
procedure WriteRPNResult(AStream: TStream; ACell: PCell);
procedure WriteRPNTokenArray(AStream: TStream; const AFormula: TsRPNFormula;
var RPNLength: Word);
procedure WriteRPNTokenArraySize(AStream: TStream; ASize: Word); virtual;
// Writes out a ROW record
procedure WriteRow(AStream: TStream; ASheet: TsWorksheet;
ARowIndex, AFirstColIndex, ALastColIndex: Cardinal; ARow: PRow); virtual;
// Write all ROW records for a sheet
procedure WriteRows(AStream: TStream; ASheet: TsWorksheet);
function WriteRPNCellAddress(AStream: TStream; ARow, ACol: Cardinal;
AFlags: TsRelFlags): Word; virtual;
function WriteRPNCellOffset(AStream: TStream; ARowOffset, AColOffset: Integer;
AFlags: TsRelFlags): Word; virtual;
function WriteRPNCellRangeAddress(AStream: TStream; ARow1, ACol1, ARow2, ACol2: Cardinal;
AFlags: TsRelFlags): Word; virtual;
procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal;
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; const AFormula: TsRPNFormula;
WriteTokenArraySize: Boolean; var RPNLength: Word);
procedure WriteRPNTokenArraySize(AStream: TStream; ASize: Word); virtual;
// 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; const ARange: TRect); virtual;
procedure WriteSheetPR(AStream: TStream);
procedure WriteStringRecord(AStream: TStream; AString: String); virtual;
// Writes cell content received by workbook in OnNeedCellData event
@ -543,7 +554,7 @@ type
implementation
uses
Math, Variants, fpsNumFormatParser;
AVL_Tree, Math, Variants, fpsNumFormatParser;
{ Helper table for rpn formulas:
Assignment of FormulaElementKinds (fekXXXX) to EXCEL_TOKEN IDs. }
@ -2160,6 +2171,16 @@ begin
end;
end;
{ Writes an Excel FORMULA record.
Note: The formula is already stored in the cell.
Since BIFF files contain RPN formulas the method calls WriteRPNFormula.
}
procedure TsSpreadBIFFWriter.WriteFormula(AStream: TStream;
const ARow, ACol: Cardinal; ACell: PCell);
begin
WriteRPNFormula(AStream, ARow, ACol, ACell^.RPNFormulaValue, ACell);
end;
{ Writes a 64-bit floating point NUMBER record.
Valid for BIFF5 and BIFF8 (BIFF2 has a different record structure.). }
procedure TsSpreadBIFFWriter.WriteNumber(AStream: TStream;
@ -2350,14 +2371,36 @@ function TsSpreadBIFFWriter.WriteRPNCellAddress(AStream: TStream;
var
r: Cardinal; // row index containing encoded relativ/absolute address info
begin
// Encoded row address
r := ARow and MASK_EXCEL_ROW;
if (rfRelRow in AFlags) then r := r or MASK_EXCEL_RELATIVE_ROW;
if (rfRelCol in AFlags) then r := r or MASK_EXCEL_RELATIVE_COL;
AStream.WriteWord(r);
AStream.WriteWord(WordToLE(r));
// Column address
AStream.WriteByte(ACol);
// Number of bytes written
Result := 3;
end;
{ Writes row and column offset (unsigned integers!)
Valid for BIFF2-BIFF5. }
function TsSpreadBIFFWriter.WriteRPNCellOffset(AStream: TStream;
ARowOffset, AColOffset: Integer; AFlags: TsRelFlags): Word;
var
r: Word;
c: Byte;
begin
// Encoded row address
r := ARowOffset and MASK_EXCEL_ROW;
if (rfRelRow in AFlags) then r := r + MASK_EXCEL_RELATIVE_ROW;
if (rfRelCol in AFlags) then r := r + MASK_EXCEL_RELATIVE_COL;
AStream.WriteWord(WordToLE(r));
// Column address
c := Lo(AColOffset);
AStream.WriteByte(c);
// Number of bytes written
Result := 3;
end;
{ Writes the address of a cell range as used in an RPN formula and returns the
count of bytes written.
@ -2392,15 +2435,19 @@ procedure TsSpreadBIFFWriter.WriteRPNFormula(AStream: TStream;
const ARow, ACol: Cardinal; const AFormula: TsRPNFormula; ACell: PCell);
var
RPNLength: Word = 0;
RecordSizePos, FinalPos: Int64;
RecordSizePos, StartPos, FinalPos: Int64;
begin
if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then
exit;
if not ((Length(AFormula) > 0) or (ACell^.SharedFormulaBase <> nil)) then
exit;
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_FORMULA));
RecordSizePos := AStream.Position;
AStream.WriteWord(0); // This is the record size which is not yet known here
StartPos := AStream.Position;
{ BIFF Record data }
AStream.WriteWord(WordToLE(ARow));
@ -2420,15 +2467,28 @@ begin
AStream.WriteDWord(0);
{ Formula data (RPN token array) }
WriteRPNTokenArray(AStream, AFormula, RPNLength);
if ACell^.SharedFormulaBase <> nil then
WriteRPNSharedFormulaLink(AStream, ACell, RPNLength)
else
WriteRPNTokenArray(AStream, AFormula, true, RPNLength);
{ Write sizes in the end, after we known them }
FinalPos := AStream.Position;
AStream.Position := RecordSizePos;
AStream.WriteWord(WordToLE(22 + RPNLength));
AStream.WriteWord(WordToLE(FinalPos - StartPos));
// AStream.WriteWord(WordToLE(22 + RPNLength));
AStream.Position := FinalPos;
{ Write following STRING record if formula result is a non-empty string }
{ 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}
if (ACell^.SharedFormulaBase <> nil) and
(ARow = ACell^.SharedFormulaBase.Row) and
(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);
end;
@ -2493,9 +2553,34 @@ begin
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.
This implementation is valid for BIFF5 and BIFF8. BIFF2 does not support
shared formulas; the BIFF2 writer must copy the formula found in the
SharedFormulaBase field of the cell and adjust the relative references. }
procedure TsSpreadBIFFWriter.WriteRPNSharedFormulaLink(AStream: TStream;
ACell: PCell; var RPNLength: Word);
type
TSharedFormulaLinkRecord = record
FormulaSize: Word; // Size of token array
Token: Byte; // 1st (and only) token of the rpn formula array
Row: Word; // row of cell containing the shared formula
Col: Word; // column of cell containing the shared formula
end;
var
rec: TSharedFormulaLinkRecord;
begin
rec.FormulaSize := WordToLE(5);
rec.Token := INT_EXCEL_TOKEN_TEXP; // Marks the cell for using a shared formula
rec.Row := WordToLE(ACell^.SharedFormulaBase.Row);
rec.Col := WordToLE(ACell^.SharedFormulaBase.Col);
AStream.WriteBuffer(rec, SizeOf(rec));
RPNLength := SizeOf(rec);
end;
{ Writes the token array of the given RPN formula and returns its size }
procedure TsSpreadBIFFWriter.WriteRPNTokenArray(AStream: TStream;
const AFormula: TsRPNFormula; var RPNLength: Word);
const AFormula: TsRPNFormula; WriteTokenArraySize: Boolean; var RPNLength: Word);
var
i: Integer;
tokenID, secondaryID: Word;
@ -2505,10 +2590,12 @@ var
begin
RPNLength := 0;
if WriteTokenArraySize then begin
{ The size of the token array is written later, because it's necessary to
calculate it first, and this is done at the same time it is written }
TokenArraySizePos := AStream.Position;
WriteRPNTokenArraySize(AStream, 0);
end;
{ Formula data (RPN token array) }
for i := 0 to Length(AFormula) - 1 do begin
@ -2521,9 +2608,8 @@ begin
{ Token data }
case tokenID of
{ Operand Tokens }
INT_EXCEL_TOKEN_TREFR,
INT_EXCEL_TOKEN_TREFV,
INT_EXCEL_TOKEN_TREFA: { fekCell }
INT_EXCEL_TOKEN_TREFR, INT_EXCEL_TOKEN_TREFV, INT_EXCEL_TOKEN_TREFA: { fekCell }
// INT_EXCEL_TOKEN_TREFN_R, INT_EXCEL_TOKEN_TREFN_V, INT_EXCEL_TOKEN_TREFN_A: { fekCellOffset}
begin
n := WriteRPNCellAddress(
AStream,
@ -2544,6 +2630,18 @@ begin
inc(RPNLength, n);
end;
INT_EXCEL_TOKEN_TREFN_R,
INT_EXCEL_TOKEN_TREFN_V,
INT_EXCEL_TOKEN_TREFN_A: { fekCellOffset }
begin
n := WriteRPNCellOffset(
AStream,
AFormula[i].Row, AFormula[i].Col,
AFormula[i].RelFlags
);
inc(RPNLength, n);
end;
INT_EXCEL_TOKEN_TNUM: { fekNum }
begin
AStream.WriteBuffer(AFormula[i].DoubleValue, 8);
@ -2593,11 +2691,13 @@ begin
end; // for
// Now update the size of the token array.
if WriteTokenArraySize then begin
finalPos := AStream.Position;
AStream.Position := TokenArraySizePos;
WriteRPNTokenArraySize(AStream, RPNLength);
AStream.Position := finalPos;
end;
end;
{ Writes the size of the RPN token array. Called from WriteRPNFormula.
Valid for BIFF3-BIFF8. Override in BIFF2. }
@ -2773,6 +2873,94 @@ begin
end;
end;
{ Writes the token array of a shared formula stored in ACell.
Note: Relative cell addresses of a shared formula are defined by
token fekCellOffset
Valid for BIFF5-BIFF8. No shared formulas before BIFF2. But since a worksheet
containing shared formulas can be written the BIFF2 writer needs to duplicate
the formulas in each cell. In BIFF2 WriteSharedFormula must not do anything. }
procedure TsSpreadBIFFWriter.WriteSharedFormula(AStream: TStream; ACell: PCell);
var
range: TRect;
node: TAVLTreeNode;
cell: PCell;
RPNLength: word;
recordSizePos: Int64;
startPos, finalPos: Int64;
formula: TsRPNFormula;
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
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;
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);
end;
// Write BIFF record ID and size
AStream.WriteWord(WordToLE(INT_EXCEL_ID_SHAREDFMLA));
recordSizePos := AStream.Position;
AStream.WriteWord(0); // This is the record size which is not yet known here
startPos := AStream.Position;
// Write borders of cell range covered by the formula
WriteSharedFormulaRange(AStream, range);
// Copy the formula (we don't want to overwrite the cell formulas)
// and adjust relative references
SetLength(formula, Length(ACell^.SharedFormulaBase^.RPNFormulaValue));
for i:=0 to Length(ACell^.SharedFormulaBase^.RPNFormulaValue)-1 do begin
formula[i] := ACell^.SharedFormulaBase^.RPNFormulaValue[i];
FixRelativeReferences(ACell, formula[i]);
end;
// Writes the (copied) rpn token array
WriteRPNTokenArray(AStream, formula, false, RPNLength);
{ Write record size at the end after we known it }
finalPos := AStream.Position;
AStream.Position := RecordSizePos;
AStream.WriteWord(WordToLE(finalPos - startPos));
AStream.Position := finalPos;
end;
{ Writes the borders of the cell range covered by a shared formula.
Needs to be overridden by BIFF5 and BIFF8 to write the column data
(1 byte in BIFF5, 2 bytes in BIFF8). No need for BIFF2 which does not
support shared formulas. }
procedure TsSpreadBIFFWriter.WriteSharedFormulaRange(AStream: TStream;
const ARange: TRect);
begin
// Index to first row
AStream.WriteWord(WordToLE(ARange.Top));
// Index to last row
AStream.WriteWord(WordToLE(ARange.Bottom));
// column indexes follow in overridden procedure!
end;
{ Writes a SHEETPR Record.
Valid for BIFF3-BIFF8. }
procedure TsSpreadBIFFWriter.WriteSheetPR(AStream: TStream);

6
components/fpspreadsheet/xlsxooxml.pas
View File

@ -147,7 +147,7 @@ type
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override;
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal;
const AFormula: TsFormula; ACell: PCell); override;
ACell: PCell); override;
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell); override;
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
@ -2495,7 +2495,7 @@ end;
{ Writes a string formula to the given cell. }
procedure TsSpreadOOXMLWriter.WriteFormula(AStream: TStream;
const ARow, ACol: Cardinal; const AFormula: TsFormula; ACell: PCell);
const ARow, ACol: Cardinal; ACell: PCell);
var
cellPosText: String;
lStyleIndex: Integer;
@ -2508,7 +2508,7 @@ begin
'<f>%s</f>' +
'</c>', [
CellPosText, lStyleIndex,
PrepareFormula(AFormula)
PrepareFormula(ACell^.FormulaValue)
]));
end;