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;