fpspreadsheet: Gradient support in xlsx charts. Unified gradient directions between xlsx and ods.

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

components/fpspreadsheet/source/common/fpschart.pas

@@ -57,7 +57,7 @@ type
     procedure CopyFrom(ALine: TsChartLine);
   end;
 
-  TsChartGradientStyle = (cgsLinear, cgsAxial, cgsRadial, cgsElliptic, cgsSquare, cgsRectangular);
+  TsChartGradientStyle = (cgsLinear, cgsAxial, cgsRadial, cgsElliptic, cgsSquare, cgsRectangular, cgsShape);
 
   TsChartGradientStep = record
     Value: Double;         // 0.0 ... 1.0
@@ -78,8 +78,8 @@ type
     Name: String;
     Style: TsChartGradientStyle;
     Border: Double;            // 0.0 ... 1.0
-    CenterX, CenterY: Double;  // 0.0 ... 1.0
+    CenterX, CenterY: Double;  // 0.0 ... 1.0  ( for gradients which are not linear )
-    Angle: Double;             // degrees
+    Angle: Double;             // degrees, 0° = horizontal, grows CCW
     constructor Create;
     destructor Destroy; override;
     procedure CopyFrom(ASource: TsChartGradient);

components/fpspreadsheet/source/common/fpsopendocumentchart.pas

@@ -202,7 +202,7 @@ const
   );  // unsupported: bow-tie, hourglass, vertical-bar
 
   GRADIENT_STYLES: array[TsChartGradientStyle] of string = (
-    'linear', 'axial', 'radial', 'ellipsoid', 'square', 'rectangular'
+    'linear', 'axial', 'radial', 'ellipsoid', 'square', 'rectangular', 'radial'
   );
 
   HATCH_STYLES: array[TsChartHatchStyle] of string = (
@@ -2020,6 +2020,9 @@ begin
     for i := Length(s) downto 1 do
       if not (s[i] in ['0'..'9', '.', '+', '-']) then Delete(s, i, 1);
     angle := StrToFloatDef(s, 0.0, FPointSeparatorSettings);
+    { ods has angle=0 in vertical direction, and orientation is CW
+      --> We must transform to fps angular orientations (0° horizontal, CCW) }
+    angle := (90.0 - angle) mod 360;
   end;
 
   s := GetAttrValue(ANode, 'draw:cx');
@@ -3539,7 +3542,7 @@ begin
       cgsLinear, cgsAxial:
         style := style + Format(
           'draw:angle="%.0fdeg" ',
-          [ gradient.Angle ],
+          [ (90 - gradient.Angle) mod 360 ],   // transform to fps angle orientations
           FPointSeparatorSettings
         );
       cgsElliptic, cgsSquare, cgsRectangular:
@@ -3548,12 +3551,14 @@ begin
           [ gradient.CenterX * 100, gradient.CenterY * 100, gradient.Angle ],
           FPointSeparatorSettings
         );
-      cgsRadial:
+      cgsRadial, cgsShape:
         style := style + Format(
           'draw:cx="%.0f%%" draw:cy="%.0f%%" ',
           [ gradient.CenterX * 100, gradient.CenterY * 100 ],
           FPointSeparatorSettings
         );
+      else
+        raise Exception.Create('Unsupported gradient style');
     end;
     style := style + '/>' + LE;
 

components/fpspreadsheet/source/common/xlsxooxmlchart.pas

@@ -83,6 +83,7 @@ type
     FAxisID: array[TsChartAxisAlignment] of DWord;
     FSeriesIndex: Integer;
     function GetChartColorXML(AIndent: Integer; ANodeName: String; AColor: TsChartColor): String;
+    function GetChartColorXML(AColor: TsChartColor): String;
     function GetChartFillAndLineXML(AIndent: Integer; AChart: TsChart; AFill: TsChartFill; ALine: TsChartLine): String;
     function GetChartFillXML(AIndent: Integer; AChart: TsChart; AFill: TsChartFill): String;
     function GetChartFontXML(AIndent: Integer; AFont: TsFont; ANodeName: String): String;
@@ -779,6 +780,26 @@ begin
           if TryStrToFloat(s, value, FPointSeparatorSettings) then
             gradient.Angle := value / ANGLE_MULTIPLIER;
         end;
+      'a:path':
+        begin
+          s := GetAttrValue(ANode, 'path');
+          case s of
+            'rect': gradient.Style := cgsRectangular;
+            'circle': gradient.Style := cgsRadial;
+            'shape': gradient.Style := cgsShape;
+          end;
+          child := ANode.FindNode('a:fillToRect');
+          s := GetAttrValue(ANode, 'l');
+          if TryStrToFloat(s, value, FPointSeparatorSettings) then
+            gradient.CenterX := value / FACTOR_MULTIPLIER
+          else
+            gradient.CenterX := 0.0;
+          s := GetAttrValue(aNode, 't');
+          if tryStrToFloat(s, value, FPointSeparatorSettings) then
+            gradient.CenterY := value / FACTOR_MULTIPLIER
+          else
+            gradient.CenterY := 0.0;
+        end;
     end;
     ANode := ANode.NextSibling;
   end;
