fpspreadsheet: Support reading of font from xlsx files. Add unit tests, 3 fails related to font color.

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

components/fpspreadsheet/fpsopendocument.pas

@@ -114,6 +114,7 @@ type
     procedure ReadFormula(ARow, ACol: Word; ACellNode: TDOMNode); reintroduce;
     procedure ReadLabel(ARow, ACol: Word; ACellNode: TDOMNode); reintroduce;
     procedure ReadNumber(ARow, ACol: Word; ACellNode: TDOMNode); reintroduce;
+
   public
     { General reading methods }
     constructor Create(AWorkbook: TsWorkbook); override;
@@ -1199,12 +1200,12 @@ begin
   //unzip files into AFileName path
   FilePath := GetTempDir(false);
   UnZip := TUnZipper.Create;
-  UnZip.OutputPath := FilePath;
   FileList := TStringList.Create;
+  try
     FileList.Add('styles.xml');
     FileList.Add('content.xml');
     FileList.Add('settings.xml');
-  try
+    UnZip.OutputPath := FilePath;
     Unzip.UnZipFiles(AFileName,FileList);
   finally
     FreeAndNil(FileList);

components/fpspreadsheet/fpspreadsheet.pas

@@ -806,6 +806,7 @@ type
       AStyle: TsFontStyles; AColor: TsColor): Integer; overload;
     function AddFont(const AFont: TsFont): Integer; overload;
     procedure CopyFontList(ASource: TFPList);
+    procedure DeleteFont(AFontIndex: Integer);
     function FindFont(const AFontName: String; ASize: Single;
       AStyle: TsFontStyles; AColor: TsColor): Integer;
     function GetDefaultFont: TsFont;
@@ -4366,7 +4367,7 @@ end;
 {@@
   Reads the document from a file. This method will try to guess the format from
   the extension. In the case of the ambiguous xls extension, it will simply
-  assume that it is BIFF8. Note that it could be BIFF2, 3, 4 or 5 too.
+  assume that it is BIFF8. Note that it could be BIFF2 or 5 as well.
 }
 procedure TsWorkbook.ReadFromFile(AFileName: string); overload;
 var
@@ -4711,6 +4712,23 @@ begin
   end;
 end;
 
