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

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

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,6 +2739,10 @@ begin
 
   // rows and cells
   // 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);
 
   // Footer
@@ -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(
+        '<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
   written file from the wordwrap setting in the format cell.
   Is called from WriteStyles (via WriteStylesXMLAsString). }

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,6 +396,7 @@ var
   value: Double;
   s: String;
 begin
+  try
     workbook := TsWorkbook.Create;
     try
       worksheet := workbook.AddWorksheet('VirtualMode');
@@ -410,7 +413,6 @@ begin
       workbook.Free;
     end;
 
-  if AFormat <> sfOOXML then begin     // No reader support for OOXML
     workbook := TsWorkbook.Create;
     try
       workbook.ReadFromFile(tempFile, AFormat);
@@ -433,10 +435,11 @@ begin
     finally
       workbook.Free;
     end;
-  end;
 
+  finally
     DeleteFile(tempFile);
   end;
+end;
 
 procedure TSpreadInternalTests.TestVirtualMode_BIFF2;
 begin
@@ -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

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;