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:
wp_xxyyzz
2014-08-07 08:43:11 +00:00
parent 2fd7d0caa1
commit c575126fa0
4 changed files with 159 additions and 25 deletions

View File

@@ -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

View File

@@ -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). }

View File

@@ -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

View File

@@ -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;