fpspreadsheet: Support for column widths and row heights of xlsx reader. Extend unit tests --> passed. Add "debug with heaptrc" build mode to spreadtestgui (--> there is an unfixed memory leak in fpsfunc).

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3418 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/fpsfunc.pas

@@ -184,7 +184,7 @@ function fpsVALUE       (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
 implementation
 
 uses
-  Math, lazutf8, StrUtils, DateUtils, fpsUtils;
+  Math, lazutf8, DateUtils, fpsUtils;
 
 
 { Helpers }

components/fpspreadsheet/tests/formattests.pas

@@ -122,6 +122,8 @@ type
     procedure TestWriteRead_OOXML_Alignment;
     procedure TestWriteRead_OOXML_Border;
     procedure TestWriteRead_OOXML_BorderStyles;
+    procedure TestWriteRead_OOXML_ColWidths;
+    procedure TestWriteRead_OOXML_RowHeights;
     procedure TestWriteRead_OOXML_DateTimeFormats;
     procedure TestWriteRead_OOXML_NumberFormats;
     procedure TestWriteRead_OOXML_TextRotation;
@@ -934,6 +936,12 @@ begin
   TestWriteReadColWidths(sfOpenDocument);
 end;
 
+procedure TSpreadWriteReadFormatTests.TestWriteRead_OOXML_ColWidths;
+begin
+  TestWriteReadColWidths(sfOOXML);
+end;
+
+
 { --- Row height tests --- }
 
 procedure TSpreadWriteReadFormatTests.TestWriteReadRowHeights(AFormat: TsSpreadsheetFormat);
@@ -1005,6 +1013,11 @@ begin
   TestWriteReadRowHeights(sfOpenDocument);
 end;
 
+procedure TSpreadWriteReadFormatTests.TestWriteRead_OOXML_RowHeights;
+begin
+  TestWriteReadRowHeights(sfOOXML);
+end;
+
 
 { --- Text rotation tests --- }
 

components/fpspreadsheet/tests/formulatests.pas

@@ -87,38 +87,43 @@ begin
 
   // Create test workbook
   MyWorkbook := TsWorkbook.Create;
-  MyWorkSheet:= MyWorkBook.AddWorksheet(SHEET);
+  try
+    MyWorkSheet:= MyWorkBook.AddWorksheet(SHEET);
 
-  // Write out all test formulas
+    // Write out all test formulas
-  // All formulas are in column B
+    // All formulas are in column B
-  WriteRPNFormulaSamples(MyWorksheet, AFormat, true);
+    WriteRPNFormulaSamples(MyWorksheet, AFormat, true);
-  MyWorkBook.WriteToFile(TempFile, AFormat, true);
+    MyWorkBook.WriteToFile(TempFile, AFormat, true);
-  MyWorkbook.Free;
+  finally
+    MyWorkbook.Free;
+  end;
 
   // Open the spreadsheet
   MyWorkbook := TsWorkbook.Create;
-  MyWorkbook.ReadFormulas := true;
+  try
+    MyWorkbook.ReadFormulas := true;
 
-  MyWorkbook.ReadFromFile(TempFile, AFormat);
+    MyWorkbook.ReadFromFile(TempFile, AFormat);
-  if AFormat = sfExcel2 then
+    if AFormat = sfExcel2 then
-    MyWorksheet := MyWorkbook.GetFirstWorksheet
+      MyWorksheet := MyWorkbook.GetFirstWorksheet
-  else
+    else
-    MyWorksheet := GetWorksheetByName(MyWorkBook, SHEET);
+      MyWorksheet := GetWorksheetByName(MyWorkBook, SHEET);
-  if MyWorksheet=nil then
+    if MyWorksheet=nil then
-    fail('Error in test code. Failed to get named worksheet');
+      fail('Error in test code. Failed to get named worksheet');
-  for Row := 0 to MyWorksheet.GetLastRowIndex do
+    for Row := 0 to MyWorksheet.GetLastRowIndex do
-  begin
+    begin
-    cell := MyWorksheet.FindCell(Row, 1);
+      cell := MyWorksheet.FindCell(Row, 1);
-    if (cell <> nil) and (Length(cell^.RPNFormulaValue) > 0) then begin
+      if (cell <> nil) and (Length(cell^.RPNFormulaValue) > 0) then begin
-      actual := MyWorksheet.ReadRPNFormulaAsString(cell);
+        actual := MyWorksheet.ReadRPNFormulaAsString(cell);
-      expected := MyWorksheet.ReadAsUTF8Text(Row, 0);
+        expected := MyWorksheet.ReadAsUTF8Text(Row, 0);
-      CheckEquals(expected, actual, 'Test read formula mismatch, cell '+CellNotation(MyWorkSheet,Row,1));
+        CheckEquals(expected, actual, 'Test read formula mismatch, cell '+CellNotation(MyWorkSheet,Row,1));
+      end;
     end;
-  end;
 
-  // Finalization
+  finally
-  MyWorkbook.Free;
+    MyWorkbook.Free;
-  DeleteFile(TempFile);
+    DeleteFile(TempFile);
+  end;
 end;
 
 procedure TSpreadWriteReadFormulaTests.TestWriteRead_BIFF2_FormulaStrings;
@@ -174,94 +179,99 @@ begin
 
   // Create test workbook
   MyWorkbook := TsWorkbook.Create;
-  MyWorkSheet:= MyWorkBook.AddWorksheet(SHEET);
+  try
-  MyWorkSheet.Options := MyWorkSheet.Options + [soCalcBeforeSaving];
+    MyWorkSheet:= MyWorkBook.AddWorksheet(SHEET);
-  // Calculation of rpn formulas must be activated explicitly!
+    MyWorkSheet.Options := MyWorkSheet.Options + [soCalcBeforeSaving];
+    // Calculation of rpn formulas must be activated explicitly!
 
-  { Write out test formulas.
+    { Write out test formulas.
-    This include file creates various rpn formulas and stores the expected
+      This include file creates various rpn formulas and stores the expected
-    results in array "sollValues".
+      results in array "sollValues".
-    The test file contains the text representation in column A, and the
+      The test file contains the text representation in column A, and the
-    formula in column B. }
+      formula in column B. }
-  Row := 0;
+    Row := 0;
-  {$I testcases_calcrpnformula.inc}
+    {$I testcases_calcrpnformula.inc}
-  TempFile:=GetTempFileName;
+    TempFile:=GetTempFileName;
-  MyWorkBook.WriteToFile(TempFile, AFormat, true);
+    MyWorkBook.WriteToFile(TempFile, AFormat, true);
-  MyWorkbook.Free;
+  finally
+    MyWorkbook.Free;
+  end;
 
   // Open the workbook
   MyWorkbook := TsWorkbook.Create;
-  MyWorkbook.ReadFromFile(TempFile, AFormat);
+  try
-  if AFormat = sfExcel2 then
+    MyWorkbook.ReadFromFile(TempFile, AFormat);
-    MyWorksheet := MyWorkbook.GetFirstWorksheet
+    if AFormat = sfExcel2 then
-  else
+      MyWorksheet := MyWorkbook.GetFirstWorksheet
-    MyWorksheet := GetWorksheetByName(MyWorkBook, SHEET);
+    else
-  if MyWorksheet=nil then
+      MyWorksheet := GetWorksheetByName(MyWorkBook, SHEET);
-    fail('Error in test code. Failed to get named worksheet');
+    if MyWorksheet=nil then
+      fail('Error in test code. Failed to get named worksheet');
 
-  for Row := 0 to MyWorksheet.GetLastRowIndex do
+    for Row := 0 to MyWorksheet.GetLastRowIndex do
-  begin
+    begin
-    formula := MyWorksheet.ReadAsUTF8Text(Row, 0);
+      formula := MyWorksheet.ReadAsUTF8Text(Row, 0);
-    cell := MyWorksheet.FindCell(Row, 1);
+      cell := MyWorksheet.FindCell(Row, 1);
-    if (cell = nil) then
+      if (cell = nil) then
-      fail('Error in test code: Failed to get cell ' + CellNotation(MyWorksheet, Row, 1));
+        fail('Error in test code: Failed to get cell ' + CellNotation(MyWorksheet, Row, 1));
-    case cell^.ContentType of
+      case cell^.ContentType of
-      cctBool       : actual := CreateBoolArg(cell^.BoolValue);
+        cctBool       : actual := CreateBoolArg(cell^.BoolValue);
-      cctNumber     : actual := CreateNumberArg(cell^.NumberValue);
+        cctNumber     : actual := CreateNumberArg(cell^.NumberValue);
-      cctError      : actual := CreateErrorArg(cell^.ErrorValue);
+        cctError      : actual := CreateErrorArg(cell^.ErrorValue);
-      cctUTF8String : actual := CreateStringArg(cell^.UTF8StringValue);
+        cctUTF8String : actual := CreateStringArg(cell^.UTF8StringValue);
-      else            fail('ContentType not supported');
+        else            fail('ContentType not supported');
-    end;
+      end;
-    expected := SollValues[row];
+      expected := SollValues[row];
-    CheckEquals(ord(expected.ArgumentType), ord(actual.ArgumentType),
+      CheckEquals(ord(expected.ArgumentType), ord(actual.ArgumentType),
-      'Test read calculated formula data type mismatch, formula "' + formula +
+        'Test read calculated formula data type mismatch, formula "' + formula +
-      '", cell '+CellNotation(MyWorkSheet,Row,1));
+        '", cell '+CellNotation(MyWorkSheet,Row,1));
 
-    // The now function result is volatile, i.e. changes continuously. The
+      // The now function result is volatile, i.e. changes continuously. The
-    // time for the soll value was created such that we can expect to have
+      // time for the soll value was created such that we can expect to have
-    // the file value in the same second. Therefore we neglect the milliseconds.
+      // the file value in the same second. Therefore we neglect the milliseconds.
-    if formula = '=NOW()' then begin
+      if formula = '=NOW()' then begin
-      // Round soll value to seconds
+        // Round soll value to seconds
-      DecodeTime(expected.NumberValue, hr,min,sec,msec);
+        DecodeTime(expected.NumberValue, hr,min,sec,msec);
-      expected.NumberValue := EncodeTime(hr, min, sec, 0);
+        expected.NumberValue := EncodeTime(hr, min, sec, 0);
-      // Round formula value to seconds
+        // Round formula value to seconds
-      DecodeTime(actual.NumberValue, hr,min,sec,msec);
+        DecodeTime(actual.NumberValue, hr,min,sec,msec);
-      actual.NumberValue := EncodeTime(hr,min,sec,0);
+        actual.NumberValue := EncodeTime(hr,min,sec,0);
+      end;
+
+      case actual.ArgumentType of
+        atBool:
+          CheckEquals(BoolToStr(expected.BoolValue), BoolToStr(actual.BoolValue),
+            'Test read calculated formula result mismatch, formula "' + formula +
+            '", cell '+CellNotation(MyWorkSheet,Row,1));
+        atNumber:
+          {$if (defined(mswindows)) or (FPC_FULLVERSION>=20701)}
+          // FPC 2.6.x and trunk on Windows need this, also FPC trunk on Linux x64
+          CheckEquals(expected.NumberValue, actual.NumberValue, ErrorMargin,
+            'Test read calculated formula result mismatch, formula "' + formula +
+            '", cell '+CellNotation(MyWorkSheet,Row,1));
+          {$else}
+          // Non-Windows: test without error margin
+          CheckEquals(expected.NumberValue, actual.NumberValue,
+            'Test read calculated formula result mismatch, formula "' + formula +
+            '", cell '+CellNotation(MyWorkSheet,Row,1));
+          {$endif}
+        atString:
+          CheckEquals(expected.StringValue, actual.StringValue,
+            'Test read calculated formula result mismatch, formula "' + formula +
+            '", cell '+CellNotation(MyWorkSheet,Row,1));
+        atError:
+          CheckEquals(
+            GetEnumName(TypeInfo(TsErrorValue), ord(expected.ErrorValue)),
+            GetEnumname(TypeInfo(TsErrorValue), ord(actual.ErrorValue)),
+            'Test read calculated formula error value mismatch, formula ' + formula +
+            ', cell '+CellNotation(MyWorkSheet,Row,1));
+      end;
     end;
 
-    case actual.ArgumentType of
+  finally
-      atBool:
+    MyWorkbook.Free;
-        CheckEquals(BoolToStr(expected.BoolValue), BoolToStr(actual.BoolValue),
+    DeleteFile(TempFile);
-          'Test read calculated formula result mismatch, formula "' + formula +
-          '", cell '+CellNotation(MyWorkSheet,Row,1));
-      atNumber:
-        {$if (defined(mswindows)) or (FPC_FULLVERSION>=20701)}
-        // FPC 2.6.x and trunk on Windows need this, also FPC trunk on Linux x64
-        CheckEquals(expected.NumberValue, actual.NumberValue, ErrorMargin,
-          'Test read calculated formula result mismatch, formula "' + formula +
-          '", cell '+CellNotation(MyWorkSheet,Row,1));
-        {$else}
-        // Non-Windows: test without error margin
-        CheckEquals(expected.NumberValue, actual.NumberValue,
-          'Test read calculated formula result mismatch, formula "' + formula +
-          '", cell '+CellNotation(MyWorkSheet,Row,1));
-        {$endif}
-      atString:
-        CheckEquals(expected.StringValue, actual.StringValue,
-          'Test read calculated formula result mismatch, formula "' + formula +
-          '", cell '+CellNotation(MyWorkSheet,Row,1));
-      atError:
-        CheckEquals(
-          GetEnumName(TypeInfo(TsErrorValue), ord(expected.ErrorValue)),
-          GetEnumname(TypeInfo(TsErrorValue), ord(actual.ErrorValue)),
-          'Test read calculated formula error value mismatch, formula ' + formula +
-          ', cell '+CellNotation(MyWorkSheet,Row,1));
-    end;
   end;
-
-  // Finalization
-  MyWorkbook.Free;
-  DeleteFile(TempFile);
 end;
 
 procedure TSpreadWriteReadFormulaTests.TestWriteRead_BIFF2_CalcRPNFormula;

components/fpspreadsheet/xlsxooxml.pas

@@ -68,6 +68,7 @@ type
     procedure ReadBorders(ANode: TDOMNode);
     procedure ReadCell(ANode: TDOMNode; AWorksheet: TsWorksheet);
     procedure ReadCellXfs(ANode: TDOMNode);
+    procedure ReadCols(ANode: TDOMNode; AWorksheet: TsWorksheet);
     procedure ReadDateMode(ANode: TDOMNode);
     procedure ReadFileVersion(ANode: TDOMNode);
     procedure ReadFills(ANode: TDOMNode);
@@ -75,6 +76,7 @@ type
     procedure ReadFonts(ANode: TDOMNode);
     procedure ReadNumFormats(ANode: TDOMNode);
     procedure ReadPalette(ANode: TDOMNode);
+    procedure ReadRowHeight(ANode: TDOMNode; AWorksheet: TsWorksheet);
     procedure ReadSharedStrings(ANode: TDOMNode);
     procedure ReadSheetList(ANode: TDOMNode; AList: TStrings);
     procedure ReadWorksheet(ANode: TDOMNode; AWorksheet: TsWorksheet);
@@ -688,6 +690,35 @@ begin
   end;
 end;
 
+procedure TsSpreadOOXMLReader.ReadCols(ANode: TDOMNode; AWorksheet: TsWorksheet);
+var
+  colNode: TDOMNode;
+  col, col1, col2: Cardinal;
+  w: Double;
+  s: String;
+begin
+  if ANode = nil then
+    exit;
+
+  colNode := ANode.FirstChild;
+  while Assigned(colNode) do begin
+    s := GetAttrValue(colNode, 'customWidth');
+    if s = '1' then begin
+      s := GetAttrValue(colNode, 'min');
+      if s <> '' then col1 := StrToInt(s)-1 else col1 := 0;
+      s := GetAttrValue(colNode, 'max');
+      if s <> '' then col2 := StrToInt(s)-1 else col2 := col1;
+      s := GetAttrValue(colNode, 'width');
+      if s <> '' then begin
+        w := StrToFloat(s, FPointSeparatorSettings);
+        for col := col1 to col2 do
+          FWorksheet.WriteColWidth(col, w);
+      end;
+    end;
+    colNode := colNode.NextSibling;
+  end;
+end;
+
 procedure TsSpreadOOXMLReader.ReadDateMode(ANode: TDOMNode);
 var
   s: String;
@@ -929,6 +960,30 @@ begin
   FWorkbook.UsePalette(@pal[0], n);
 end;
 
+procedure TsSpreadOOXMLReader.ReadRowHeight(ANode: TDOMNode; AWorksheet: TsWorksheet);
+var
+  s: String;
+  ht: Single;
+  r: Cardinal;
+  row: PRow;
+begin
+  if ANode = nil then
+    exit;
+  s := GetAttrValue(ANode, 'customHeight');
+  if s = '1' then begin
+    s := GetAttrValue(ANode, 'r');
+    r := StrToInt(s) - 1;
+    s := GetAttrValue(ANode, 'ht');
+    ht := StrToFloat(s, FPointSeparatorSettings);    // seems to be in "Points"
+    row := FWorksheet.GetRow(r);
+    row^.Height := ht / FWorkbook.GetDefaultFontSize;
+    if row^.Height > ROW_HEIGHT_CORRECTION then
+      row^.Height := row^.Height - ROW_HEIGHT_CORRECTION
+    else
+      row^.Height := 0;
+  end;
+end;
+
 procedure TsSpreadOOXMLReader.ReadSharedStrings(ANode: TDOMNode);
 var
   valuenode: TDOMNode;
@@ -967,6 +1022,7 @@ begin
   rownode := ANode.FirstChild;
   while Assigned(rownode) do begin
     if rownode.NodeName = 'row' then begin
+      ReadRowHeight(rownode, AWorksheet);
       cellnode := rownode.FirstChild;
       while Assigned(cellnode) do begin
         if cellnode.NodeName = 'c' then
@@ -1068,6 +1124,7 @@ begin
 
       FWorksheet := AData.AddWorksheet(SheetList[i]);
 
+      ReadCols(Doc.DocumentElement.FindNode('cols'), FWorksheet);
       ReadWorksheet(Doc.DocumentElement.FindNode('sheetData'), FWorksheet);
 
       FreeAndNil(Doc);