From 036383d658fa96e33c522a48a9bdc7328d4e54f9 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Fri, 6 Jun 2014 08:48:22 +0000 Subject: [PATCH] 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 | 72 ++++++++++++++++--- components/fpspreadsheet/fpspreadsheet.pas | 6 +- .../fpspreadsheet/fpspreadsheetgrid.pas | 2 + components/fpspreadsheet/fpsutils.pas | 3 + 4 files changed, 72 insertions(+), 11 deletions(-) diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index 0488e0d88..f57be3f95 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -395,14 +395,12 @@ begin // Now copy all style parameters from the styleData to the cell. // Font - { - if style.FontIndex = 1 then - Include(cell^.UsedFormattingFields, uffBold) + if styleData.FontIndex = 1 then + Include(ACell^.UsedFormattingFields, uffBold) else - if XFData.FontIndex > 1 then - Include(cell^.UsedFormattingFields, uffFont); - cell^.FontIndex := styleData.FontIndex; - } + if styleData.FontIndex > 1 then + Include(ACell^.UsedFormattingFields, uffFont); + 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; diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index edf6a3f02..6f6bd1572 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/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, [fssUnderline], scBlack); // FONT3 for uffUnderline + AddFont(fntName, fntSize, [fssItalic], scBlack); // FONT2 (Italic) + 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; diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index 70de9dc6a..e2984719c 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/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; diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index 069cde14c..d71a2c59b 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/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