diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index 4d10aabb9..8a8ee8075 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/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; - FileList.Add('styles.xml'); - FileList.Add('content.xml'); - FileList.Add('settings.xml'); try + FileList.Add('styles.xml'); + FileList.Add('content.xml'); + FileList.Add('settings.xml'); + UnZip.OutputPath := FilePath; Unzip.UnZipFiles(AFileName,FileList); finally FreeAndNil(FileList); diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index ebd8b122e..c201cdf70 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/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; {@@ diff --git a/components/fpspreadsheet/laz_fpspreadsheet.lpk b/components/fpspreadsheet/laz_fpspreadsheet.lpk index 78b5a5f17..3a43b8701 100644 --- a/components/fpspreadsheet/laz_fpspreadsheet.lpk +++ b/components/fpspreadsheet/laz_fpspreadsheet.lpk @@ -16,6 +16,11 @@ + + + + + diff --git a/components/fpspreadsheet/tests/colortests.pas b/components/fpspreadsheet/tests/colortests.pas index 800383c40..caabc928b 100644 --- a/components/fpspreadsheet/tests/colortests.pas +++ b/components/fpspreadsheet/tests/colortests.pas @@ -62,11 +62,24 @@ type procedure TestWriteRead_ODS_Background_Biff8Pal; // official biff8 palette procedure TestWriteRead_ODS_Background_RandomPal; // palette 64, top 56 entries random // Font colors... - procedure TestWriteRead_ODS_Font_InternalPal; // internal palette for BIFF8 file format - procedure TestWriteRead_ODS_Font_Biff5Pal; // official biff5 palette in BIFF8 file format - procedure TestWriteRead_ODS_Font_Biff8Pal; // official biff8 palette in BIFF8 file format - procedure TestWriteRead_ODS_Font_RandomPal; // palette 64, top 56 entries random + procedure TestWriteRead_ODS_Font_InternalPal; // internal palette for BIFF8 file format + procedure TestWriteRead_ODS_Font_Biff5Pal; // official biff5 palette in BIFF8 file format + 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); diff --git a/components/fpspreadsheet/tests/fonttests.pas b/components/fpspreadsheet/tests/fonttests.pas index e9c01c964..d79342e54 100644 --- a/components/fpspreadsheet/tests/fonttests.pas +++ b/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); diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpi b/components/fpspreadsheet/tests/spreadtestgui.lpi index ae08248f0..0431b3378 100644 --- a/components/fpspreadsheet/tests/spreadtestgui.lpi +++ b/components/fpspreadsheet/tests/spreadtestgui.lpi @@ -112,10 +112,12 @@ + + diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index 285d51f7c..1696f9a12 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/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; - fntName := fnt.FontName; - fntSize := fnt.Size; - fntStyles := []; - fntColor := fnt.Color; + if fnt <> nil then begin + fntName := fnt.FontName; + fntSize := fnt.Size; + 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 @@ -1376,8 +1409,7 @@ begin ''); for i:=1 to Workbook.GetWorksheetCount do AppendToStream(FSWorkbook, Format( - '', [Workbook.GetWorksheetByIndex(i-1).Name, i, i+2])); - // '', [i, i, i+2])); + '', [Workbook.GetWorksheetByIndex(i-1).Name, i, i+2])); AppendToStream(FSWorkbook, ''); AppendToStream(FSWorkbook, @@ -1566,7 +1598,7 @@ begin // Footer AppendToStream(FSSheets[FCurSheetNum], - '', + '' + ''); end;