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; procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override; ACell: PCell); override;
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal; 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; procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell); override; const AValue: string; ACell: PCell); override;
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
@ -3571,15 +3571,13 @@ begin
end; end;
{ Writes a string formula } { Writes a string formula }
procedure TsSpreadOpenDocWriter.WriteFormula(AStream: TStream; const ARow, procedure TsSpreadOpenDocWriter.WriteFormula(AStream: TStream; const ARow,
ACol: Cardinal; const AFormula: TsFormula; ACell: PCell); ACol: Cardinal; ACell: PCell);
var var
lStyle: String = ''; lStyle: String = '';
lIndex: Integer; lIndex: Integer;
begin begin
Unused(AStream, ARow, ACol); Unused(AStream, ARow, ACol);
Unused(AFormula, ACell);
if ACell^.UsedFormattingFields <> [] then begin if ACell^.UsedFormattingFields <> [] then begin
lIndex := FindFormattingInList(ACell); lIndex := FindFormattingInList(ACell);
@ -3587,28 +3585,13 @@ begin
end else end else
lStyle := ''; lStyle := '';
// We are writing a very rudimentary formula here without result and result { We are writing a very rudimentary formula here without result and result
// data type. Seems to work... data type. Seems to work... }
AppendToStream(AStream, Format( AppendToStream(AStream, Format(
'<table:table-cell table:formula="%s" %s>' + '<table:table-cell table:formula="%s" %s>' +
'</table:table-cell>', [ '</table:table-cell>', [
ACell^.FormulaValue.FormulaStr, lStyle 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; end;
{ {

131
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -677,8 +677,8 @@ type
{ Formulas } { Formulas }
procedure CalcFormulas; procedure CalcFormulas;
function HasFormula(ACell: PCell): Boolean;
function ReadRPNFormulaAsString(ACell: PCell): String; function ReadRPNFormulaAsString(ACell: PCell): String;
function UseSharedFormula(ARow, ACol: Cardinal; ASharedFormulaBase: PCell): PCell;
{ 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);
@ -1073,6 +1073,7 @@ type
procedure FixCellColors(ACell: PCell); procedure FixCellColors(ACell: PCell);
function FixColor(AColor: TsColor): TsColor; virtual; function FixColor(AColor: TsColor): TsColor; virtual;
procedure FixFormat(ACell: PCell); virtual; procedure FixFormat(ACell: PCell); virtual;
procedure FixRelativeReferences(ACell: PCell; var AElement: TsFormulaElement);
procedure GetSheetDimensions(AWorksheet: TsWorksheet; procedure GetSheetDimensions(AWorksheet: TsWorksheet;
out AFirstRow, ALastRow, AFirstCol, ALastCol: Cardinal); virtual; out AFirstRow, ALastRow, AFirstCol, ALastCol: Cardinal); virtual;
procedure ListAllFormattingStylesCallback(ACell: PCell; AStream: TStream); 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. } {@@ 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; 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. } {@@ 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. } {@@ Abstract method for writing an RPN formula to a cell. Must be overridden by descendent classes. }
procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal;
const AFormula: TsRPNFormula; ACell: PCell); virtual; const AFormula: TsRPNFormula; ACell: PCell); virtual;
*)
{@@ Abstract method for writing a string to a cell. Must be overridden by descendent classes. } {@@ 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; 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. } {@@ 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(out ACell: TCell); overload;
procedure InitCell(ARow, ACol: Cardinal; out ACell: TCell); overload; procedure InitCell(ARow, ACol: Cardinal; out ACell: TCell); overload;
function HasFormula(ACell: PCell): Boolean;
implementation implementation
@ -1605,6 +1610,7 @@ end;
{@@ {@@
Initalizes a new cell Initalizes a new cell
@return New cell record
} }
procedure InitCell(out ACell: TCell); procedure InitCell(out ACell: TCell);
begin begin
@ -1615,6 +1621,14 @@ begin
FillChar(ACell, SizeOf(ACell), 0); FillChar(ACell, SizeOf(ACell), 0);
end; 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); procedure InitCell(ARow, ACol: Cardinal; out ACell: TCell);
begin begin
InitCell(ACell); InitCell(ACell);
@ -1622,6 +1636,19 @@ begin
ACell.Col := ACol; ACell.Col := ACol;
end; 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 } { TsWorksheet }
@ -2445,18 +2472,6 @@ begin
Result := GetLastRowIndex; Result := GetLastRowIndex;
end; 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 Reads the contents of a cell and returns an user readable text
representing the contents of the cell. representing the contents of the cell.
@ -2915,6 +2930,32 @@ begin
FLastRowIndex := GetLastRowIndex(true); FLastRowIndex := GetLastRowIndex(true);
end; 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. Writes UTF-8 encoded text to a cell.
@ -6664,6 +6705,44 @@ begin
// to be overridden // to be overridden
end; 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. 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 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); procedure TsCustomSpreadWriter.WriteCellCallback(ACell: PCell; AStream: TStream);
begin begin
if HasFormula(ACell) then
WriteFormula(AStream, ACell^.Row, ACell^.Col, ACell)
else
{
if Length(ACell^.RPNFormulaValue) > 0 then if Length(ACell^.RPNFormulaValue) > 0 then
// A non-calculated RPN formula has ContentType cctUTF8Formula, but after // A non-calculated RPN formula has ContentType cctUTF8Formula, but after
// calculation it has the content type of the result. Both cases have in // calculation it has the content type of the result. Both cases have in
@ -6892,12 +6975,13 @@ begin
// be written to file. // be written to file.
WriteRPNFormula(AStream, ACell^.Row, ACell^.Col, ACell^.RPNFormulaValue, ACell) WriteRPNFormula(AStream, ACell^.Row, ACell^.Col, ACell^.RPNFormulaValue, ACell)
else else
}
case ACell.ContentType of case ACell.ContentType of
cctEmpty : WriteBlank(AStream, ACell^.Row, ACell^.Col, ACell); cctEmpty : WriteBlank(AStream, ACell^.Row, ACell^.Col, ACell);
cctDateTime : WriteDateTime(AStream, ACell^.Row, ACell^.Col, ACell^.DateTimeValue, ACell); cctDateTime : WriteDateTime(AStream, ACell^.Row, ACell^.Col, ACell^.DateTimeValue, ACell);
cctNumber : WriteNumber(AStream, ACell^.Row, ACell^.Col, ACell^.NumberValue, ACell); cctNumber : WriteNumber(AStream, ACell^.Row, ACell^.Col, ACell^.NumberValue, ACell);
cctUTF8String : WriteLabel(AStream, ACell^.Row, ACell^.Col, ACell^.UTF8StringValue, 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;
end; end;
@ -6998,24 +7082,22 @@ begin
end; 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. Present implementation does nothing. Needs to be overridden by descendants.
@param AStream Stream to be written @param AStream Stream to be written
@param ARow Row index of the cell containing the formula @param ARow Row index of the cell containing the formula
@param ACol Column 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 @param ACell Pointer to the cell containing the formula and being written
to the stream to the stream
} }
procedure TsCustomSpreadWriter.WriteFormula(AStream: TStream; const ARow, procedure TsCustomSpreadWriter.WriteFormula(AStream: TStream;
ACol: Cardinal; const AFormula: TsFormula; ACell: PCell); const ARow, ACol: Cardinal; ACell: PCell);
begin begin
Unused(AStream, ARow, ACol); Unused(AStream, ARow, ACol);
Unused(AFormula, ACell);
// Silently dump the formula; child classes should implement their own support
end; end;
(*
{@@ {@@
Basic method which is called when writing an RPN formula to a stream. Basic method which is called when writing an RPN formula to a stream.
Present implementation does nothing. Needs to be overridden by descendants. Present implementation does nothing. Needs to be overridden by descendants.
@ -7036,6 +7118,7 @@ begin
Unused(AFormula, ACell); Unused(AFormula, ACell);
// Silently dump the formula; child classes should implement their own support // Silently dump the formula; child classes should implement their own support
end; end;
*)
{******************************************************************************} {******************************************************************************}
@ -7216,8 +7299,8 @@ function RPNCellOffset(ARowOffset, AColOffset: Integer; AFlags: TsRelFlags;
begin begin
Result := NewRPNItem; Result := NewRPNItem;
Result^.FE.ElementKind := fekCellOffset; Result^.FE.ElementKind := fekCellOffset;
Result^.FE.Row := ARowOffset; Result^.FE.Row := Cardinal(ARowOffset);
Result^.FE.Col := AColOffset; Result^.FE.Col := Cardinal(AColOffset);
Result^.FE.RelFlags := AFlags; Result^.FE.RelFlags := AFlags;
Result^.Next := ANext; Result^.Next := ANext;
end; end;

50
components/fpspreadsheet/xlsbiff2.pas
View File

@ -125,7 +125,10 @@ type
procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal;
const AFormula: TsRPNFormula; ACell: PCell); override; const AFormula: TsRPNFormula; ACell: PCell); override;
function WriteRPNFunc(AStream: TStream; AIdentifier: Word): Word; 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 WriteRPNTokenArraySize(AStream: TStream; ASize: Word); override;
procedure WriteSharedFormula(AStream: TStream; ACell: PCell); override;
procedure WriteStringRecord(AStream: TStream; AString: String); override; procedure WriteStringRecord(AStream: TStream; AString: String); override;
procedure WriteWindow1(AStream: TStream); override; procedure WriteWindow1(AStream: TStream); override;
procedure WriteWindow2(AStream: TStream; ASheet: TsWorksheet); procedure WriteWindow2(AStream: TStream; ASheet: TsWorksheet);
@ -1566,7 +1569,7 @@ procedure TsSpreadBIFF2Writer.WriteRPNFormula(AStream: TStream;
const ARow, ACol: Cardinal; const AFormula: TsRPNFormula; ACell: PCell); const ARow, ACol: Cardinal; const AFormula: TsRPNFormula; ACell: PCell);
var var
RPNLength: Word; RPNLength: Word;
RecordSizePos, FinalPos: Cardinal; RecordSizePos, StartPos, FinalPos: Cardinal;
xf: Word; xf: Word;
begin begin
if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then
@ -1581,7 +1584,8 @@ begin
{ BIFF Record header } { BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_FORMULA)); AStream.WriteWord(WordToLE(INT_EXCEL_ID_FORMULA));
RecordSizePos := AStream.Position; 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 } { Row and column }
AStream.WriteWord(WordToLE(ARow)); AStream.WriteWord(WordToLE(ARow));
@ -1598,7 +1602,15 @@ begin
AStream.WriteByte(1); AStream.WriteByte(1);
{ Formula data (RPN token array) } { 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 } { Finally write sizes after we know them }
FinalPos := AStream.Position; FinalPos := AStream.Position;
@ -1620,6 +1632,31 @@ begin
Result := 1; Result := 1;
end; 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. { Writes the size of the RPN token array. Called from WriteRPNFormula.
Overrides xlscommon. } Overrides xlscommon. }
procedure TsSpreadBIFF2Writer.WriteRPNTokenArraySize(AStream: TStream; procedure TsSpreadBIFF2Writer.WriteRPNTokenArraySize(AStream: TStream;
@ -1628,6 +1665,13 @@ begin
AStream.WriteByte(Lo(ASize)); AStream.WriteByte(Lo(ASize));
end; 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 { Writes an Excel 2 STRING record which immediately follows a FORMULA record
when the formula result is a string. } when the formula result is a string. }
procedure TsSpreadBIFF2Writer.WriteStringRecord(AStream: TStream; procedure TsSpreadBIFF2Writer.WriteStringRecord(AStream: TStream;

190
components/fpspreadsheet/xlsbiff5.pas
View File

@ -119,10 +119,7 @@ type
procedure WriteIndex(AStream: TStream); procedure WriteIndex(AStream: TStream);
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell); override; const AValue: string; ACell: PCell); override;
{ procedure WriteSharedFormulaRange(AStream: TStream; const ARange: TRect); override;
procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal;
const AFormula: TsRPNFormula; ACell: PCell); override;
}
procedure WriteStringRecord(AStream: TStream; AString: String); override; procedure WriteStringRecord(AStream: TStream; AString: String); override;
procedure WriteStyle(AStream: TStream); procedure WriteStyle(AStream: TStream);
procedure WriteWindow2(AStream: TStream; ASheet: TsWorksheet); procedure WriteWindow2(AStream: TStream; ASheet: TsWorksheet);
@ -724,181 +721,8 @@ begin
{ Clean up } { Clean up }
SetLength(buf, 0); 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; 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 () * TsSpreadBIFF5Writer.WriteIndex ()
* *
@ -1014,6 +838,18 @@ begin
SetLength(buf, 0); SetLength(buf, 0);
end; 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 { Writes an Excel 5 STRING record which immediately follows a FORMULA record
when the formula result is a string. when the formula result is a string.
BIFF5 writes a byte-string, but uses a 16-bit length here! } 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 WriteFonts(AStream: TStream);
procedure WriteFormat(AStream: TStream; AFormatData: TsNumFormatData; procedure WriteFormat(AStream: TStream; AFormatData: TsNumFormatData;
AListIndex: Integer); override; AListIndex: Integer); override;
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal;
const AFormula: TsFormula; ACell: PCell); override;
procedure WriteIndex(AStream: TStream); procedure WriteIndex(AStream: TStream);
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell); override; const AValue: string; ACell: PCell); override;
function WriteRPNCellAddress(AStream: TStream; ARow, ACol: Cardinal; function WriteRPNCellAddress(AStream: TStream; ARow, ACol: Cardinal;
AFlags: TsRelFlags): word; override; AFlags: TsRelFlags): word; override;
function WriteRPNCellOffset(AStream: TStream; ARowOffset, AColOffset: Integer;
AFlags: TsRelFlags): Word; override;
function WriteRPNCellRangeAddress(AStream: TStream; ARow1, ACol1, ARow2, ACol2: Cardinal; function WriteRPNCellRangeAddress(AStream: TStream; ARow1, ACol1, ARow2, ACol2: Cardinal;
AFlags: TsRelFlags): Word; override; AFlags: TsRelFlags): Word; override;
procedure WriteSharedFormulaRange(AStream: TStream; const ARange: TRect); override;
function WriteString_8bitLen(AStream: TStream; AString: String): Integer; override; function WriteString_8bitLen(AStream: TStream; AString: String): Integer; override;
procedure WriteStringRecord(AStream: TStream; AString: string); override; procedure WriteStringRecord(AStream: TStream; AString: string); override;
procedure WriteStyle(AStream: TStream); procedure WriteStyle(AStream: TStream);
@ -465,6 +466,7 @@ begin
for i := 0 to Workbook.GetWorksheetCount - 1 do for i := 0 to Workbook.GetWorksheetCount - 1 do
begin begin
sheet := Workbook.GetWorksheetByIndex(i); sheet := Workbook.GetWorksheetByIndex(i);
FWorksheet := sheet;
{ First goes back and writes the position of the BOF of the { First goes back and writes the position of the BOF of the
sheet on the respective BOUNDSHEET record } sheet on the respective BOUNDSHEET record }
@ -778,103 +780,6 @@ begin
*) *)
end; 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 { Writes the address of a cell as used in an RPN formula and returns the
number of bytes written. } number of bytes written. }
function TsSpreadBIFF8Writer.WriteRPNCellAddress(AStream: TStream; function TsSpreadBIFF8Writer.WriteRPNCellAddress(AStream: TStream;
@ -890,6 +795,25 @@ begin
Result := 4; Result := 4;
end; 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 { Writes the address of a cell range as used in an RPN formula and returns the
count of bytes written. } count of bytes written. }
function TsSpreadBIFF8Writer.WriteRPNCellRangeAddress(AStream: TStream; function TsSpreadBIFF8Writer.WriteRPNCellRangeAddress(AStream: TStream;
@ -913,6 +837,18 @@ begin
Result := 8; Result := 8;
end; 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 { Helper function for writing a string with 8-bit length. Overridden version
for BIFF8. Called for writing rpn formula string tokens. for BIFF8. Called for writing rpn formula string tokens.
Returns the count of bytes written} Returns the count of bytes written}

246
components/fpspreadsheet/xlscommon.pas
View File

@ -497,6 +497,9 @@ type
AListIndex: Integer); virtual; AListIndex: Integer); virtual;
// Writes out all FORMAT records // Writes out all FORMAT records
procedure WriteFormats(AStream: TStream); 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 // Writes out a floating point NUMBER record
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: Double; ACell: PCell); override; const AValue: Double; ACell: PCell); override;
@ -506,25 +509,33 @@ type
// Writes out a PANE record // Writes out a PANE record
procedure WritePane(AStream: TStream; ASheet: TsWorksheet; IsBiff58: Boolean; procedure WritePane(AStream: TStream; ASheet: TsWorksheet; IsBiff58: Boolean;
out ActivePane: Byte); 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 // Writes out a ROW record
procedure WriteRow(AStream: TStream; ASheet: TsWorksheet; procedure WriteRow(AStream: TStream; ASheet: TsWorksheet;
ARowIndex, AFirstColIndex, ALastColIndex: Cardinal; ARow: PRow); virtual; ARowIndex, AFirstColIndex, ALastColIndex: Cardinal; ARow: PRow); virtual;
// Write all ROW records for a sheet // Write all ROW records for a sheet
procedure WriteRows(AStream: TStream; ASheet: TsWorksheet); 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 // Writes out a SELECTION record
procedure WriteSelection(AStream: TStream; ASheet: TsWorksheet; APane: Byte); procedure WriteSelection(AStream: TStream; ASheet: TsWorksheet; APane: Byte);
procedure WriteSelections(AStream: TStream; ASheet: TsWorksheet); 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 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
@ -543,7 +554,7 @@ type
implementation implementation
uses uses
Math, Variants, fpsNumFormatParser; AVL_Tree, Math, Variants, fpsNumFormatParser;
{ Helper table for rpn formulas: { Helper table for rpn formulas:
Assignment of FormulaElementKinds (fekXXXX) to EXCEL_TOKEN IDs. } Assignment of FormulaElementKinds (fekXXXX) to EXCEL_TOKEN IDs. }
@ -2160,6 +2171,16 @@ begin
end; end;
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. { Writes a 64-bit floating point NUMBER record.
Valid for BIFF5 and BIFF8 (BIFF2 has a different record structure.). } Valid for BIFF5 and BIFF8 (BIFF2 has a different record structure.). }
procedure TsSpreadBIFFWriter.WriteNumber(AStream: TStream; procedure TsSpreadBIFFWriter.WriteNumber(AStream: TStream;
@ -2350,14 +2371,36 @@ function TsSpreadBIFFWriter.WriteRPNCellAddress(AStream: TStream;
var var
r: Cardinal; // row index containing encoded relativ/absolute address info r: Cardinal; // row index containing encoded relativ/absolute address info
begin begin
// Encoded row address
r := ARow and MASK_EXCEL_ROW; r := ARow and MASK_EXCEL_ROW;
if (rfRelRow in AFlags) then r := r or MASK_EXCEL_RELATIVE_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; if (rfRelCol in AFlags) then r := r or MASK_EXCEL_RELATIVE_COL;
AStream.WriteWord(r); AStream.WriteWord(WordToLE(r));
// Column address
AStream.WriteByte(ACol); AStream.WriteByte(ACol);
// Number of bytes written
Result := 3; Result := 3;
end; 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 { Writes the address of a cell range as used in an RPN formula and returns the
count of bytes written. count of bytes written.
@ -2392,15 +2435,19 @@ procedure TsSpreadBIFFWriter.WriteRPNFormula(AStream: TStream;
const ARow, ACol: Cardinal; const AFormula: TsRPNFormula; ACell: PCell); const ARow, ACol: Cardinal; const AFormula: TsRPNFormula; ACell: PCell);
var var
RPNLength: Word = 0; RPNLength: Word = 0;
RecordSizePos, FinalPos: Int64; RecordSizePos, StartPos, FinalPos: Int64;
begin begin
if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then
exit; exit;
if not ((Length(AFormula) > 0) or (ACell^.SharedFormulaBase <> nil)) then
exit;
{ BIFF Record header } { BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_FORMULA)); AStream.WriteWord(WordToLE(INT_EXCEL_ID_FORMULA));
RecordSizePos := AStream.Position; RecordSizePos := AStream.Position;
AStream.WriteWord(0); // This is the record size which is not yet known here AStream.WriteWord(0); // This is the record size which is not yet known here
StartPos := AStream.Position;
{ BIFF Record data } { BIFF Record data }
AStream.WriteWord(WordToLE(ARow)); AStream.WriteWord(WordToLE(ARow));
@ -2420,15 +2467,28 @@ begin
AStream.WriteDWord(0); AStream.WriteDWord(0);
{ Formula data (RPN token array) } { 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 } { Write sizes in the end, after we known them }
FinalPos := AStream.Position; FinalPos := AStream.Position;
AStream.Position := RecordSizePos; AStream.Position := RecordSizePos;
AStream.WriteWord(WordToLE(22 + RPNLength)); AStream.WriteWord(WordToLE(FinalPos - StartPos));
// AStream.WriteWord(WordToLE(22 + RPNLength));
AStream.Position := FinalPos; 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 if (ACell^.ContentType = cctUTF8String) and (ACell^.UTF8StringValue <> '') then
WriteStringRecord(AStream, ACell^.UTF8StringValue); WriteStringRecord(AStream, ACell^.UTF8StringValue);
end; end;
@ -2493,9 +2553,34 @@ begin
AStream.WriteBuffer(Data, 8); AStream.WriteBuffer(Data, 8);
end; 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 } { Writes the token array of the given RPN formula and returns its size }
procedure TsSpreadBIFFWriter.WriteRPNTokenArray(AStream: TStream; procedure TsSpreadBIFFWriter.WriteRPNTokenArray(AStream: TStream;
const AFormula: TsRPNFormula; var RPNLength: Word); const AFormula: TsRPNFormula; WriteTokenArraySize: Boolean; var RPNLength: Word);
var var
i: Integer; i: Integer;
tokenID, secondaryID: Word; tokenID, secondaryID: Word;
@ -2505,10 +2590,12 @@ var
begin begin
RPNLength := 0; RPNLength := 0;
{ The size of the token array is written later, because it's necessary to if WriteTokenArraySize then begin
calculate it first, and this is done at the same time it is written } { The size of the token array is written later, because it's necessary to
TokenArraySizePos := AStream.Position; calculate it first, and this is done at the same time it is written }
WriteRPNTokenArraySize(AStream, 0); TokenArraySizePos := AStream.Position;
WriteRPNTokenArraySize(AStream, 0);
end;
{ Formula data (RPN token array) } { Formula data (RPN token array) }
for i := 0 to Length(AFormula) - 1 do begin for i := 0 to Length(AFormula) - 1 do begin
@ -2521,9 +2608,8 @@ begin
{ Token data } { Token data }
case tokenID of case tokenID of
{ Operand Tokens } { Operand Tokens }
INT_EXCEL_TOKEN_TREFR, INT_EXCEL_TOKEN_TREFR, INT_EXCEL_TOKEN_TREFV, INT_EXCEL_TOKEN_TREFA: { fekCell }
INT_EXCEL_TOKEN_TREFV, // INT_EXCEL_TOKEN_TREFN_R, INT_EXCEL_TOKEN_TREFN_V, INT_EXCEL_TOKEN_TREFN_A: { fekCellOffset}
INT_EXCEL_TOKEN_TREFA: { fekCell }
begin begin
n := WriteRPNCellAddress( n := WriteRPNCellAddress(
AStream, AStream,
@ -2544,6 +2630,18 @@ begin
inc(RPNLength, n); inc(RPNLength, n);
end; 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 } INT_EXCEL_TOKEN_TNUM: { fekNum }
begin begin
AStream.WriteBuffer(AFormula[i].DoubleValue, 8); AStream.WriteBuffer(AFormula[i].DoubleValue, 8);
@ -2593,10 +2691,12 @@ begin
end; // for end; // for
// Now update the size of the token array. // Now update the size of the token array.
finalPos := AStream.Position; if WriteTokenArraySize then begin
AStream.Position := TokenArraySizePos; finalPos := AStream.Position;
WriteRPNTokenArraySize(AStream, RPNLength); AStream.Position := TokenArraySizePos;
AStream.Position := finalPos; WriteRPNTokenArraySize(AStream, RPNLength);
AStream.Position := finalPos;
end;
end; end;
{ Writes the size of the RPN token array. Called from WriteRPNFormula. { Writes the size of the RPN token array. Called from WriteRPNFormula.
@ -2773,6 +2873,94 @@ begin
end; 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
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. { Writes a SHEETPR Record.
Valid for BIFF3-BIFF8. } Valid for BIFF3-BIFF8. }
procedure TsSpreadBIFFWriter.WriteSheetPR(AStream: TStream); 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; procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override; ACell: PCell); override;
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal; 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; procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell); override; const AValue: string; ACell: PCell); override;
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
@ -2495,7 +2495,7 @@ end;
{ Writes a string formula to the given cell. } { Writes a string formula to the given cell. }
procedure TsSpreadOOXMLWriter.WriteFormula(AStream: TStream; procedure TsSpreadOOXMLWriter.WriteFormula(AStream: TStream;
const ARow, ACol: Cardinal; const AFormula: TsFormula; ACell: PCell); const ARow, ACol: Cardinal; ACell: PCell);
var var
cellPosText: String; cellPosText: String;
lStyleIndex: Integer; lStyleIndex: Integer;
@ -2508,7 +2508,7 @@ begin
'<f>%s</f>' + '<f>%s</f>' +
'</c>', [ '</c>', [
CellPosText, lStyleIndex, CellPosText, lStyleIndex,
PrepareFormula(AFormula) PrepareFormula(ACell^.FormulaValue)
])); ]));
end; end;