From f989031cf9ec6bf163fdf346f941dc3da7e2ed19 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Tue, 29 Jul 2014 21:02:14 +0000 Subject: [PATCH] fpspreadsheet: Fix font color issues of xlsx reader. No fails in unit test any more. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3396 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/fpspreadsheet/fpsopendocument.pas | 2 +- components/fpspreadsheet/fpsutils.pas | 25 +++--- components/fpspreadsheet/xlsbiff8.pas | 2 +- components/fpspreadsheet/xlsxooxml.pas | 84 +++++++++++++++++++- 4 files changed, 98 insertions(+), 15 deletions(-) diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index 8a8ee8075..b0173ccad 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -3316,7 +3316,7 @@ begin exit; fnt := Workbook.GetFont(AFormat.FontIndex); - defFnt := Workbook.GetFont(0); // Defaultfont + defFnt := Workbook.GetDefaultfont; if fnt.FontName <> defFnt.FontName then Result := Result + Format('style:font-name="%s" ', [fnt.FontName]); diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index 0ad0b3256..74e545a3c 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/components/fpspreadsheet/fpsutils.pas @@ -127,7 +127,7 @@ function PtsToPx(AValue: Double; AScreenPixelsPerInch: Integer): Integer; function HTMLLengthStrToPts(AValue: String): Double; function HTMLColorStrToColor(AValue: String): TsColorValue; -function ColorToHTMLColorStr(AValue: TsColorValue): String; +function ColorToHTMLColorStr(AValue: TsColorValue; AExcelDialect: Boolean = false): String; function UTF8TextToXMLText(AText: ansistring): ansistring; function AnalyzeCompareStr(AString: String; out ACompareOp: TsCompareOperation): String; @@ -1408,7 +1408,7 @@ end; {@@ Converts a HTML color string to a TsColorValue. Need for the ODS file format. - @param AValue HTML color string, such as '#FF0000' + @param AValue HTML color string, such as '#FF0000' @return rgb color value in little endian byte-sequence. This value is compatible with the TColor data type of the graphics unit. } @@ -1454,18 +1454,23 @@ end; {@@ Converts an rgb color value to a string as used in HTML code (for ods) - @param AValue RGB color value (compatible with the TColor data type of the - graphics unit) - @return HTML-compatible string, like '#FF0000' + @param AValue RGB color value (compatible with the TColor data type + of the graphics unit) + @param AExcelDialect If TRUE, returned string is in Excels format for xlsx, + i.e. in AARRGGBB notation, like '00FF0000' for "red" + @return HTML-compatible string, like '#FF0000' (AExcelDialect = false) } -function ColorToHTMLColorStr(AValue: TsColorValue): String; +function ColorToHTMLColorStr(AValue: TsColorValue; AExcelDialect: Boolean = false): String; type TRGB = record r,g,b,a: Byte end; var rgb: TRGB; begin rgb := TRGB(AValue); - Result := Format('#%.2x%.2x%.2x', [rgb.r, rgb.g, rgb.b]); + if AExcelDialect then + Result := Format('00%.2x%.2x%.2x', [rgb.r, rgb.g, rgb.b]) + else + Result := Format('#%.2x%.2x%.2x', [rgb.r, rgb.g, rgb.b]); end; {@@ @@ -1906,8 +1911,8 @@ end; Is needed for some Excel-strings. @param AString Input string starting with "<", "<=", ">", ">=", "<>" or "=" - If this start is missing a "=" is assumed. - @param ACompareOp Identifier for the comparins operation extracted - see TsCompareOperation + If this start code is missing a "=" is assumed. + @param ACompareOp Identifier for the comparing operation extracted - see TsCompareOperation @return Input string with the comparing characters stripped. } function AnalyzeComparestr(AString: String; out ACompareOp: TsCompareOperation): String; @@ -1931,7 +1936,7 @@ begin end; '>' : case AString[2] of '=' : RemoveChars(2, coGreaterEqual); - else Removechars(1, coGreater); + else RemoveChars(1, coGreater); end; '=' : RemoveChars(1, coEqual); else RemoveChars(0, coEqual); diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index 6e019d8d7..e6a005642 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/components/fpspreadsheet/xlsbiff8.pas @@ -142,7 +142,7 @@ type end; var - // the palette of the default BIFF8 colors as "big-endian color" values + // the palette of the 64 default BIFF8 colors as "big-endian color" values PALETTE_BIFF8: array[$00..$3F] of TsColorValue = ( $000000, // $00: black // 8 built-in default colors $FFFFFF, // $01: white diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index 1696f9a12..3137f6a92 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -72,6 +72,7 @@ type procedure ReadFont(ANode: TDOMNode); procedure ReadFonts(ANode: TDOMNode); procedure ReadNumFormats(ANode: TDOMNode); + procedure ReadPalette(ANode: TDOMNode); procedure ReadSharedStrings(ANode: TDOMNode); procedure ReadSheetList(ANode: TDOMNode; AList: TStrings); procedure ReadWorksheet(ANode: TDOMNode; AWorksheet: TsWorksheet); @@ -110,6 +111,7 @@ type procedure WriteFillList(AStream: TStream); procedure WriteFontList(AStream: TStream); procedure WriteNumFormatList(AStream: TStream); + procedure WritePalette(AStream: TStream); procedure WriteStyleList(AStream: TStream; ANodeName: String); protected { Streams with the contents of files } @@ -584,8 +586,19 @@ begin else if nodename = 'color' then begin s := GetAttrValue(node, 'rgb'); - if s <> '' then + if s <> '' then begin fntColor := FWorkbook.AddColorToPalette(HTMLColorStrToColor('#' + s)); + node := node.NextSibling; + continue; + end; + s := GetAttrValue(node, 'indexed'); + if s <> '' then begin + fntColor := StrToInt(s); + if (fntColor >= FWorkbook.GetPaletteSize) then + fntColor := scBlack; + node := node.NextSibling; + continue; + end; end; node := node.NextSibling; end; @@ -643,6 +656,44 @@ begin end; end; +procedure TsSpreadOOXMLReader.ReadPalette(ANode: TDOMNode); +var + node, colornode: TDOMNode; + nodename: String; + rgb: string; + n: Integer; + color: TsColorValue; + pal: array of TsColorValue; +begin + if ANode = nil then + exit; + SetLength(pal, 1000); + n := 0; + node := ANode.FirstChild; + while Assigned(node) do begin + nodename := node.NodeName; + if nodename = 'indexedColors' then begin + colornode := node.FirstChild; + while Assigned(colornode) do begin + nodename := colornode.NodeName; + if nodename = 'rgbColor' then begin + rgb := GetAttrValue(colornode, 'rgb'); + if rgb <> '' then begin + color := HTMLColorStrToColor('#' + rgb); + if n = Length(pal) then + SetLength(pal, Length(pal) + 1000); + pal[n] := color; + inc(n); + end; + end; + colornode := colorNode.NextSibling; + end; + end; + node := node.NextSibling; + end; + FWorkbook.UsePalette(@pal[0], n); +end; + procedure TsSpreadOOXMLReader.ReadSharedStrings(ANode: TDOMNode); var valuenode: TDOMNode; @@ -748,6 +799,7 @@ begin if FileExists(FilePath + OOXML_PATH_XL_STYLES) then begin // should always exist, just to make sure... ReadXMLFile(Doc, FilePath + OOXML_PATH_XL_STYLES); DeleteFile(FilePath + OOXML_PATH_XL_STYLES); + ReadPalette(Doc.DocumentElement.FindNode('colors')); ReadFonts(Doc.DocumentElement.FindNode('fonts')); ReadNumFormats(Doc.DocumentElement.FindNode('numFmts')); ReadCellXfs(Doc.DocumentElement.FindNode('cellXfs')); @@ -1150,8 +1202,9 @@ begin if (fssStrikeout in font.Style) then s := s + ''; if font.Color <> scBlack then begin - rgb := Workbook.GetPaletteColor(font.Color); - s := s + Format('', [Copy(ColorToHTMLColorStr(rgb), 2, 255)]); + s := s + Format('', [font.Color]); + // rgb := Workbook.GetPaletteColor(font.Color); + // s := s + Format('', [Copy(ColorToHTMLColorStr(rgb), 2, 255)]); end; AppendToStream(AStream, '', s, ''); @@ -1192,6 +1245,28 @@ begin end; end; +{ Writes the workbook's color palette to the file } +procedure TsSpreadOOXMLWriter.WritePalette(AStream: TStream); +var + c: TsColor; + rgb: TsColorValue; + i: Integer; +begin + AppendToStream(AStream, + '' + + ''); + + for i:=0 to Workbook.GetPaletteSize-1 do begin + rgb := Workbook.GetPaletteColor(i); + AppendToStream(AStream, + ''); + end; + + AppendToStream(AStream, + '' + + ''); +end; + { Writes the style list which the writer has collected in FFormattingStyles. } procedure TsSpreadOOXMLWriter.WriteStyleList(AStream: TStream; ANodeName: String); var @@ -1364,6 +1439,9 @@ begin AppendToStream(FSStyles, ''); + // Palette + WritePalette(FSStyles); + AppendToStream(FSStyles, ''); end;