fpspreadsheet: Add support for reading fonts from ods files.

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

components/fpspreadsheet/fpsopendocument.pas

@@ -395,14 +395,12 @@ begin
   // Now copy all style parameters from the styleData to the cell.
 
   // Font
-  {
+  if styleData.FontIndex = 1 then
-  if style.FontIndex = 1 then
+    Include(ACell^.UsedFormattingFields, uffBold)
-    Include(cell^.UsedFormattingFields, uffBold)
   else
-  if XFData.FontIndex > 1 then
+  if styleData.FontIndex > 1 then
-    Include(cell^.UsedFormattingFields, uffFont);
+    Include(ACell^.UsedFormattingFields, uffFont);
-  cell^.FontIndex := styleData.FontIndex;
+  ACell^.FontIndex := styleData.FontIndex;
-   }
 
   // Word wrap
   if styleData.WordWrap then
@@ -1362,6 +1360,7 @@ var
   borders: TsCellBorders;
   borderStyles: TsCellBorderStyles;
   bkClr: TsColorValue;
+  fntIndex: Integer;
   s: String;
 
   procedure SetBorderStyle(ABorder: TsCellBorder; AStyleValue: String);
@@ -1432,6 +1431,56 @@ var
     end;
   end;
 
+  function ReadFont(ANode: TDOMnode; IsDefaultFont: Boolean): Integer;
+  var
+    fntName: String;
+    fntSize: Single;
+    fntStyles: TsFontStyles;
+    fntColor: TsColor;
+    s: String;
+  begin
+    if ANode = nil then begin
+      Result := 0;
+      exit;
+    end;
+
+    fntName := GetAttrValue(ANode, 'style:font-name');
+    if fntName = '' then
+      fntName := FWorkbook.GetFont(0).FontName;
+
+    s := GetAttrValue(ANode, 'fo:font-size');
+    if s <> '' then
+      fntSize := HTMLLengthStrToPts(s)
+    else
+      fntSize := FWorkbook.GetDefaultFontSize;
+
+    fntStyles := [];
+    if GetAttrValue(ANode, 'fo:font-style') = 'italic' then
+      Include(fntStyles, fssItalic);
+    if GetAttrValue(ANode, 'fo:font-weight') = 'bold' then
+      Include(fntStyles, fssBold);
+    if GetAttrValue(ANode, 'style:text-underline-style') <> '' then
+      Include(fntStyles, fssUnderline);
+    if GetAttrValue(ANode, 'style:text-strike-through-style') <> '' then
+      Include(fntStyles, fssStrikeout);
+
+    s := GetAttrValue(ANode, 'fo:color');
+    if s <> '' then
+      fntColor := FWorkbook.AddColorToPalette(HTMLColorStrToColor(s))
+    else
+      fntColor := FWorkbook.GetFont(0).Color;
+
+    if IsDefaultFont then begin
+      FWorkbook.SetDefaultFont(fntName, fntSize);
+      Result := 0;
+    end
+    else begin
+      Result := FWorkbook.FindFont(fntName, fntSize, fntStyles, fntColor);
+      if Result = -1 then
+        Result := FWorkbook.AddFont(fntName, fntSize, fntStyles, fntColor);
+    end;
+  end;
+
 begin
   if not Assigned(AStylesNode) then
     exit;
@@ -1443,6 +1492,9 @@ begin
 
   styleNode := AStylesNode.FirstChild;
   while Assigned(styleNode) do begin
+    if styleNode.NodeName = 'style:default-style' then begin
+      ReadFont(styleNode.FindNode('style:text-properties'), true);
+    end else
     if styleNode.NodeName = 'style:style' then begin
       family := GetAttrValue(styleNode, 'style:family');
 
@@ -1468,9 +1520,13 @@ begin
         txtRot := trHorizontal;
         horAlign := haDefault;
         vertAlign := vaDefault;
+        fntIndex := 0;
 
         styleChildNode := styleNode.FirstChild;
         while Assigned(styleChildNode) do begin
+          if styleChildNode.NodeName = 'style:text-properties' then
+            fntIndex := ReadFont(styleChildNode, false)
+          else
           if styleChildNode.NodeName = 'style:table-cell-properties' then begin
             // Background color
             s := GetAttrValue(styleChildNode, 'fo:background-color');
@@ -1545,7 +1601,7 @@ begin
 
         style := TCellStyleData.Create;
         style.Name := stylename;
-        style.FontIndex := 0;
+        style.FontIndex := fntIndex;
         style.NumFormatIndex := numFmtIndex;
         style.HorAlignment := horAlign;
         style.VertAlignment := vertAlign;

components/fpspreadsheet/fpspreadsheet.pas

@@ -2912,10 +2912,10 @@ begin
   SetDefaultFont(fntName, fntSize);                      // Default font (FONT0)
   AddFont(fntName, fntSize, [fssBold], scBlack);         // FONT1 for uffBold
 
-  AddFont(fntName, fntSize, [fssItalic], scBlack);       // FONT2 for uffItalic
+  AddFont(fntName, fntSize, [fssItalic], scBlack);       // FONT2 (Italic)
-  AddFont(fntName, fntSize, [fssUnderline], scBlack);    // FONT3 for uffUnderline
+  AddFont(fntName, fntSize, [fssUnderline], scBlack);    // FONT3 (fUnderline)
   // FONT4 which does not exist in BIFF is added automatically with nil as place-holder
-  AddFont(fntName, fntSize, [fssBold, fssItalic], scBlack); // FONT5 for uffBoldItalic
+  AddFont(fntName, fntSize, [fssBold, fssItalic], scBlack); // FONT5 (bold & italic)
 
   FBuiltinFontCount := FFontList.Count;
 end;

components/fpspreadsheet/fpspreadsheetgrid.pas

@@ -9,6 +9,8 @@ AUTHORS: Felipe Monteiro de Carvalho, Werner Pamler
 { To do:
  - When Lazarus 1.4 comes out remove the workaround for the RGB2HLS bug in
    FindNearestPaletteIndex.
+ - Arial bold is not shown as such if loaded from ods
+ - Background color of first cell is ignored.
 }
 
 unit fpspreadsheetgrid;

components/fpspreadsheet/fpsutils.pas

@@ -1457,6 +1457,9 @@ begin
   units := lowercase(Copy(AValue, Length(AValue)-1, 2));
   val(copy(AValue, 1, Length(AValue)-2), x, res);
   // No hasseling with the decimal point...
+  if units = 'pt' then
+    Result := x
+  else
   if units = 'in' then
     Result := InToPts(x)
   else if units = 'cm' then