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

@@ -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]);

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
+  @param   AValue          RGB color value (compatible with the TColor data type
-                    graphics unit)
+                           of the graphics unit)
-  @return  HTML-compatible string, like '#FF0000'
+  @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.
+                      If this start code is missing a "=" is assumed.
-  @param  ACompareOp  Identifier for the comparins operation extracted - see TsCompareOperation
+  @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);

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

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 + '<strike />';
       if font.Color <> scBlack then begin
-        rgb := Workbook.GetPaletteColor(font.Color);
+        s := s + Format('<color indexed="%d" />', [font.Color]);
-        s := s + Format('<color rgb="%s" />', [Copy(ColorToHTMLColorStr(rgb), 2, 255)]);
+        // rgb := Workbook.GetPaletteColor(font.Color);
+        // s := s + Format('<color rgb="%s" />', [Copy(ColorToHTMLColorStr(rgb), 2, 255)]);
       end;
       AppendToStream(AStream,
         '<font>', s, '</font>');
@@ -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,
+    '<colors>' +
+      '<indexedColors>');
+
+  for i:=0 to Workbook.GetPaletteSize-1 do begin
+    rgb := Workbook.GetPaletteColor(i);
+    AppendToStream(AStream,
+        '<rgbColor rgb="'+ColorToHTMLColorStr(rgb, true) + '" />');
+  end;
+
+  AppendToStream(AStream,
+      '</indexedColors>' +
+    '</colors>');
+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,
       '<tableStyles count="0" defaultTableStyle="TableStyleMedium9" defaultPivotStyle="PivotStyleLight16" />');
 
+  // Palette
+  WritePalette(FSStyles);
+
   AppendToStream(FSStyles,
     '</styleSheet>');
 end;