@@ -3403,27 +3424,30 @@ function TsSpreadOOXMLChartWriter.GetChartColorXML(AIndent: Integer;
 var
   indent: String;
   rgbStr: String;
-  alpha: Integer;
 begin
-  if (AColor.Transparency > 0) then
-  begin
-    alpha := round((1.0 - AColor.Transparency) * FACTOR_MULTIPLIER);
-    rgbStr := Format('<a:srgbClr val="%s"><a:alpha val="%d"/></a:srgbClr>',
-      [HtmlColorStr(AColor.Color), alpha], FPointSeparatorsettings
-    );
-  end else
-    rgbstr := Format('<a:srgbClr val="%s"/>',
-      [ HtmlColorStr(AColor.Color) ]
-    );
-
   indent := DupeString(' ', AIndent);
-
+  rgbStr := GetChartColorXML(AColor);
   Result :=
     indent + '<' + ANodeName + '>' + LE +
     indent + '  ' + rgbStr +  LE +
     indent + '</' + ANodeName + '>';
 end;
 
+function TsSpreadOOXMLChartWriter.GetChartColorXML(AColor: TsChartColor): String;
+var
+  alpha: Integer;
+begin
+  if (AColor.Transparency > 0) then
+  begin
+    alpha := round((1.0 - AColor.Transparency) * FACTOR_MULTIPLIER);
+    Result := Format('<a:srgbClr val="%s"><a:alpha val="%d"/></a:srgbClr>',
+      [HtmlColorStr(AColor.Color), alpha]
+    );
+  end else
+    Result := Format('<a:srgbClr val="%s"/>',
+      [ HtmlColorStr(AColor.Color) ]
+    );
+end;
 
 {@@ ----------------------------------------------------------------------------
   Assembles the xml string for the children of a <c:spPr> node (fill and line style)
@@ -3455,6 +3479,14 @@ const
 var
   indent: String;
   hatch: TsChartHatch;
+  gradient: TsChartGradient;
+  step: TsChartGradientStep;
+  gSteps: String = '';
+  gStyle: String = '';
+  lStr: String = '';
+  tStr: String = '';
+  rStr: String = '';
+  bStr: String = '';
   i: Integer;
   presetIdx: Integer;
   alpha: Integer;
@@ -3466,8 +3498,62 @@ begin
     Result := indent + '<a:noFill/>'
   else
     case AFill.Style of
+      // Solid fills
       cfsSolid:
         Result := GetChartColorXML(AIndent + 2, 'a:solidFill', AFill.Color);
+
+      // Gradient fills
+      cfsGradient:
+        begin
+          gradient := AChart.Gradients[AFill.Gradient];
+          gSteps := indent + '  <a:gsLst>' + LE;
+          for i := 0 to gradient.NumSteps - 1 do
+          begin
+            step := gradient.Steps[i];
+            gSteps := gSteps + Format(
+              indent + '    <a:gs pos="%.0f">' + LE +
+              indent + '      %s' + LE +
+              indent + '    </a:gs>' + LE,
+              [ step.Value * FACTOR_MULTIPLIER, GetChartColorXML(step.Color) ]
+            );
+          end;
+          gSteps := gSteps + indent + '  </a:gsLst>' + LE;
+          case gradient.Style of
+            cgsLinear:
+              gStyle := indent + Format('  <a:lin ang="%.0f" scaled="1"/>',
+                [ gradient.Angle * ANGLE_MULTIPLIER ]
+              );
+            cgsAxial,
+            cgsRadial,
+            cgsElliptic,
+            cgsSquare,
+            cgsRectangular,
+            cgsShape:
+              begin
+                case gradient.Style of
+                  cgsRectangular, cgsAxial: gStyle := 'rect';
+                  cgsElliptic, cgsRadial: gStyle := 'circle';
+                  else gStyle := 'shape';
+                end;
+                if gradient.CenterX <> 0 then lStr := Format('l="%.0f" ', [gradient.CenterX * FACTOR_MULTIPLIER]);
+                if gradient.CenterX <> 1.0 then rStr := Format('r="%.0f" ', [(1.0-gradient.CenterX) * FACTOR_MULTIPLIER]);
+                if gradient.CenterY <> 0 then tStr := Format('t="%.0f" ', [gradient.CenterY * FACTOR_MULTIPLIER]);
+                if gradient.CenterY <> 1.0 then bStr := Format('b="%.0f" ', [(1.0-gradient.CenterY) * FACTOR_MULTIPLIER]);
+                gStyle := Format(
+                  indent + '  <a:path path="%s">' + LE +
+                  indent + '    <a:fillToRect %s%s%s%s/>' + LE +
+                  indent + '  </a:path>' + LE,
+                  [ gStyle, lStr, tStr, rStr, bStr ]
+                );
+              end;
+          end;
+          Result := indent + '<a:gradFill>' + LE +
+                    gSteps +
+                    gStyle +
+                    indent + '</a:gradFill>' + LE;
+        end;
+
+      // Hatched and pattern fills
       cfsHatched, cfsSolidHatched:
         begin
           hatch := AChart.Hatches[AFill.Hatch];