FPSpreadsheet: Proper usage of Theme colors by xlsx chart reader.

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

components/fpspreadsheet/source/common/xlsxooxml.pas

@@ -87,8 +87,8 @@ type
     FEmbeddedObjList: TFPList;
     FHyperlinkList: TFPList;
     FSharedFormulaBaseList: TFPList;
+    FThemeColorList: TFPList;
     FPalette: TsPalette;
-    FThemeColors: array of TsColor;
     FLastRow, FLastCol: Cardinal;
     FWrittenByFPS: Boolean;
     procedure ApplyCellFormatting(ACell: PCell; XfIndex: Integer);
@@ -169,6 +169,7 @@ type
     destructor Destroy; override;
     class function CheckFileFormat(AStream: TStream): Boolean; override;
     function CreateXMLStream: TStream;
+    function GetThemeColor(AName: String): Integer;
     function NeedsPassword(AStream: TStream): Boolean; override;
     procedure ReadFromStream(AStream: TStream; APassword: String = '';
       AParams: TsStreamParams = []); override;
@@ -488,6 +489,11 @@ type
     RelId: String;
   end;
 
+  TThemeColor = class
+    Name: String;
+    Color: TsColor;
+  end;
+
 const
   PATTERN_TYPES: array [TsFillStyle] of string = (
     'none',            // fsNoFill
@@ -846,6 +852,7 @@ begin
   FCellFormatList := TsCellFormatList.Create(true);
   FDifferentialFormatList := TFPList.Create;
   FDrawingToSheetRelList := TFPList.Create;
+  FThemeColorList := TFPList.Create;
   FEmbeddedObjList := TFPList.Create;
   // Allow duplicates because xf indexes used in cell records cannot be found any more.
   FSharedFormulaBaseList := TFPList.Create;
@@ -882,9 +889,14 @@ begin
     TObject(FDifferentialFormatList[j]).Free;
   FDifferentialFormatList.Free;
 
+  for j := FThemeColorList.Count-1 downto 0 do
+    TObject(FThemeColorList[j]).Free;
+  FThemeColorList.Free;
+
   for j := FDrawingToSheetRelList.Count-1 downto 0 do
     TObject(FDrawingToSheetRelList[j]).Free;
   FDrawingToSheetRelList.Free;
+
   for j := FSheetList.Count-1 downto 0 do
     TObject(FSheetList[j]).Free;
   FSheetList.Free;
@@ -985,6 +997,21 @@ begin
     Result := TMemoryStream.Create;
 end;
 
+function TsSpreadOOXMLReader.GetThemeColor(AName: String): Integer;
+var
+  i: Integer;
+begin
+  AName := 'a:' + AName;
+  for i := 0 to FThemeColorList.Count-1 do
+    if SameText(TThemeColor(FThemeColorList[i]).Name, AName) then
+    begin
+      Result := TThemeColor(FThemeColorList[i]).Color;
+      exit;
+    end;
+  Result := scNotDefined;
+end;
+
+
 { Checks the file header for the signature of the decrypted file format. }
 class function TsSpreadOOXMLReader.IsEncrypted(AStream: TStream): Boolean;
 var
@@ -2108,7 +2135,7 @@ begin
   s := GetAttrValue(ANode, 'theme');
   if s <> '' then begin
     idx := StrToInt(s);
-    if idx < Length(FThemeColors) then begin
+    if idx < FThemeColorList.Count then begin
       // For some reason the first two pairs of colors are interchanged in Excel!
       case idx of
         0: idx := 1;
@@ -2116,7 +2143,7 @@ begin
         2: idx := 3;
         3: idx := 2;
       end;
-      rgb := FThemeColors[idx];
+      rgb := TThemeColor(FThemeColorList[idx]).Color;
       s := GetAttrValue(ANode, 'tint');
       if s <> '' then begin
         tint := StrToFloat(s, FPointSeparatorSettings);
@@ -4349,14 +4376,37 @@ end;
 
 procedure TsSpreadOOXMLReader.ReadThemeColors(ANode: TDOMNode);
 var
+  child: TDOMNode;
   clrNode: TDOMNode;
   nodeName: String;
+  j: Integer;
 
-  procedure AddColor(AColorStr: String);
+  function GetColorFromNode(ANode: TDOMNode; AAttrName: String): String;
+  var
+    nodeName: String;
+  begin
+    while Assigned(ANode) do
+    begin
+      nodeName := ANode.NodeName;
+      if (nodeName = 'a:sysClr')  or (nodeName = 'a:srgbClr') then
+      begin
+        Result := GetAttrValue(ANode, AAttrName);
+        exit;
+      end;
+      ANode := ANode.NextSibling;
+    end;
+    Result := '';
+  end;
+
+  procedure AddColor(AColorName, AColorStr: String);
+  var
+    themeClr: TThemeColor;
   begin
     if AColorStr <> '' then begin
-      SetLength(FThemeColors, Length(FThemeColors)+1);
+      themeClr := TThemeColor.Create;
-      FThemeColors[Length(FThemeColors)-1] := HTMLColorStrToColor('#' + AColorStr);
+      themeClr.Name := AColorName;
+      themeClr.Color := HTMLColorStrToColor('#' + AColorStr);
+      FThemeColorList.Add(themeClr);
     end;
   end;
 
@@ -4364,45 +4414,52 @@ begin
   if not Assigned(ANode) then
     exit;
 
-  SetLength(FThemeColors, 0);
+  if FThemeColorList.Count > 0 then
+  begin
+    for j := FThemeColorList.Count-1 downto 0 do
+      TObject(FThemeColorList[j]).Free;
+    FThemeColorList.Clear;
+  end;
+
   clrNode := ANode.FirstChild;
   while Assigned(clrNode) do begin
     nodeName := clrNode.NodeName;
+    child := clrNode.FirstChild;
     if nodeName = 'a:dk1' then
-      AddColor(GetAttrValue(clrNode.FirstChild, 'lastClr'))
+      AddColor(nodeName, GetColorFromNode(child, 'lastClr'))
     else
     if nodeName = 'a:lt1' then
-      AddColor(GetAttrValue(clrNode.FirstChild, 'lastClr'))
+      AddColor(nodeName, GetColorFromNode(child, 'lastClr'))
     else
     if nodeName = 'a:dk2' then
-      AddColor(GetAttrValue(clrNode.FirstChild, 'val'))
+      AddColor(nodeName, GetColorFromNode(child, 'val'))
     else
     if nodeName = 'a:lt2' then
-      AddColor(GetAttrValue(clrNode.FirstChild, 'val'))
+      AddColor(nodeName, GetColorFromNode(child, 'val'))
     else
     if nodeName = 'a:accent1' then
-      AddColor(GetAttrValue(clrNode.FirstChild, 'val'))
+      AddColor(nodeName, GetColorFromNode(child, 'val'))
     else
     if nodeName = 'a:accent2' then
-      AddColor(GetAttrValue(clrNode.FirstChild, 'val'))
+      AddColor(nodeName, GetColorFromNode(child, 'val'))
     else
     if nodeName = 'a:accent3' then
-      AddColor(GetAttrValue(clrNode.FirstChild, 'val'))
+      AddColor(nodeName, GetColorFromNode(child, 'val'))
     else
     if nodeName = 'a:accent4' then
-      AddColor(GetAttrValue(clrNode.FirstChild, 'val'))
+      AddColor(nodeName, GetColorFromNode(child, 'val'))
     else
     if nodeName = 'a:accent5' then
-      AddColor(GetAttrValue(clrNode.FirstChild, 'val'))
+      AddColor(nodeName, GetColorFromNode(child, 'val'))
     else
     if nodeName = 'a:accent6' then
-      AddColor(GetAttrValue(clrNode.FirstChild, 'val'))
+      AddColor(nodeName, GetColorFromNode(child, 'val'))
     else
     if nodeName = 'a:hlink' then
-      AddColor(GetAttrValue(clrNode.FirstChild, 'val'))
+      AddColor(nodeName, GetColorFromNode(child, 'val'))
     else
     if nodeName = 'a:folHlink' then
-      AddColor(GetAttrValue(clrNode.FirstChild, 'aval'));
+      AddColor(nodeName, GetColorFromNode(child, 'aval'));
     clrNode := clrNode.NextSibling;
   end;
 end;

components/fpspreadsheet/source/common/xlsxooxmlchart.pas

@@ -8,7 +8,7 @@ interface
 {$ifdef FPS_CHARTS}
 
 uses                                                  //LazLoggerBase,
-  Classes, SysUtils, StrUtils, Contnrs, FPImage, fgl,
+  Classes, SysUtils, StrUtils, Contnrs, FPImage,
   {$ifdef FPS_PATCHED_ZIPPER}fpszipper,{$else}zipper,{$endif}
   laz2_xmlread, laz2_DOM,
   fpsTypes, fpSpreadsheet, fpsChart, fpsUtils, fpsNumFormat, fpsImages,
@@ -20,7 +20,6 @@ type
   TsSpreadOOXMLChartReader = class(TsBasicSpreadChartReader)
   private
     FPointSeparatorSettings: TFormatSettings;
-    FColors: specialize TFPGMap<string, TsColor>;
     FImages: TFPObjectList;
     FXAxisID, FYAxisID, FX2AxisID, FY2AxisID: DWord;
     FXAxisDelete, FYAxisDelete, FX2AxisDelete, FY2AxisDelete: Boolean;
@@ -282,27 +281,12 @@ begin
   FPointSeparatorSettings := SysUtils.DefaultFormatSettings;
   FPointSeparatorSettings.DecimalSeparator:='.';
 
-  // The following color values are directly copied from xlsx files written by Excel.
-  // In the long term, they should be read from xl/theme/theme1.xml.
-  FColors := specialize TFPGMap<string, TsColor>.Create;
-  FColors.Add('dk1', scBlack);
-  FColors.Add('lt1', scWhite);
-  FColors.Add('dk2', FlipColorBytes($44546A));
-  FColors.Add('lt2', FlipColorBytes($E7E6E6));
-  FColors.Add('accent1', FlipColorBytes($4472C4));
-  FColors.Add('accent2', FlipColorBytes($ED7D31));
-  FColors.Add('accent3', FlipColorBytes($A5A5A5));
-  FColors.Add('accent4', FlipColorBytes($FFC000));
-  FColors.Add('accent5', FlipColorBytes($5B9BD5));
-  FColors.Add('accent6', FlipColorBytes($70AD47));
-
   FImages := TFPObjectList.Create;
 end;
 
 destructor TsSpreadOOXMLChartReader.Destroy;
 begin
   FImages.Free;
-  FColors.Free;
   inherited;
 end;
 
@@ -672,9 +656,9 @@ procedure TsSpreadOOXMLChartReader.ReadChartColor(ANode: TDOMNode;
 
 var
   nodeName, s: String;
-  idx: Integer;
   n: Integer;
   child: TDOMNode;
+  themeRGB: TsColor;
   lumMod: Single = 1.0;
   lumOff: Single = 0.0;
 begin
@@ -687,10 +671,10 @@ begin
           s := GetAttrValue(ANode, 'val');
           if (s <> '') then
           begin
-            idx := FColors.IndexOf(ColorAlias(s));
+            themeRGB := TsSpreadOOXMLReader(Reader).GetThemeColor(ColorAlias(s));
-            if idx > -1 then
+            if themeRGB <> scNotDefined then
             begin
-              AColor.Color := FColors.Data[idx];
+              AColor.Color := themeRGB;
               child := ANode.FirstChild;
               while Assigned(child) do
               begin