fpspreadsheet: Add font writing support to ods. Add font ods test cases. Passed.

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

components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr

@@ -35,7 +35,7 @@ begin
 
   // Add some formatting
   MyWorksheet.WriteUsedFormatting(0, 0, [uffBold]);
-  MyWorksheet.WriteFontColor(0, 1, scRed);
+  MyWorksheet.WriteFont(0, 1, 'Times New Roman', 16, [], scRed);
 
   // Creates a new worksheet
   MyWorksheet := MyWorkbook.AddWorksheet('My Worksheet 2');

components/fpspreadsheet/fpsopendocument.pas

@@ -125,6 +125,8 @@ type
 
     function WriteBackgroundColorStyleXMLAsString(const AFormat: TCell): String;
     function WriteBorderStyleXMLAsString(const AFormat: TCell): String;
+    function WriteDefaultFontXMLAsString: String;
+    function WriteFontNamesXMLAsString: String;
     function WriteFontStyleXMLAsString(const AFormat: TCell): String;
     function WriteHorAlignmentStyleXMLAsString(const AFormat: TCell): String;
     function WriteTextRotationStyleXMLAsString(const AFormat: TCell): String;
@@ -1811,11 +1813,12 @@ begin
      '" xmlns:text="' + SCHEMAS_XMLNS_TEXT +
      '" xmlns:v="' + SCHEMAS_XMLNS_V + '">' + LineEnding +
    '<office:font-face-decls>' + LineEnding +
-   '  <style:font-face style:name="Arial" svg:font-family="Arial" />' + LineEnding +
+   '  '+WriteFontNamesXMLAsString + LineEnding +
+//   '  <style:font-face style:name="Arial" svg:font-family="Arial" />' + LineEnding +
    '</office:font-face-decls>' + LineEnding +
    '<office:styles>' + LineEnding +
    '  <style:style style:name="Default" style:family="table-cell">' + LineEnding +
-   '    <style:text-properties fo:font-size="10" style:font-name="Arial" />' + LineEnding +
+   '    ' + WriteDefaultFontXMLAsString + LineEnding +
    '  </style:style>' + LineEnding +
    '</office:styles>' + LineEnding +
    '<office:automatic-styles>' + LineEnding +
@@ -1891,7 +1894,8 @@ begin
 
    // Fonts
    '  <office:font-face-decls>' + LineEnding +
-   '    <style:font-face style:name="Arial" svg:font-family="Arial" xmlns:v="urn:schemas-microsoft-com:vml" />' + LineEnding +
+   '    ' + WriteFontNamesXMLAsString + LineEnding +
+//   '    <style:font-face style:name="Arial" svg:font-family="Arial" xmlns:v="urn:schemas-microsoft-com:vml" />' + LineEnding +
    '  </office:font-face-decls>' + LineEnding +
 
    // Automatic styles
@@ -2436,6 +2440,41 @@ begin
     Result := Result + 'fo:border-top="none" ';
 end;
 
+function TsSpreadOpenDocWriter.WriteDefaultFontXMLAsString: String;
+var
+  fnt: TsFont;
+begin
+  fnt := Workbook.GetFont(0);
+  Result := Format(
+    '<style:text-properties style:font-name="%s" fo:font-size="%.1f" />',
+    [fnt.FontName, fnt.Size], FPointSeparatorSettings
+  );
+end;
+
+function TsSpreadOpenDocWriter.WriteFontNamesXMLAsString: String;
+var
+  L: TStringList;
+  fnt: TsFont;
+  i: Integer;
+begin
+  Result := '';
+  L := TStringList.Create;
+  try
+    for i:=0 to Workbook.GetFontCount-1 do begin
+      fnt := Workbook.GetFont(i);
+      if (fnt <> nil) and (L.IndexOf(fnt.FontName) = -1) then
+        L.Add(fnt.FontName);
+    end;
+    for i:=0 to L.Count-1 do
+      Result := Format(
+        '<style:font-face style:name="%s" svg:font-family="%s" />',
+        [ L[i], L[i] ]
+      );
+  finally
+    L.Free;
+  end;
+end;
+
 function TsSpreadOpenDocWriter.WriteFontStyleXMLAsString(const AFormat: TCell): String;
 var
   fnt: TsFont;
@@ -2443,6 +2482,9 @@ var
 begin
   Result := '';
 
+  if not (uffFont in AFormat.UsedFormattingFields) then
+    exit;
+
   fnt := Workbook.GetFont(AFormat.FontIndex);
   defFnt := Workbook.GetFont(0);  // Defaultfont
 

components/fpspreadsheet/fpspreadsheet.pas

@@ -565,6 +565,7 @@ type
     procedure CopyFontList(ASource: TFPList);
     function FindFont(const AFontName: String; ASize: Single;
       AStyle: TsFontStyles; AColor: TsColor): Integer;
+    function GetDefaultFont: TsFont;
     function GetDefaultFontSize: Single;
     function GetFont(AIndex: Integer): TsFont;
     function GetFontCount: Integer;
@@ -2955,6 +2956,14 @@ begin
   end;
 end;
 
+{@@
+  Returns the default font. This is the first font (index 0) in the font list
+}
+function TsWorkbook.GetDefaultFont: TsFont;
+begin
+  Result := GetFont(0);
+end;
+
 {@@
   Returns the point size of the default font
 }

components/fpspreadsheet/tests/fonttests.pas

@@ -38,22 +38,28 @@ type
 
   published
     // BIFF2 test cases
-    procedure TestWriteReadBold_BIFF2;
+    procedure TestWriteRead_BIFF2_Bold;
-    procedure TestWriteReadFont_BIFF2_Arial;
+    procedure TestWriteRead_BIFF2_Font_Arial;
-    procedure TestWriteReadFont_BIFF2_TimesNewRoman;
+    procedure TestWriteRead_BIFF2_Font_TimesNewRoman;
-    procedure TestWriteReadFont_BIFF2_CourierNew;
+    procedure TestWriteRead_BIFF2_Font_CourierNew;
 
     // BIFF5 test cases
