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

fpspreadsheet: Write OOXML string formulas. Write biff2 dimension record.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3456 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-08-08 19:00:27 +00:00
parent 8f666bec13
commit a0a19eb380
7 changed files with 106 additions and 71 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
components/fpspreadsheet/fpsfunc.pas
View File

@ -1372,7 +1372,6 @@ function fpsDATEDIF(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
= YD - The difference between the days (years and dates are ignored). }
var
interval: String;
data: TsArgStringArray;
start_date, end_date: TDate;
res1, res2, res3: TsArgument;
begin
@ -1599,7 +1598,6 @@ function fpsCOUNTBLANK(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var
arg: TsArgument;
r, c, n: Cardinal;
cell: PCell;
begin
arg := Args.Pop;
case arg.ArgumentType of

33
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -584,6 +584,8 @@ type
function WriteFormula(ARow, ACol: Cardinal; AFormula: TsFormula): PCell; overload;
procedure WriteFormula(ACell: PCell; AFormula: TsFormula); overload;
function WriteFormula(ARow, ACol: Cardinal; AFormula: String): PCell; overload;
procedure WriteFormula(ACell: PCell; AFormula: String); overload;
procedure WriteNumber(ARow, ACol: Cardinal; ANumber: double); overload;
procedure WriteNumber(ACell: PCell; ANumber: Double); overload;
@ -1700,7 +1702,6 @@ end;
procedure TsWorksheet.CalcRPNFormula(ACell: PCell);
var
i: Integer;
formula: TsRPNFormula;
args: TsArgumentStack;
func: TsFormulaFunc;
val: TsArgument;
@ -2342,7 +2343,6 @@ function TsWorksheet.ReadAsUTF8Text(ACell: PCell): ansistring;
ANumberFormat: TsNumberFormat; ANumberFormatStr: string): ansistring;
var
fs: TFormatSettings;
left, right: String;
begin
fs := FWorkbook.FormatSettings;
if IsNan(Value) then
@ -3456,6 +3456,35 @@ begin
ChangedCell(ACell^.Row, ACell^.Col);
end;
{@@
Writes a formula to a given cell
@param ARow The row of the cell
@param ACol The column of the cell
@param AFormula The formula string to be written
@return Pointer to the cell
}
function TsWorksheet.WriteFormula(ARow, ACol: Cardinal; AFormula: string): PCell;
begin
Result := GetCell(ARow, ACol);
WriteFormula(Result, AFormula);
end;
{@@
Writes a formula to a given cell
@param ACell Pointer to the cell
@param AFormula Formula string to be written
}
procedure TsWorksheet.WriteFormula(ACell: PCell; AFormula: String);
begin
if ACell = nil then
exit;
ACell^.ContentType := cctFormula;
ACell^.FormulaValue.FormulaStr := AFormula;
ChangedCell(ACell^.Row, ACell^.Col);
end;
{@@
Adds a number format to the formatting of a cell

4
components/fpspreadsheet/tests/spreadtestgui.lpi
View File

@ -52,7 +52,6 @@
<Unit2>
<Filename Value="stringtests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="stringtests"/>
</Unit2>
<Unit3>
<Filename Value="numberstests.pas"/>
@ -66,16 +65,15 @@
<Unit5>
<Filename Value="testsutility.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="testsutility"/>
</Unit5>
<Unit6>
<Filename Value="internaltests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="internaltests"/>
</Unit6>
<Unit7>
<Filename Value="formattests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="formattests"/>
</Unit7>
<Unit8>
<Filename Value="colortests.pas"/>

36
components/fpspreadsheet/xlsbiff2.pas
View File

@ -93,6 +93,7 @@ type
procedure WriteCellFormatting(AStream: TStream; ACell: PCell; XFIndex: Word);
procedure WriteColWidth(AStream: TStream; ACol: PCol);
procedure WriteColWidths(AStream: TStream);
procedure WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteEOF(AStream: TStream);
procedure WriteFont(AStream: TStream; AFontIndex: Integer);
procedure WriteFonts(AStream: TStream);
@ -148,6 +149,7 @@ uses
const
{ Excel record IDs }
INT_EXCEL_ID_DIMENSIONS = $0000;
INT_EXCEL_ID_BLANK = $0001;
INT_EXCEL_ID_INTEGER = $0002;
INT_EXCEL_ID_NUMBER = $0003;
@ -169,6 +171,15 @@ const
INT_EXCEL_MACRO_SHEET = $0040;
type
TBIFF2DimensionsRecord = packed record
RecordID: Word;
RecordSize: Word;
FirstRow: Word;
LastRowPlus1: Word;
FirstCol: Word;
LastColPlus1: Word;
end;
TBIFF2LabelRecord = packed record
RecordID: Word;
RecordSize: Word;
@ -1112,6 +1123,30 @@ begin
end;
end;
{
Writes an Excel 2 DIMENSIONS record
}
procedure TsSpreadBIFF2Writer.WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet);
var
firstRow, lastRow, firstCol, lastCol: Cardinal;
rec: TBIFF2DimensionsRecord;
begin
{ Determine sheet size }
GetSheetDimensions(AWorksheet, firstRow, lastRow, firstCol, lastCol);
{ Populate BIFF record }
rec.RecordID := WordToLE(INT_EXCEL_ID_DIMENSIONS);
rec.RecordSize := WordToLE(8);
rec.FirstRow := WordToLE(firstRow);
rec.LastRowPlus1 := WordToLE(Min(lastRow+1, $FFFF)); // avoid WORD overflow
rec.FirstCol := WordToLE(firstCol);
rec.LastColPlus1 := WordToLE(lastCol+1);
{ Write BIFF record to stream }
AStream.WriteBuffer(rec, SizeOf(rec));
end;
{
Writes an Excel 2 IXFE record
This record contains the "real" XF index if it is > 62.
@ -1143,6 +1178,7 @@ begin
WriteFormats(AStream);
WriteXFRecords(AStream);
WriteColWidths(AStream);
WriteDimensions(AStream, sheet);
WriteRows(AStream, sheet);
if (boVirtualMode in Workbook.Options) then

29
components/fpspreadsheet/xlsbiff5.pas
View File

@ -219,7 +219,7 @@ var
implementation
uses
fpsStreams;
Math, fpsStreams;
const
{ Excel record IDs }
@ -563,7 +563,6 @@ procedure TsSpreadBIFF5Writer.WriteDimensions(AStream: TStream; AWorksheet: TsWo
var
rec: TBIFF5DimensionsRecord;
firstCol, lastCol, firstRow, lastRow: Cardinal;
lLastRow, lLastCol: Word;
begin
{ Determine sheet size }
GetSheetDimensions(AWorksheet, firstRow, lastRow, firstCol, lastCol);
@ -572,37 +571,13 @@ begin
rec.RecordID := WordToLE(INT_EXCEL_ID_DIMENSIONS);
rec.RecordSize := WordToLE(10);
rec.FirstRow := WordToLE(firstRow);
rec.LastRowPlus1 := WordToLE(lastRow+1);
rec.LastRowPlus1 := WordToLE(Min(lastRow+1, $FFFF)); // avoid word overflow
rec.FirstCol := WordToLe(firstCol);
rec.LastColPlus1 := WordToLE(lastCol+1);
rec.NotUsed := 0;
{ Write BIFF record }
AStream.WriteBuffer(rec, SizeOf(rec));
(*
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_DIMENSIONS));
AStream.WriteWord(WordToLE(10));
{ Index to first used row }
AStream.WriteWord(0);
{ Index to last used row, increased by 1 }
lLastRow := Word(GetLastRowIndex(AWorksheet)+1);
AStream.WriteWord(WordToLE(lLastRow)); // Old dummy value: 33
{ Index to first used column }
AStream.WriteWord(0);
{ Index to last used column, increased by 1 }
lLastCol := Word(GetLastColIndex(AWorksheet)+1);
AStream.WriteWord(WordToLE(lLastCol)); // Old dummy value: 10
{ Not used }
AStream.WriteWord(0);
*)
end;
{*******************************************************************

24
components/fpspreadsheet/xlsbiff8.pas
View File

@ -606,30 +606,6 @@ begin
{ Write BIFF record to stream }
AStream.WriteBuffer(rec, SizeOf(rec));
(*
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_DIMENSIONS));
AStream.WriteWord(WordToLE(14));
{ Determine sheet size }
GetSheetDimensions(AWorksheet, firstRow, lastRow, firstCol, lastCol);
{ Index to first used row }
AStream.WriteDWord(DWordToLE(firstRow));
{ Index to last used row, increased by 1 }
AStream.WriteDWord(DWordToLE(lastRow+1));
{ Index to first used column }
AStream.WriteWord(WordToLE(firstCol));
{ Index to last used column, increased by 1 }
AStream.WriteWord(WordToLE(lastCol+1));
{ Not used }
AStream.WriteWord(WordToLE(0));
*)
end;
{*******************************************************************

49
components/fpspreadsheet/xlsxooxml.pas
View File

@ -114,6 +114,7 @@ type
function GetStyleIndex(ACell: PCell): Cardinal;
procedure ListAllBorders;
procedure ListAllFills;
function PrepareFormula(const AFormula: TsFormula): String;
procedure ResetStreams;
procedure WriteBorderList(AStream: TStream);
procedure WriteCols(AStream: TStream; AWorksheet: TsWorksheet);
@ -143,10 +144,16 @@ type
protected
{ Record writing methods }
//todo: add WriteDate
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; 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; const AValue: double; ACell: PCell); override;
procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); override;
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;
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell); override;
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: double; ACell: PCell); override;
procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: TDateTime; ACell: PCell); override;
public
constructor Create(AWorkbook: TsWorkbook); override;
@ -1907,15 +1914,6 @@ begin
end else
begin
// The cells need to be written in order, row by row, cell by cell
(*
c1 := AWorksheet.GetFirstColIndex;
c2 := AWorksheet.GetLastColIndex;
if (c1 = $FFFFFFFF) and (c2 = 0) then c1 := 0; // avoid arithmetic overflow in case of empty worksheet
r1 := AWorksheet.GetFirstRowIndex;
r2 := AWorksheet.GetlastRowIndex;
if (r1 = $FFFFFFFF) and (r2 = 0) then r1 := 0; // avoid arithmetic overflow in case of empty worksheet
// for r := 0 to AWorksheet.GetLastRowIndex do begin
*)
for r := r1 to r2 do begin
// If the row has a custom height add this value to the <row> specification
row := AWorksheet.FindRow(r);
@ -2364,6 +2362,13 @@ begin
SetLength(FSSheets, 0);
end;
{ Prepares a string formula for writing }
function TsSpreadOOXMLWriter.PrepareFormula(const AFormula: TsFormula): String;
begin
Result := AFormula.FormulaStr;
if (Result <> '') and (Result[1] = '=') then Delete(Result, 1, 1);
end;
{ Is called before zipping the individual file parts. Rewinds the streams. }
procedure TsSpreadOOXMLWriter.ResetStreams;
var
@ -2486,6 +2491,24 @@ begin
'</c>');
end;
{ Writes a string formula to the given cell. }
procedure TsSpreadOOXMLWriter.WriteFormula(AStream: TStream;
const ARow, ACol: Cardinal; const AFormula: TsFormula; ACell: PCell);
var
cellPosText: String;
lStyleIndex: Integer;
begin
cellPosText := TsWorksheet.CellPosToText(ARow, ACol);
lStyleIndex := GetStyleIndex(ACell);
AppendToStream(AStream, Format(
'<c r="%s" s="%d">' +
'<f>%s</f>' +
'</c>', [
CellPosText, lStyleIndex,
PrepareFormula(AFormula)
]));
end;
{*******************************************************************
* TsSpreadOOXMLWriter.WriteLabel ()