From c575126fa0741799c82888bfcaea3e02b255a759 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Thu, 7 Aug 2014 08:43:11 +0000 Subject: [PATCH] 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 --- .../examples/other/demo_virtualmode_write.lpr | 9 +- components/fpspreadsheet/fpsopendocument.pas | 123 +++++++++++++++++- .../fpspreadsheet/tests/internaltests.pas | 50 ++++--- .../fpspreadsheet/tests/testsutility.pas | 2 +- 4 files changed, 159 insertions(+), 25 deletions(-) diff --git a/components/fpspreadsheet/examples/other/demo_virtualmode_write.lpr b/components/fpspreadsheet/examples/other/demo_virtualmode_write.lpr index f50b1ea2f..6b1f80a44 100644 --- a/components/fpspreadsheet/examples/other/demo_virtualmode_write.lpr +++ b/components/fpspreadsheet/examples/other/demo_virtualmode_write.lpr @@ -10,7 +10,7 @@ uses {$ENDIF} Classes, SysUtils, lazutf8, - variants, fpspreadsheet, xlsbiff2, xlsbiff5, xlsbiff8, xlsxooxml; + variants, fpspreadsheet, fpsallformats; type TDataProvider = class @@ -66,8 +66,8 @@ begin { These are the essential commands to activate virtual mode: } - workbook.Options := [boVirtualMode, boBufStream]; -// workbook.Options := [boVirtualMode]; +// workbook.Options := [boVirtualMode, boBufStream]; + workbook.Options := [boVirtualMode]; { boBufStream can be omitted, but is important for large files: it causes writing temporary data to a buffered file stream instead of a pure 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: } t := Now; + workbook.WriteToFile('test_virtual.ods', sfOpenDocument, true); //workbook.WriteToFile('test_virtual.xlsx', sfOOXML, true); //workbook.WriteToFile('test_virtual.xls', sfExcel8, 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; finally diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index 14234bd39..b57180c48 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -138,6 +138,7 @@ type procedure WriteRowStyles(AStream: TStream); procedure WriteRowsAndCells(AStream: TStream; ASheet: TsWorksheet); procedure WriteTableSettings(AStream: TStream); + procedure WriteVirtualCells(AStream: TStream; ASheet: TsWorksheet); function WriteBackgroundColorStyleXMLAsString(const AFormat: TCell): String; function WriteBorderStyleXMLAsString(const AFormat: TCell): String; @@ -192,7 +193,7 @@ type implementation uses - StrUtils, fpsStreams; + StrUtils, Variants, fpsStreams; const { OpenDocument general XML constants } @@ -2738,7 +2739,11 @@ begin // rows and cells // The cells need to be written in order, row by row, cell by cell - WriteRowsAndCells(AStream, CurSheet); + if (boVirtualMode in Workbook.Options) then begin + if Assigned(Workbook.OnWriteCellData) then + WriteVirtualCells(AStream, CurSheet) + end else + WriteRowsAndCells(AStream, CurSheet); // Footer AppendToStream(AStream, @@ -3476,6 +3481,120 @@ begin 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( + '', [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( + '', [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, + ''); + + // Next row + inc(r, rowsRepeated); + end; +end; + { Creates an XML string for inclusion of the wordwrap option into the written file from the wordwrap setting in the format cell. Is called from WriteStyles (via WriteStylesXMLAsString). } diff --git a/components/fpspreadsheet/tests/internaltests.pas b/components/fpspreadsheet/tests/internaltests.pas index b9e348c71..691c211d3 100644 --- a/components/fpspreadsheet/tests/internaltests.pas +++ b/components/fpspreadsheet/tests/internaltests.pas @@ -58,12 +58,14 @@ type procedure TestVirtualMode_BIFF2; procedure TestVirtualMode_BIFF5; procedure TestVirtualMode_BIFF8; + procedure TestVirtualMode_ODS; procedure TestVirtualMode_OOXML; procedure TestVirtualMode_BIFF2_BufStream; procedure TestVirtualMode_BIFF5_BufStream; procedure TestVirtualMode_BIFF8_BufStream; - procedure TestVirtualMode_OOXML_BufStream; + //procedure TestVirtualMode_ODS_BufStream; + //procedure TestVirtualMode_OOXML_BufStream; end; implementation @@ -394,23 +396,23 @@ var value: Double; s: String; begin - workbook := TsWorkbook.Create; try - worksheet := workbook.AddWorksheet('VirtualMode'); - workbook.Options := workbook.Options + [boVirtualMode]; - if ABufStreamMode then - workbook.Options := workbook.Options + [boBufStream]; - workbook.VirtualColCount := 1; - workbook.VirtualRowCount := Length(SollNumbers) + 4; - // We'll use only the first 4 SollStrings, the others cause trouble due to utf8 and formatting. - workbook.OnWriteCellData := @WriteVirtualCellDataHandler; - tempFile:=NewTempFile; - workbook.WriteToFile(tempfile, AFormat, true); - finally - workbook.Free; - end; + workbook := TsWorkbook.Create; + try + worksheet := workbook.AddWorksheet('VirtualMode'); + workbook.Options := workbook.Options + [boVirtualMode]; + if ABufStreamMode then + workbook.Options := workbook.Options + [boBufStream]; + workbook.VirtualColCount := 1; + workbook.VirtualRowCount := Length(SollNumbers) + 4; + // We'll use only the first 4 SollStrings, the others cause trouble due to utf8 and formatting. + workbook.OnWriteCellData := @WriteVirtualCellDataHandler; + tempFile:=NewTempFile; + workbook.WriteToFile(tempfile, AFormat, true); + finally + workbook.Free; + end; - if AFormat <> sfOOXML then begin // No reader support for OOXML workbook := TsWorkbook.Create; try workbook.ReadFromFile(tempFile, AFormat); @@ -433,9 +435,10 @@ begin finally workbook.Free; end; - end; - DeleteFile(tempFile); + finally + DeleteFile(tempFile); + end; end; procedure TSpreadInternalTests.TestVirtualMode_BIFF2; @@ -453,6 +456,11 @@ begin TestVirtualMode(sfExcel8, false); end; +procedure TSpreadInternalTests.TestVirtualMode_ODS; +begin + TestVirtualMode(sfOpenDocument, false); +end; + procedure TSpreadInternalTests.TestVirtualMode_OOXML; begin TestVirtualMode(sfOOXML, false); @@ -472,11 +480,17 @@ procedure TSpreadInternalTests.TestVirtualMode_BIFF8_BufStream; begin TestVirtualMode(sfExcel8, true); end; + (* +procedure TSpreadInternalTests.TestVirtualMode_ODS_BufStream; +begin + TestVirtualMode(sfOpenDocument, true); +end; procedure TSpreadInternalTests.TestVirtualMode_OOXML_BufStream; begin TestVirtualMode(sfOOXML, true); end; + *) initialization // Register so these tests are included in a full run diff --git a/components/fpspreadsheet/tests/testsutility.pas b/components/fpspreadsheet/tests/testsutility.pas index 947a519eb..adb0f2bde 100644 --- a/components/fpspreadsheet/tests/testsutility.pas +++ b/components/fpspreadsheet/tests/testsutility.pas @@ -55,7 +55,7 @@ begin if FileExists(Result) then begin 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;