-    procedure TestWriteReadBold_BIFF5;
+    procedure TestWriteRead_BIFF5_Bold;
-    procedure TestWriteReadFont_BIFF5_Arial;
+    procedure TestWriteRead_BIFF5_Font_Arial;
-    procedure TestWriteReadFont_BIFF5_TimesNewRoman;
+    procedure TestWriteRead_BIFF5_Font_TimesNewRoman;
-    procedure TestWriteReadFont_BIFF5_CourierNew;
+    procedure TestWriteRead_BIFF5_Font_CourierNew;
 
     // BIFF8 test cases
-    procedure TestWriteReadBold_BIFF8;
+    procedure TestWriteRead_BIFF8_Bold;
-    procedure TestWriteReadFont_BIFF8_Arial;
+    procedure TestWriteRead_BIFF8_Font_Arial;
-    procedure TestWriteReadFont_BIFF8_TimesNewRoman;
+    procedure TestWriteRead_BIFF8_Font_TimesNewRoman;
-    procedure TestWriteReadFont_BIFF8_CourierNew;
+    procedure TestWriteRead_BIFF8_Font_CourierNew;
+
+    // ODS test cases
+    procedure TestWriteRead_ODS_Bold;
+    procedure TestWriteRead_ODS_Font_Arial;
+    procedure TestWriteRead_ODS_Font_TimesNewRoman;
+    procedure TestWriteRead_ODS_Font_CourierNew;
   end;
 
 implementation
@@ -190,21 +196,26 @@ begin
   DeleteFile(TempFile);
 end;
 
-procedure TSpreadWriteReadFontTests.TestWriteReadBold_BIFF2;
+procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF2_Bold;
 begin
   TestWriteReadBold(sfExcel2);
 end;
 
-procedure TSpreadWriteReadFontTests.TestWriteReadBold_BIFF5;
+procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF5_Bold;
 begin
   TestWriteReadBold(sfExcel5);
 end;
 
-procedure TSpreadWriteReadFontTests.TestWriteReadBold_BIFF8;
+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
@@ -282,51 +293,68 @@ begin
 end;
 
 { BIFF2 }
-procedure TSpreadWriteReadFontTests.TestWriteReadFont_BIFF2_Arial;
+procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF2_Font_Arial;
 begin
   TestWriteReadFont(sfExcel2, 'Arial');
 end;
 
-procedure TSpreadWriteReadFontTests.TestWriteReadFont_BIFF2_TimesNewRoman;
+procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF2_Font_TimesNewRoman;
 begin
-  TestWriteReadFont(sfExcel2, 'TimesNewRoman');
+  TestWriteReadFont(sfExcel2, 'Times New Roman');
 end;
 
-procedure TSpreadWriteReadFontTests.TestWriteReadFont_BIFF2_CourierNew;
+procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF2_Font_CourierNew;
 begin
-  TestWriteReadFont(sfExcel2, 'CourierNew');
+  TestWriteReadFont(sfExcel2, 'Courier New');
 end;
 
 { BIFF5 }
-procedure TSpreadWriteReadFontTests.TestWriteReadFont_BIFF5_Arial;
+procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF5_Font_Arial;
 begin
   TestWriteReadFont(sfExcel5, 'Arial');
 end;
 
-procedure TSpreadWriteReadFontTests.TestWriteReadFont_BIFF5_TimesNewRoman;
+procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF5_Font_TimesNewRoman;
 begin
-  TestWriteReadFont(sfExcel5, 'TimesNewRoman');
+  TestWriteReadFont(sfExcel5, 'Times New Roman');
 end;
 
-procedure TSpreadWriteReadFontTests.TestWriteReadFont_BIFF5_CourierNew;
+procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF5_Font_CourierNew;
 begin
-  TestWriteReadFont(sfExcel5, 'CourierNew');
+  TestWriteReadFont(sfExcel5, 'Courier New');
 end;
 
 { BIFF8 }
-procedure TSpreadWriteReadFontTests.TestWriteReadFont_BIFF8_Arial;
+procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF8_Font_Arial;
 begin
   TestWriteReadFont(sfExcel8, 'Arial');
 end;
 
-procedure TSpreadWriteReadFontTests.TestWriteReadFont_BIFF8_TimesNewRoman;
+procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF8_Font_TimesNewRoman;
 begin
-  TestWriteReadFont(sfExcel8, 'TimesNewRoman');
+  TestWriteReadFont(sfExcel8, 'Times New Roman');
 end;
 
-procedure TSpreadWriteReadFontTests.TestWriteReadFont_BIFF8_CourierNew;
+procedure TSpreadWriteReadFontTests.TestWriteRead_BIFF8_Font_CourierNew;
 begin
-  TestWriteReadFont(sfExcel8, 'CourierNew');
+  TestWriteReadFont(sfExcel8, 'Courier New');
+end;
+
+
+{ ODS }
+procedure TSpreadWriteReadFontTests.TestWriteRead_ODS_Font_Arial;
+begin
+  TestWriteReadFont(sfOpenDocument, 'Arial');
+end;
+
+procedure TSpreadWriteReadFontTests.TestWriteRead_ODS_Font_TimesNewRoman;
+begin
+  TestWriteReadFont(sfOpenDocument, 'Times New Roman');
+end;
+
+procedure TSpreadWriteReadFontTests.TestWriteRead_ODS_Font_CourierNew;
+begin
+  TestWriteReadFont(sfOpenDocument, 'Courier New');
 end;