You've already forked lazarus-ccr
fpspreadsheet: Implement writing of ODS files in virtual mode. Adapt demo_virtualmode_write, speed test, and unit test (--> passed).
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3443 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@@ -10,7 +10,7 @@ uses
|
|||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
Classes, SysUtils,
|
Classes, SysUtils,
|
||||||
lazutf8,
|
lazutf8,
|
||||||
variants, fpspreadsheet, xlsbiff2, xlsbiff5, xlsbiff8, xlsxooxml;
|
variants, fpspreadsheet, fpsallformats;
|
||||||
|
|
||||||
type
|
type
|
||||||
TDataProvider = class
|
TDataProvider = class
|
||||||
@@ -66,8 +66,8 @@ begin
|
|||||||
|
|
||||||
{ These are the essential commands to activate virtual mode: }
|
{ These are the essential commands to activate virtual mode: }
|
||||||
|
|
||||||
workbook.Options := [boVirtualMode, boBufStream];
|
// workbook.Options := [boVirtualMode, boBufStream];
|
||||||
// workbook.Options := [boVirtualMode];
|
workbook.Options := [boVirtualMode];
|
||||||
{ boBufStream can be omitted, but is important for large files: it causes
|
{ boBufStream can be omitted, but is important for large files: it causes
|
||||||
writing temporary data to a buffered file stream instead of a pure
|
writing temporary data to a buffered file stream instead of a pure
|
||||||
memory stream which can overflow memory. In cases, the option can slow
|
memory stream which can overflow memory. In cases, the option can slow
|
||||||
@@ -97,10 +97,11 @@ begin
|
|||||||
{ In case of a database, you would open the dataset before calling this: }
|
{ In case of a database, you would open the dataset before calling this: }
|
||||||
|
|
||||||
t := Now;
|
t := Now;
|
||||||
|
workbook.WriteToFile('test_virtual.ods', sfOpenDocument, true);
|
||||||
//workbook.WriteToFile('test_virtual.xlsx', sfOOXML, true);
|
//workbook.WriteToFile('test_virtual.xlsx', sfOOXML, true);
|
||||||
//workbook.WriteToFile('test_virtual.xls', sfExcel8, true);
|
//workbook.WriteToFile('test_virtual.xls', sfExcel8, true);
|
||||||
//workbook.WriteToFile('test_virtual.xls', sfExcel5, true);
|
//workbook.WriteToFile('test_virtual.xls', sfExcel5, true);
|
||||||
workbook.WriteToFile('test_virtual.xls', sfExcel2, true);
|
//workbook.WriteToFile('test_virtual.xls', sfExcel2, true);
|
||||||
t := Now - t;
|
t := Now - t;
|
||||||
|
|
||||||
finally
|
finally
|
||||||
|
@@ -138,6 +138,7 @@ type
|
|||||||
procedure WriteRowStyles(AStream: TStream);
|
procedure WriteRowStyles(AStream: TStream);
|
||||||
procedure WriteRowsAndCells(AStream: TStream; ASheet: TsWorksheet);
|
procedure WriteRowsAndCells(AStream: TStream; ASheet: TsWorksheet);
|
||||||
procedure WriteTableSettings(AStream: TStream);
|
procedure WriteTableSettings(AStream: TStream);
|
||||||
|
procedure WriteVirtualCells(AStream: TStream; ASheet: TsWorksheet);
|
||||||
|
|
||||||
function WriteBackgroundColorStyleXMLAsString(const AFormat: TCell): String;
|
function WriteBackgroundColorStyleXMLAsString(const AFormat: TCell): String;
|
||||||
function WriteBorderStyleXMLAsString(const AFormat: TCell): String;
|
function WriteBorderStyleXMLAsString(const AFormat: TCell): String;
|
||||||
@@ -192,7 +193,7 @@ type
|
|||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
StrUtils, fpsStreams;
|
StrUtils, Variants, fpsStreams;
|
||||||
|
|
||||||
const
|
const
|
||||||
{ OpenDocument general XML constants }
|
{ OpenDocument general XML constants }
|
||||||
@@ -2738,6 +2739,10 @@ begin
|
|||||||
|
|
||||||
// rows and cells
|
// rows and cells
|
||||||
// The cells need to be written in order, row by row, cell by cell
|
// The cells need to be written in order, row by row, cell by cell
|
||||||
|
if (boVirtualMode in Workbook.Options) then begin
|
||||||
|
if Assigned(Workbook.OnWriteCellData) then
|
||||||
|
WriteVirtualCells(AStream, CurSheet)
|
||||||
|
end else
|
||||||
WriteRowsAndCells(AStream, CurSheet);
|
WriteRowsAndCells(AStream, CurSheet);
|
||||||
|
|
||||||
// Footer
|
// Footer
|
||||||
@@ -3476,6 +3481,120 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TsSpreadOpenDocWriter.WriteVirtualCells(AStream: TStream;
|
||||||
|
ASheet: TsWorksheet);
|
||||||
|
var
|
||||||
|
r, c, cc: Cardinal;
|
||||||
|
lCell: TCell;
|
||||||
|
row: PRow;
|
||||||
|
value: variant;
|
||||||
|
styleCell: PCell;
|
||||||
|
styleName: String;
|
||||||
|
h, h_mm: Single; // row height in "lines" and millimeters, respectively
|
||||||
|
k: Integer;
|
||||||
|
rowStyleData: TRowStyleData;
|
||||||
|
rowsRepeated: Integer;
|
||||||
|
colsRepeated: Integer;
|
||||||
|
colsRepeatedStr: String;
|
||||||
|
defFontSize: Single;
|
||||||
|
lastCol, lastRow: Cardinal;
|
||||||
|
begin
|
||||||
|
// some abbreviations...
|
||||||
|
lastCol := Workbook.VirtualColCount - 1;
|
||||||
|
lastRow := Workbook.VirtualRowCount - 1;
|
||||||
|
defFontSize := Workbook.GetFont(0).Size;
|
||||||
|
|
||||||
|
rowsRepeated := 1;
|
||||||
|
r := 0;
|
||||||
|
while (r <= lastRow) do begin
|
||||||
|
// Look for the row style of the current row (r)
|
||||||
|
row := ASheet.FindRow(r);
|
||||||
|
if row = nil then
|
||||||
|
styleName := 'ro1'
|
||||||
|
else begin
|
||||||
|
styleName := '';
|
||||||
|
|
||||||
|
h := row^.Height; // row height in "lines"
|
||||||
|
h_mm := PtsToMM((h + ROW_HEIGHT_CORRECTION) * defFontSize); // in mm
|
||||||
|
for k := 0 to FRowStyleList.Count-1 do begin
|
||||||
|
rowStyleData := TRowStyleData(FRowStyleList[k]);
|
||||||
|
// Compare row heights, but be aware of rounding errors
|
||||||
|
if SameValue(rowStyleData.RowHeight, h_mm, 1E-3) then begin
|
||||||
|
styleName := rowStyleData.Name;
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if styleName = '' then
|
||||||
|
raise Exception.Create('Row style not found.');
|
||||||
|
end;
|
||||||
|
|
||||||
|
// No empty rows allowed here for the moment!
|
||||||
|
|
||||||
|
|
||||||
|
// Write the row XML
|
||||||
|
AppendToStream(AStream, Format(
|
||||||
|
'<table:table-row table:style-name="%s">', [styleName]));
|
||||||
|
|
||||||
|
// Loop along the row and write the cells.
|
||||||
|
c := 0;
|
||||||
|
while c <= lastCol do begin
|
||||||
|
// Empty cell? Need to count how many "table:number-columns-repeated" to be added
|
||||||
|
colsRepeated := 1;
|
||||||
|
|
||||||
|
InitCell(r, c, lCell);
|
||||||
|
value := varNull;
|
||||||
|
styleCell := nil;
|
||||||
|
|
||||||
|
Workbook.OnWriteCellData(Workbook, r, c, value, styleCell);
|
||||||
|
|
||||||
|
if VarIsNull(value) then begin
|
||||||
|
// Local loop to count empty cells
|
||||||
|
cc := c + 1;
|
||||||
|
while (cc <= lastCol) do begin
|
||||||
|
InitCell(r, cc, lCell);
|
||||||
|
value := varNull;
|
||||||
|
styleCell := nil;
|
||||||
|
Workbook.OnWriteCellData(Workbook, r, cc, value, styleCell);
|
||||||
|
if not VarIsNull(value) then
|
||||||
|
break;
|
||||||
|
inc(cc);
|
||||||
|
end;
|
||||||
|
colsRepeated := cc - c;
|
||||||
|
colsRepeatedStr := IfThen(colsRepeated = 1, '',
|
||||||
|
Format('table:number-columns-repeated="%d"', [colsRepeated]));
|
||||||
|
AppendToStream(AStream, Format(
|
||||||
|
'<table:table-cell %s />', [colsRepeatedStr]));
|
||||||
|
end else begin
|
||||||
|
if VarIsNumeric(value) then begin
|
||||||
|
lCell.ContentType := cctNumber;
|
||||||
|
lCell.NumberValue := value;
|
||||||
|
end else
|
||||||
|
if VarType(value) = varDate then begin
|
||||||
|
lCell.ContentType := cctDateTime;
|
||||||
|
lCell.DateTimeValue := StrToDate(VarToStr(value), Workbook.FormatSettings);
|
||||||
|
end else
|
||||||
|
if VarIsStr(value) then begin
|
||||||
|
lCell.ContentType := cctUTF8String;
|
||||||
|
lCell.UTF8StringValue := VarToStrDef(value, '');
|
||||||
|
end else
|
||||||
|
if VarIsBool(value) then begin
|
||||||
|
lCell.ContentType := cctBool;
|
||||||
|
lCell.BoolValue := value <> 0;
|
||||||
|
end else
|
||||||
|
lCell.ContentType := cctEmpty;
|
||||||
|
WriteCellCallback(@lCell, AStream);
|
||||||
|
end;
|
||||||
|
inc(c, colsRepeated);
|
||||||
|
end;
|
||||||
|
|
||||||
|
AppendToStream(AStream,
|
||||||
|
'</table:table-row>');
|
||||||
|
|
||||||
|
// Next row
|
||||||
|
inc(r, rowsRepeated);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
{ Creates an XML string for inclusion of the wordwrap option into the
|
{ Creates an XML string for inclusion of the wordwrap option into the
|
||||||
written file from the wordwrap setting in the format cell.
|
written file from the wordwrap setting in the format cell.
|
||||||
Is called from WriteStyles (via WriteStylesXMLAsString). }
|
Is called from WriteStyles (via WriteStylesXMLAsString). }
|
||||||
|
@@ -58,12 +58,14 @@ type
|
|||||||
procedure TestVirtualMode_BIFF2;
|
procedure TestVirtualMode_BIFF2;
|
||||||
procedure TestVirtualMode_BIFF5;
|
procedure TestVirtualMode_BIFF5;
|
||||||
procedure TestVirtualMode_BIFF8;
|
procedure TestVirtualMode_BIFF8;
|
||||||
|
procedure TestVirtualMode_ODS;
|
||||||
procedure TestVirtualMode_OOXML;
|
procedure TestVirtualMode_OOXML;
|
||||||
|
|
||||||
procedure TestVirtualMode_BIFF2_BufStream;
|
procedure TestVirtualMode_BIFF2_BufStream;
|
||||||
procedure TestVirtualMode_BIFF5_BufStream;
|
procedure TestVirtualMode_BIFF5_BufStream;
|
||||||
procedure TestVirtualMode_BIFF8_BufStream;
|
procedure TestVirtualMode_BIFF8_BufStream;
|
||||||
procedure TestVirtualMode_OOXML_BufStream;
|
//procedure TestVirtualMode_ODS_BufStream;
|
||||||
|
//procedure TestVirtualMode_OOXML_BufStream;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
@@ -394,6 +396,7 @@ var
|
|||||||
value: Double;
|
value: Double;
|
||||||
s: String;
|
s: String;
|
||||||
begin
|
begin
|
||||||
|
try
|
||||||
workbook := TsWorkbook.Create;
|
workbook := TsWorkbook.Create;
|
||||||
try
|
try
|
||||||
worksheet := workbook.AddWorksheet('VirtualMode');
|
worksheet := workbook.AddWorksheet('VirtualMode');
|
||||||
@@ -410,7 +413,6 @@ begin
|
|||||||
workbook.Free;
|
workbook.Free;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
if AFormat <> sfOOXML then begin // No reader support for OOXML
|
|
||||||
workbook := TsWorkbook.Create;
|
workbook := TsWorkbook.Create;
|
||||||
try
|
try
|
||||||
workbook.ReadFromFile(tempFile, AFormat);
|
workbook.ReadFromFile(tempFile, AFormat);
|
||||||
@@ -433,9 +435,10 @@ begin
|
|||||||
finally
|
finally
|
||||||
workbook.Free;
|
workbook.Free;
|
||||||
end;
|
end;
|
||||||
end;
|
|
||||||
|
|
||||||
|
finally
|
||||||
DeleteFile(tempFile);
|
DeleteFile(tempFile);
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TSpreadInternalTests.TestVirtualMode_BIFF2;
|
procedure TSpreadInternalTests.TestVirtualMode_BIFF2;
|
||||||
@@ -453,6 +456,11 @@ begin
|
|||||||
TestVirtualMode(sfExcel8, false);
|
TestVirtualMode(sfExcel8, false);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TSpreadInternalTests.TestVirtualMode_ODS;
|
||||||
|
begin
|
||||||
|
TestVirtualMode(sfOpenDocument, false);
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TSpreadInternalTests.TestVirtualMode_OOXML;
|
procedure TSpreadInternalTests.TestVirtualMode_OOXML;
|
||||||
begin
|
begin
|
||||||
TestVirtualMode(sfOOXML, false);
|
TestVirtualMode(sfOOXML, false);
|
||||||
@@ -472,11 +480,17 @@ procedure TSpreadInternalTests.TestVirtualMode_BIFF8_BufStream;
|
|||||||
begin
|
begin
|
||||||
TestVirtualMode(sfExcel8, true);
|
TestVirtualMode(sfExcel8, true);
|
||||||
end;
|
end;
|
||||||
|
(*
|
||||||
|
procedure TSpreadInternalTests.TestVirtualMode_ODS_BufStream;
|
||||||
|
begin
|
||||||
|
TestVirtualMode(sfOpenDocument, true);
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TSpreadInternalTests.TestVirtualMode_OOXML_BufStream;
|
procedure TSpreadInternalTests.TestVirtualMode_OOXML_BufStream;
|
||||||
begin
|
begin
|
||||||
TestVirtualMode(sfOOXML, true);
|
TestVirtualMode(sfOOXML, true);
|
||||||
end;
|
end;
|
||||||
|
*)
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
// Register so these tests are included in a full run
|
// Register so these tests are included in a full run
|
||||||
|
@@ -55,7 +55,7 @@ begin
|
|||||||
if FileExists(Result) then
|
if FileExists(Result) then
|
||||||
begin
|
begin
|
||||||
DeleteFile(Result);
|
DeleteFile(Result);
|
||||||
sleep(40); //e.g. on Windows, give file system chance to perform changes
|
sleep(50); //e.g. on Windows, give file system chance to perform changes
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
Reference in New Issue
Block a user