+{@@
+  Deletes a font.
+  Use with caution because this will screw up the font assignment to cells.
+  The only legal reason to call this method is from a reader of a file format
+  in which the missing font #4 of BIFF does exist.
+}
+procedure TsWorkbook.DeleteFont(AFontIndex: Integer);
+var
+  fnt: TsFont;
+begin
+  if AFontIndex < FFontList.Count then begin
+    fnt := TsFont(FFontList.Items[AFontIndex]);
+    if fnt <> nil then fnt.Free;
+    FFontList.Delete(AFontIndex);
+  end;
+end;
+
 {@@
   Checks whether the font with the given specification is already contained in
   the font list. Returns the index, or -1 if not found.
@@ -4788,6 +4806,7 @@ begin
     fnt.Free;
     FFontList.Delete(i);
   end;
+  FBuiltinFontCount := 0;
 end;
 
 {@@

components/fpspreadsheet/laz_fpspreadsheet.lpk

@@ -16,6 +16,11 @@
           <UseAnsiStrings Value="False"/>
         </SyntaxOptions>
       </Parsing>
+      <Linking>
+        <Debugging>
+          <UseExternalDbgSyms Value="True"/>
+        </Debugging>
+      </Linking>
       <Other>
         <CustomOptions Value="$(IDEBuildOptions)"/>
       </Other>

components/fpspreadsheet/tests/colortests.pas

@@ -67,6 +67,19 @@ type
     procedure TestWriteRead_ODS_Font_Biff8Pal;             // official biff8 palette in BIFF8 file format
     procedure TestWriteRead_ODS_Font_RandomPal;            // palette 64, top 56 entries random
 
+    { OpenDocument file format tests }
+    // Background colors...
+    (*
+    procedure TestWriteRead_OOXML_Background_InternalPal;  // internal palette
+    procedure TestWriteRead_OOXML_Background_Biff5Pal;     // official biff5 palette
+    procedure TestWriteRead_OOXML_Background_Biff8Pal;     // official biff8 palette
+    procedure TestWriteRead_OOXML_Background_RandomPal;    // palette 64, top 56 entries random
+    *)
+    // Font colors...
+    procedure TestWriteRead_OOXML_Font_InternalPal;        // internal palette for BIFF8 file format
+    procedure TestWriteRead_OOXML_Font_Biff5Pal;           // official biff5 palette in BIFF8 file format
+    procedure TestWriteRead_OOXML_Font_Biff8Pal;           // official biff8 palette in BIFF8 file format
+    procedure TestWriteRead_OOXML_Font_RandomPal;          // palette 64, top 56 entries random
   end;
 
 implementation
@@ -388,6 +401,48 @@ begin
   TestWriteReadFontColors(sfOpenDocument, 999);
 end;
 
+{ Tests for OOXML file format }
+(*
+procedure TSpreadWriteReadColorTests.TestWriteRead_OOXML_Background_InternalPal;
+begin
+  TestWriteReadBackgroundColors(sfOOXML, 0);
+end;
+
+procedure TSpreadWriteReadColorTests.TestWriteRead_OOXML_Background_Biff5Pal;
+begin
+  TestWriteReadBackgroundColors(sfOOXML, 5);
+end;
+
+procedure TSpreadWriteReadColorTests.TestWriteRead_OOXML_Background_Biff8Pal;
+begin
+  TestWriteReadBackgroundColors(sfOOXML, 8);
+end;
+
+procedure TSpreadWriteReadColorTests.TestWriteRead_OOXML_Background_RandomPal;
+begin
+  TestWriteReadBackgroundColors(sfOOXML, 999);
+end;
+  *)
+procedure TSpreadWriteReadColorTests.TestWriteRead_OOXML_Font_InternalPal;
+begin
+  TestWriteReadFontColors(sfOOXML, 0);
+end;
+
+procedure TSpreadWriteReadColorTests.TestWriteRead_OOXML_Font_Biff5Pal;
+begin
+  TestWriteReadFontColors(sfOOXML, 5);
+end;
+
+procedure TSpreadWriteReadColorTests.TestWriteRead_OOXML_Font_Biff8Pal;
+begin
+  TestWriteReadFontColors(sfOOXML, 8);
+end;
+
+procedure TSpreadWriteReadColorTests.TestWriteRead_OOXML_Font_RandomPal;
+begin
+  TestWriteReadFontColors(sfOOXML, 999);
+end;
+
 
 initialization
   RegisterTest(TSpreadWriteReadColorTests);

components/fpspreadsheet/tests/fonttests.pas

@@ -60,6 +60,12 @@ type
     procedure TestWriteRead_ODS_Font_Arial;
     procedure TestWriteRead_ODS_Font_TimesNewRoman;
     procedure TestWriteRead_ODS_Font_CourierNew;
+
+    // OOXML test cases
+    procedure TestWriteRead_OOXML_Bold;
+    procedure TestWriteRead_OOXML_Font_Arial;
+    procedure TestWriteRead_OOXML_Font_TimesNewRoman;
+    procedure TestWriteRead_OOXML_Font_CourierNew;
   end;
 
 implementation
@@ -139,7 +145,7 @@ begin
   MyWorkbook := TsWorkbook.Create;
   MyWorkSheet:= MyWorkBook.AddWorksheet(FontSheet);
 
-  // Write out a cell without "bold"formatting style
+  // Write out a cell without "bold" formatting style
   row := 0;
   col := 0;
   MyWorksheet.WriteUTF8Text(row, col, 'not bold');
@@ -149,7 +155,7 @@ begin
   CheckEquals(uffBold in MyCell^.UsedFormattingFields, false,
     'Test unsaved bold attribute, cell '+CellNotation(MyWorksheet,Row,Col));
 
-  // Write out a cell with "bold"formatting style
+  // Write out a cell with "bold" formatting style
   inc(row);
   MyWorksheet.WriteUTF8Text(row, col, 'bold');
   MyWorksheet.WriteUsedFormatting(row, col, [uffBold]);
@@ -163,7 +169,7 @@ begin
   MyWorkBook.WriteToFile(TempFile, AFormat, true);
   MyWorkbook.Free;
 
-  // Open the spreadsheet, as biff8
+  // Open the spreadsheet
   MyWorkbook := TsWorkbook.Create;
   MyWorkbook.ReadFromFile(TempFile, AFormat);
   if AFormat = sfExcel2 then
@@ -194,26 +200,6 @@ begin
   DeleteFile(TempFile);
 end;
 
-procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF2_Bold;
-begin
-  TestWriteReadBold(sfExcel2);
-end;
-
-procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF5_Bold;
-begin
-  TestWriteReadBold(sfExcel5);
-end;
-
-procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF8_Bold;
-begin
-  TestWriteReadBold(sfExcel8);
-end;
-
-procedure TSpreadWriteReadFontTests.TestWriteRead_ODS_Bold;
-begin
-  TestWriteReadBold(sfOpenDocument);
-end;
-
 procedure TSpreadWriteReadFontTests.TestWriteReadFont(AFormat: TsSpreadsheetFormat;
   AFontName: String);
 var
@@ -261,7 +247,7 @@ begin
   MyWorkBook.WriteToFile(TempFile, AFormat, true);
   MyWorkbook.Free;
 
-  // Open the spreadsheet, as biff8
+  // Open the spreadsheet
   MyWorkbook := TsWorkbook.Create;
   MyWorkbook.ReadFromFile(TempFile, AFormat);
   if AFormat = sfExcel2 then
@@ -295,6 +281,12 @@ begin
 end;
 
 { BIFF2 }
+
+procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF2_Bold;
+begin
+  TestWriteReadBold(sfExcel2);
+end;
+
 procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF2_Font_Arial;
 begin
   TestWriteReadFont(sfExcel2, 'Arial');
@@ -311,6 +303,11 @@ begin
 end;
 
 { BIFF5 }
+procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF5_Bold;
+begin
+  TestWriteReadBold(sfExcel5);
+end;
+
 procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF5_Font_Arial;
 begin
   TestWriteReadFont(sfExcel5, 'Arial');
@@ -327,6 +324,11 @@ begin
 end;
 
 { BIFF8 }
+procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF8_Bold;
+begin
+  TestWriteReadBold(sfExcel8);
+end;
+
 procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF8_Font_Arial;
 begin
   TestWriteReadFont(sfExcel8, 'Arial');
@@ -343,6 +345,11 @@ begin
 end;
 
 { ODS }
+procedure TSpreadWriteReadFontTests.TestWriteRead_ODS_Bold;
+begin
+  TestWriteReadBold(sfOpenDocument);
+end;
+
 procedure TSpreadWriteReadFontTests.TestWriteRead_ODS_Font_Arial;
 begin
   TestWriteReadFont(sfOpenDocument, 'Arial');
@@ -358,6 +365,26 @@ begin
   TestWriteReadFont(sfOpenDocument, 'Courier New');
 end;
 
+{ OOXML }
+procedure TSpreadWriteReadFontTests.TestWriteRead_OOXML_Bold;
+begin
+  TestWriteReadBold(sfOOXML);
+end;
+
+procedure TSpreadWriteReadFontTests.TestWriteRead_OOXML_Font_Arial;
+begin
+  TestWriteReadFont(sfOOXML, 'Arial');
+end;
+
+procedure TSpreadWriteReadFontTests.TestWriteRead_OOXML_Font_TimesNewRoman;
+begin
+  TestWriteReadFont(sfOOXML, 'Times New Roman');
+end;
+
+procedure TSpreadWriteReadFontTests.TestWriteRead_OOXML_Font_CourierNew;
+begin
+  TestWriteReadFont(sfOOXML, 'Courier New');
+end;
 
 initialization
   RegisterTest(TSpreadWriteReadFontTests);

components/fpspreadsheet/tests/spreadtestgui.lpi

@@ -112,10 +112,12 @@
       <Unit8>
         <Filename Value="colortests.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="colortests"/>
       </Unit8>
       <Unit9>
         <Filename Value="fonttests.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="fonttests"/>
       </Unit9>
       <Unit10>
         <Filename Value="optiontests.pas"/>

components/fpspreadsheet/xlsxooxml.pas

@@ -64,9 +64,11 @@ type
     FXfList: TFPList;
     FFillList: TFPList;
     FBorderList: TFPList;
+    FWrittenByFPS: Boolean;
     procedure ReadCell(ANode: TDOMNode; AWorksheet: TsWorksheet);
     procedure ReadCellXfs(ANode: TDOMNode);
     procedure ReadDateMode(ANode: TDOMNode);
+    procedure ReadFileVersion(ANode: TDOMNode);
     procedure ReadFont(ANode: TDOMNode);
     procedure ReadFonts(ANode: TDOMNode);
     procedure ReadNumFormats(ANode: TDOMNode);
@@ -517,6 +519,11 @@ begin
   end;
 end;
 
+procedure TsSpreadOOXMLReader.ReadFileVersion(ANode: TDOMNode);
+begin
+  FWrittenByFPS := GetAttrValue(ANode, 'appName') = 'fpspreadsheet';
+end;
+
 procedure TsSpreadOOXMLReader.ReadFont(ANode: TDOMNode);
 var
   node: TDOMNode;
@@ -530,16 +537,23 @@ var
   s: String;
 begin
   fnt := Workbook.GetDefaultFont;
+  if fnt <> nil then begin
     fntName := fnt.FontName;
     fntSize := fnt.Size;
-  fntStyles := [];
+    fntStyles := fnt.Style;
     fntColor := fnt.Color;
+  end else begin
+    fntName := 'Arial';
+    fntSize := 10;
+    fntStyles := [];
+    fntColor := scBlack;
+  end;
 
   node := ANode.FirstChild;
   while node <> nil do begin
     nodename := node.NodeName;
     if nodename = 'name' then begin
-      s := GetAttrValue(ANode, 'val');
+      s := GetAttrValue(node, 'val');
       if s <> '' then fntName := s;
     end
     else
@@ -549,27 +563,27 @@ begin
     end
     else
     if nodename = 'b' then begin
-      if GetAttrValue(ANode, 'val') <> 'false'
+      if GetAttrValue(node, 'val') <> 'false'
         then fntStyles := fntStyles + [fssBold];
     end
     else
     if nodename = 'i' then begin
-      if GetAttrValue(ANode, 'val') <> 'false'
+      if GetAttrValue(node, 'val') <> 'false'
         then fntStyles := fntStyles + [fssItalic];
     end
     else
     if nodename = 'u' then begin
-      if GetAttrValue(ANode, 'val') <> 'false'
+      if GetAttrValue(node, 'val') <> 'false'
         then fntStyles := fntStyles+ [fssUnderline]
     end
     else
     if nodename = 'strike' then begin
-      if GetAttrValue(ANode, 'val') <> 'false'
+      if GetAttrValue(node, 'val') <> 'false'
         then fntStyles := fntStyles + [fssStrikeout];
     end
     else
     if nodename = 'color' then begin
-      s := GetAttrValue(ANode, 'rgb');
+      s := GetAttrValue(node, 'rgb');
       if s <> '' then
         fntColor := FWorkbook.AddColorToPalette(HTMLColorStrToColor('#' + s));
     end;
@@ -583,12 +597,29 @@ end;
 procedure TsSpreadOOXMLReader.ReadFonts(ANode: TDOMNode);
 var
   node: TDOMNode;
+  n: Integer;
 begin
+  // Clear existing fonts. They will be replaced by those from the file.
+  FWorkbook.RemoveAllFonts;
+
   node := ANode.FirstChild;
   while node <> nil do begin
     ReadFont(node);
     node := node.NextSibling;
   end;
+
+  n := FWorkbook.GetFontCount;
+
+  { A problem is caused by the font #4 which is missing in BIFF file versions.
+    FPSpreadsheet writes a nil value to this position in order to keep compatibility
+    with other file formats. Other applications, however, have a valid font at
+    this index. Therefore, we delete the font #4 if the file was not written
+    by FPSpreadsheet. }
+  if not FWrittenByFPS then
+    FWorkbook.DeleteFont(4);
+
+  n := FWorkbook.GetFontCount;
+
 end;
 
 procedure TsSpreadOOXMLReader.ReadNumFormats(ANode: TDOMNode);
@@ -703,6 +734,16 @@ begin
       FreeAndNil(Doc);
     end;
 
+    // process the workbook.xml file
+    if not FileExists(FilePath + OOXML_PATH_XL_WORKBOOK) then
+      raise Exception.Create('Defective internal structure of xlsx file');
+    ReadXMLFile(Doc, FilePath + OOXML_PATH_XL_WORKBOOK);
+    DeleteFile(FilePath + OOXML_PATH_XL_WORKBOOK);
+    ReadFileVersion(Doc.DocumentElement.FindNode('fileVersion'));
+    ReadDateMode(Doc.DocumentElement.FindNode('workbookPr'));
+    ReadSheetList(Doc.DocumentElement.FindNode('sheets'), SheetList);
+    FreeAndNil(Doc);
+
     // process the styles.xml file
     if FileExists(FilePath + OOXML_PATH_XL_STYLES) then begin // should always exist, just to make sure...
       ReadXMLFile(Doc, FilePath + OOXML_PATH_XL_STYLES);
@@ -713,14 +754,6 @@ begin
       FreeAndNil(Doc);
     end;
 
-    // process the workbook.xml file
-    ReadXMLFile(Doc, FilePath + OOXML_PATH_XL_WORKBOOK);
-    DeleteFile(FilePath + OOXML_PATH_XL_WORKBOOK);
-    ReadDateMode(Doc.DocumentElement.FindNode('workbookPr'));
-    ReadSheetList(Doc.DocumentElement.FindNode('sheets'), SheetList);
-
-    FreeAndNil(Doc);
-
     // read worksheets
     for i:=0 to SheetList.Count-1 do begin
 
@@ -1377,7 +1410,6 @@ begin
   for i:=1 to Workbook.GetWorksheetCount do
     AppendToStream(FSWorkbook, Format(
         '<sheet name="%s" sheetId="%d" r:id="rId%d" />', [Workbook.GetWorksheetByIndex(i-1).Name, i, i+2]));
-    //        '<sheet name="Sheet%d" sheetId="%d" r:id="rId%d" />', [i, i, i+2]));
   AppendToStream(FSWorkbook,
       '</sheets>');
   AppendToStream(FSWorkbook,
@@ -1566,7 +1598,7 @@ begin
 
   // Footer
   AppendToStream(FSSheets[FCurSheetNum],
-      '</sheetData>',
+      '</sheetData>' +
     '</worksheet>');
 end;