fpspreadsheet: Chart link as well as ods reader/writer support individual data point colors

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

components/fpspreadsheet/examples/other/chart/piechart_write_demo.lpr

@@ -25,6 +25,7 @@ begin
     sheet.WriteText(1, 0, 'https://en.wikipedia.org/wiki/World_population');
     sheet.WriteHyperlink(1, 0, 'https://en.wikipedia.org/wiki/World_population');
     sheet.WriteText(3, 0, 'Continent');  sheet.WriteText  (3, 1, 'Population (millions)');
+    sheet.WriteFontStyle(3, 0, [fssBold]); sheet.WriteFontStyle(3, 1, [fssBold]);
     sheet.WriteText(4, 0, 'Asia');       sheet.WriteNumber(4, 1, 4641);      // sheet.WriteChartColor(4, 2, scYellow);
     sheet.WriteText(5, 0, 'Africa');     sheet.WriteNumber(5, 1, 1340);      // sheet.WriteChartColor(5, 2, scBrown);
     sheet.WriteText(6, 0, 'America');    sheet.WriteNumber(6, 1, 653 + 368); // sheet.WriteChartColor(6, 2, scRed);
@@ -53,6 +54,15 @@ begin
     ser.LabelPosition := lpOutside;
     ser.Line.Color := scWhite;
     ser.LabelFormat := '#,##0';
+
+    // Individual sector colors
+    // Must be complete, otherwise will be ignored by Calc and replaced by default colors
+    ser.AddDataPointStyle(scYellow);
+    ser.AddDataPointStyle(scMaroon);
+    ser.AddDataPointStyle(scRed);
+    ser.AddDataPointStyle(scWhite);
+    ser.AddDatapointStyle(scBlue);
+
     //ser.SetFillColorRange(4, 2, 8, 2);
 
     {

components/fpspreadsheet/source/common/fpschart.pas

@@ -40,6 +40,7 @@ type
     Width: Double;         // mm
     Color: TsColor;        // in hex: $00bbggrr, r=red, g=green, b=blue
     Transparency: Double;  // in percent
+    procedure CopyFrom(ALine: TsChartLine);
   end;
 
   TsChartGradientStyle = (cgsLinear, cgsAxial, cgsRadial, cgsElliptic, cgsSquare, cgsRectangular);
@@ -135,6 +136,7 @@ type
     Hatch: Integer;
     Image: Integer;
     Transparency: Double;  // 0.0 ... 1.0
+    procedure CopyFrom(AFill: TsChartFill);
   end;
 
   TsChartLineSegment = record
@@ -312,6 +314,8 @@ type
   TsChartDataLabels = set of TsChartDataLabel;
   TsChartLabelPosition = (lpDefault, lpOutside, lpInside, lpCenter);
 
+  TsChartDataPointStyle = class(TsChartFillElement);
+
   TsChartSeries = class(TsChartElement)
   private
     FChartType: TsChartType;
@@ -331,11 +335,14 @@ type
     FLine: TsChartLine;
     FFill: TsChartFill;
     FDataLabels: TsChartDataLabels;
+    FDataPointStyles: TFPObjectList;
   protected
     function GetChartType: TsChartType; virtual;
   public
     constructor Create(AChart: TsChart); virtual;
     destructor Destroy; override;
+    procedure AddDataPointStyle(AFill: TsChartFill; ALine: TsChartLine; ACount: Integer = 1);
+    procedure AddDataPointStyle(AColor: TsColor; ACount: Integer = 1);
     function GetCount: Integer;
     function GetXCount: Integer;
     function GetYCount: Integer;
@@ -361,6 +368,7 @@ type
     property ChartType: TsChartType read GetChartType;
     property Count: Integer read GetCount;
     property DataLabels: TsChartDataLabels read FDataLabels write FDataLabels;
+    property DataPointStyles: TFPObjectList read FDataPointStyles;
     property FillColorRange: TsChartRange read FFillColorRange write FFillColorRange;
     property LabelBackground: TsChartFill read FLabelBackground write FLabelBackground;
     property LabelBorder: TsChartLine read FLabelBorder write FLabelBorder;
@@ -659,6 +667,20 @@ implementation
 uses
   fpSpreadsheet;
 
+{ TsChartLine }
+
+procedure TsChartLine.CopyFrom(ALine: TsChartLine);
+begin
+  if ALine <> nil then
+  begin
+    Style := ALine.Style;
+    Width := ALine.Width;
+    Color := ALine.Color;
+    Transparency := ALine.Transparency;
+  end;
+end;
+
+
 { TsChartGradient }
 
 constructor TsChartGradient.Create;
@@ -900,6 +922,22 @@ begin
 end;
 
 
+{ TsChartFill }
+
+procedure TsChartFill.CopyFrom(AFill: TsChartFill);
+begin
+  if AFill <> nil then
+  begin
+    Style := AFill.Style;
+    Color := AFill.Color;
+    Gradient := AFill.Gradient;
+    Hatch := AFill.Hatch;
+    Image := AFill.Image;
+    Transparency := AFill.Transparency;
+  end;
+end;
+
+
 { TsChartLineStyle }
 
 function TsChartLineStyle.GetID: String;
@@ -1194,6 +1232,8 @@ begin
   FLine.Width := PtsToMM(DEFAULT_CHART_LINEWIDTH);
   FLine.Color := DEFAULT_SERIES_COLORS[idx mod Length(DEFAULT_SERIES_COLORS)];
 
+  FDataPointStyles := TFPObjectList.Create;
+
   FLabelFont := TsFont.Create;
   FLabelFont.Size := 9;
 
@@ -1213,6 +1253,7 @@ begin
   FLabelBackground.Free;
   FLabelBorder.Free;
   FLabelFont.Free;
+  FDataPointStyles.Free;
   FLine.Free;
   FFill.Free;
   FTitleAddr.Free;
@@ -1224,6 +1265,39 @@ begin
   inherited;
 end;
 
+procedure TsChartSeries.AddDataPointStyle(AFill: TsChartFill; ALine: TsChartLine;
+  ACount: Integer = 1);
+var
+  i: Integer;
+  dataPointStyle: TsChartDataPointStyle;
+begin
+  if (AFill = nil) and (ALine = nil) then
+    for i := 1 to ACount do
+      FDataPointStyles.Add(nil)
+  else
+    for i := 1 to ACount do
+    begin
+      dataPointStyle := TsChartDataPointStyle.Create(FChart);
+      dataPointStyle.Background.CopyFrom(AFill);
+      dataPointStyle.Border.CopyFrom(ALine);
+      FDataPointStyles.Add(dataPointStyle);
+    end;
+end;
+
+procedure TsChartSeries.AddDataPointStyle(AColor: TsColor; ACount: Integer = 1);
+var
+  i: Integer;
+  datapointStyle: TsChartDataPointStyle;
+begin
+  for i := 1 to ACount do
+  begin
+    datapointStyle := TsChartDatapointStyle.Create(FChart);
+    dataPointStyle.Background.Style:= cfsSolid;
+    dataPointStyle.Background.Color := AColor;
+    FDataPointStyles.Add(datapointStyle);
+  end;
+end;
+
 function TsChartSeries.GetChartType: TsChartType;
 begin
   Result := FChartType;

components/fpspreadsheet/source/common/fpsopendocumentchart.pas

@@ -26,8 +26,8 @@ type
     FPieSeriesStartAngle: Integer;
     FStreamList: TFPObjectList;
     function FindStyleNode(AStyleNodes: TDOMNode; AStyleName: String): TDOMNode;
-    procedure GetChartFillProps(ANode: TDOMNode; AChart: TsChart; AFill: TsChartFill);
+    function GetChartFillProps(ANode: TDOMNode; AChart: TsChart; AFill: TsChartFill): Boolean;
-    procedure GetChartLineProps(ANode: TDOMNode; AChart: TsChart; ALine: TsChartLine);
+    function GetChartLineProps(ANode: TDOMNode; AChart: TsChart; ALine: TsChartLine): Boolean;
     procedure GetChartTextProps(ANode: TDOMNode; AFont: TsFont);
 
     procedure ReadChartAxisGrid(ANode, AStyleNode: TDOMNode; AChart: TsChart; Axis: TsChartAxis);
@@ -45,6 +45,8 @@ type
     procedure ReadChartRegressionEquationStyle(AStyleNode: TDOMNode; AChart: TsChart; ASeries: TsChartSeries);
     procedure ReadChartRegressionProps(ANode, AStyleNode: TDOMNode; AChart: TsChart; ASeries: TsChartSeries);
     procedure ReadChartRegressionStyle(AStyleNode: TDOMNode; AChart: TsChart; ASeries: TsChartSeries);
+    procedure ReadChartSeriesDataPointStyle(AStyleNode: TDOMNode; AChart: TsChart;
+      ASeries: TsChartSeries; var AFill: TsChartFill; var ALine: TsChartLine);
     procedure ReadChartSeriesProps(ANode, AStyleNode: TDOMNode; AChart: TsChart);
     procedure ReadChartSeriesStyle(AStyleNode: TDOMNode; AChart: TsChart; ASeries: TsChartSeries);
     procedure ReadChartTitleProps(ANode, AStyleNode: TDOMNode; AChart: TsChart; ATitle: TsChartText);
@@ -89,6 +91,7 @@ type
     function GetChartRegressionEquationStyleAsXML(AChart: TsChart;
       AEquation: TsRegressionEquation; AIndent, AStyleID: Integer): String;
     function GetChartRegressionStyleAsXML(AChart: TsChart; ASeriesIndex, AIndent, AStyleID: Integer): String;
+    function GetChartSeriesDataPointStyleAsXML(AChart: TsChart; ASeriesIndex, APointIndex, AIndent, AStyleID: Integer): String;
     function GetChartSeriesStyleAsXML(AChart: TsChart; ASeriesIndex, AIndent, AStyleID: integer): String;
 
     function GetNumberFormatID(ANumFormat: String): String;
@@ -403,11 +406,16 @@ begin
   FChartFiles.Add(AFileList);
 end;
 
-procedure TsSpreadOpenDocChartReader.GetChartFillProps(ANode: TDOMNode;
+{@@ ----------------------------------------------------------------------------
-  AChart: TsChart; AFill: TsChartFill);
+  Reads the fill style properties from the specified node. Returns FALSE, if
+  the node contains no fill-specific attributes.
+-------------------------------------------------------------------------------}
+function TsSpreadOpenDocChartReader.GetChartFillProps(ANode: TDOMNode;
+  AChart: TsChart; AFill: TsChartFill): Boolean;
 var
   {%H-}nodeName: String;
-  s: String;
+  sFill: String;
+  sOpac: String;
   sc: String;
   sn: String;
   opacity: Double;
@@ -417,8 +425,8 @@ var
 begin
   nodeName := ANode.NodeName;
 
-  s := GetAttrValue(ANode, 'draw:fill');
+  sFill := GetAttrValue(ANode, 'draw:fill');
-  case s of
+  case sFill of
     'none':
       AFill.Style := cfsNoFill;
     '', 'solid':
@@ -472,13 +480,19 @@ begin
       end;
   end;
 
-  s := GetAttrValue(ANode, 'draw:opacity');
+  sOpac := GetAttrValue(ANode, 'draw:opacity');
-  if (s <> '') and TryPercentStrToFloat(s, opacity) then
+  if (sOpac <> '') and TryPercentStrToFloat(sOpac, opacity) then
     AFill.Transparency := 1.0 - opacity;
+
+  Result := (sFill <> '') or (sc <> '') or (sn <> '') or (sOpac <> '');
 end;
 
-procedure TsSpreadOpenDocChartReader.GetChartLineProps(ANode: TDOMNode;
+{ ------------------------------------------------------------------------------
-  AChart: TsChart; ALine: TsChartLine);
+  Reads the line formatting properties from the specified node.
+  Returns FALSE, if there are no line-related attributes.
+-------------------------------------------------------------------------------}
+function TsSpreadOpenDocChartReader.GetChartLineProps(ANode: TDOMNode;
+  AChart: TsChart; ALine: TsChartLine): Boolean;
 var
   {%H-}nodeName: String;
   s: String;
@@ -517,9 +531,11 @@ begin
   if (sw <> '') and EvalLengthStr(sw, value, rel) then
     ALine.Width := value;
 
-  so := 'draw:stroke-opacity';
+  so := GetAttrValue(ANode, 'draw:stroke-opacity');
   if (so <> '') and TryPercentStrToFloat(so, value) then
     ALine.Transparency := 1.0 - value*0.01;
+
+  Result := (s <> '') or (sc <> '') or (sw <> '') or (so <> '');
 end;
 
 procedure TsSpreadOpenDocChartReader.GetChartTextProps(ANode: TDOMNode;
@@ -1192,14 +1208,42 @@ begin
   end;
 end;
 
+procedure TsSpreadOpenDocChartReader.ReadChartSeriesDataPointStyle(AStyleNode: TDOMNode;
+  AChart: TsChart; ASeries: TsChartSeries; var AFill: TsChartFill; var ALine: TsChartLine);
+var
+  nodeName: string;
+  grNode: TDOMNode;
+begin
+  AFill := nil;
+  ALine := nil;
+
+  nodeName := AStyleNode.NodeName;
+  AStyleNode := AStyleNode.FirstChild;
+  while AStyleNode <> nil do
+  begin
+    nodeName := AStyleNode.NodeName;
+    if nodeName = 'style:graphic-properties' then
+    begin
+      AFill := TsChartFill.Create;
+      if not GetChartFillProps(AStyleNode, AChart, AFill) then FreeAndNil(AFill);
+      ALine := TsChartLine.Create;
+      if not GetChartLineProps(AStyleNode, AChart, ALine) then FreeAndNil(ALine);
+    end;
+    AStyleNode := AStyleNode.NextSibling;
+  end;
+end;
+
 procedure TsSpreadOpenDocChartReader.ReadChartSeriesProps(ANode, AStyleNode: TDOMNode;
   AChart: TsChart);
 var
   s, nodeName: String;
   series: TsChartSeries;
+  fill: TsChartFill;
+  line: TsChartLine;
   subNode: TDOMNode;
   styleNode: TDOMNode;
   xyCounter: Integer;
+  n: Integer;
 begin
   s := GetAttrValue(ANode, 'chart:class');
   case s of
@@ -1252,6 +1296,24 @@ begin
         end;
       'chart:regression-curve':
         ReadChartRegressionProps(subNode, AStyleNode, AChart, series);
+      'chart:data-point':
+        begin
+          fill := nil;
+          line := nil;
+          n := 1;
+          s := GetAttrValue(subnode, 'chart:style-name');
+          if s <> '' then
+          begin
+            styleNode := FindStyleNode(AStyleNode, s);
+            ReadChartSeriesDataPointStyle(styleNode, AChart, series, fill, line); // creates fill and line!
+          end;
+          s := GetAttrValue(subnode, 'chart:repeated');
+          if (s <> '') then
+            n := StrToIntDef(s, 1);
+          series.AddDataPointStyle(fill, line, n);
+          fill.Free;  // the styles have been copied to the series datapoint list and are not needed any more.
+          line.Free;
+        end;
     end;
     subnode := subNode.NextSibling;
   end;
@@ -2247,6 +2309,37 @@ begin
   );
 end;
 
+function TsSpreadOpenDocChartWriter.GetChartSeriesDataPointStyleAsXML(AChart: TsChart;
+  ASeriesIndex, APointIndex, AIndent, AStyleID: Integer): String;
+var
+  series: TsChartSeries;
+  indent: String;
+  chartProps: String;
+  graphProps: String = '';
+  dataPointStyle: TsChartDataPointStyle;
+begin
+  Result := '';
+  indent := DupeString(' ', AIndent);
+
+  series := AChart.Series[ASeriesIndex];
+  dataPointStyle := TsChartDataPointStyle(series.DataPointStyles[APointIndex]);
+
+  chartProps := 'chart:solid-type="cuboid" ';
+
+  if dataPointStyle.Background <> nil then
+    graphProps := graphProps + GetChartFillStyleGraphicPropsAsXML(AChart, dataPointStyle.Background);
+  if dataPointStyle.Border <> nil then
+    graphProps := graphProps + GetChartLineStyleGraphicPropsAsXML(AChart, dataPointStyle.Border);
+
+  Result := Format(
+    indent + '<style:style style:name="ch%d" style:family="chart">' + LE +
+    indent + '  <style:chart-properties %s/>' + LE +
+    indent + '  <style:graphic-properties %s/>' + LE +
+    indent + '</style:style>' + LE,
+    [ AStyleID, chartProps, graphProps ]
+  );
+end;
+
 
 { <style:style style:name="ch1400" style:family="chart" style:data-style-name="N0">
     <style:chart-properties
@@ -2326,9 +2419,9 @@ begin
     if pos('\n', labelSeparator) > 0 then
       labelSeparator := StringReplace(labelSeparator, '\n', '<text:line-break/>', [rfReplaceAll, rfIgnoreCase]);
     labelSeparator :=
-      '    <chart:label-separator>' + LE +
+      indent + '    <chart:label-separator>' + LE +
-      '      <text:p>' + labelSeparator + '</text:p>' + LE +
+      indent + '      <text:p>' + labelSeparator + '</text:p>' + LE +
-      '    </chart:label-separator>' + LE;
+      indent + '    </chart:label-separator>' + LE;
   end;
 
   if series.LabelBorder.Style <> clsNoLine then
@@ -2338,9 +2431,9 @@ begin
   end;
 
   if labelSeparator <> '' then
-    chartProps := '  <style:chart-properties ' + chartProps + '>' + LE + labelSeparator + '  </style:chart-properties>'
+    chartProps := indent + '  <style:chart-properties ' + chartProps + '>' + LE + labelSeparator + indent + '  </style:chart-properties>'
   else
-    chartProps := '  <style:chart-properties ' + chartProps + '/>';
+    chartProps := indent + '  <style:chart-properties ' + chartProps + '/>';
 
   // Graphic properties
   lineProps := GetChartLineStyleGraphicPropsAsXML(AChart, series.Line);
@@ -2361,7 +2454,7 @@ begin
 
   Result := Format(
     indent + '<style:style style:name="ch%d" style:family="chart" style:data-style-name="%s">' + LE +
-    indent + chartProps + LE +
+    chartProps + LE +
     indent + '  <style:graphic-properties %s/>' + LE +
     indent + '  <style:text-properties %s/>' + LE +
     indent + '</style:style>' + LE,
@@ -3196,9 +3289,11 @@ var
   needRegressionEquationStyle: Boolean = false;
   regression: TsChartRegression = nil;
   titleAddr: String;
-  count: Integer;
+  i, count: Integer;
+  styleID, dpStyleID: Integer;
 begin
   indent := DupeString(' ', AChartIndent);
+  styleID := AStyleID;
 
   series := AChart.Series[ASeriesIndex];
 
@@ -3324,6 +3419,7 @@ begin
         begin
           regressionEquation := regressionEquation + Format('chart:style-name="ch%d" ', [AStyleID + 2]);
           needRegressionEquationStyle := true;
+          styleID := AStyleID + 2;
         end;
       end;
       if regression.DisplayEquation then
@@ -3345,20 +3441,43 @@ begin
           indent + '    <chart:equation %s />' + LE +
           indent + '  </chart:regression-curve>' + LE,
           [ AStyleID + 1, regressionEquation ]
-        ))
+        ));
       end else
         AppendToStream(AChartStream, Format(
           indent + '  <chart:regression-curve chart:style-name="ch%d"/>',
           [ AStyleID + 1 ]
         ));
       needRegressionStyle := true;
+      if styleID = AStyleID then
+        styleID := AStyleID + 1;
     end;
   end;
 
-  AppendToStream(AChartStream, Format(
+  // Individual data point styles
-    indent + '  <chart:data-point chart:repeated="%d"/>' + LE,
+  if series.DataPointStyles.Count = 0 then
-    [ count ]
+    AppendToStream(AChartStream, Format(
-  ));
+      indent + '  <chart:data-point chart:repeated="%d"/>' + LE,
+      [ count ]
+    ))
+  else
+  begin
+    dpStyleID := styleID + 1;
+    for i := 0 to count - 1 do
+    begin
+      if (i >= series.DataPointStyles.Count) or (series.DataPointStyles[i] = nil) then
+        AppendToStream(AChartStream,
+          indent + '  <chart:data-point chart:repeated="1">' + LE
+        )
+      else
+      begin
+        AppendToStream(AChartStream, Format(
+          indent + '  <chart:data-point chart:style-name="ch%d" />' + LE,   // ToDo: could contain "chart:repeated"
+          [ dpStyleID ]
+        ));
+        inc(dpStyleID);
+      end;
+    end;
+  end;
   AppendToStream(AChartStream,
     indent + '</chart:series>' + LE
   );
@@ -3386,6 +3505,15 @@ begin
     end;
   end;
 
+  // Data point styles
+  for i := 0 to series.DataPointStyles.Count - 1 do
+  begin
+    inc(AStyleID);
+    AppendToStream(AStyleStream,
+      GetChartSeriesDataPointStyleAsXML(AChart, ASeriesIndex, i, AStyleIndent, AStyleID)
+    );
+  end;
+
   // Next style
   inc(AStyleID);
 end;

components/fpspreadsheet/source/visual/fpspreadsheetchart.pas

@@ -53,6 +53,7 @@ type
     FTitleCol, FTitleRow: Cardinal;
     FTitleSheetName: String;
     FCyclicX: Boolean;
+    FDataPointColors: array of TsColor;
     function GetRange(AIndex: TsXYLRange): String;
     function GetTitle: String;
     function GetWorkbook: TsWorkbook;
@@ -82,6 +83,7 @@ type
     procedure SetXRange(XIndex: Integer;ARange: TsChartRange);
     procedure SetYRange(YIndex: Integer; ARange: TsChartRange);
     procedure SetTitleAddr(Addr: TsChartCellAddr);
+    procedure UseDataPointColors(ASeries: TsChartSeries);
     property PointsNumber: Cardinal read FPointsNumber;
     property Workbook: TsWorkbook read GetWorkbook;
   public
@@ -481,6 +483,8 @@ begin
   end;
 
   FCurItem.Color := clTAColor;  // = clDefault
+  if AIndex <= High(FDataPointColors) then
+    FCurItem.Color := FDataPointColors[AIndex];
   if FRanges[rngColor] <> nil then
   begin
     GetXYItem(rngColor, 0, AIndex, dummyNumber, dummyString);
@@ -537,6 +541,7 @@ end;
   @param  APointIndex  Index of the data point for which the data are required
   @param  ANumber      (output) x or y coordinate of the data point
   @param  AText        Data point marks label text
+  @param  AColor       Individual data point color
 -------------------------------------------------------------------------------}
 procedure TsWorkbookChartSource.GetXYItem(ARangeIndex:TsXYLRange;
   AListIndex, APointIndex: Integer; out ANumber: Double; out AText: String);
@@ -891,6 +896,27 @@ begin
   SetRangeFromChart(rngY, YIndex, ARange);
 end;
 
+procedure TsWorkbookChartSource.UseDataPointColors(ASeries: TsChartSeries);
+var
+  datapointStyle: TsChartDataPointStyle;
+  i: Integer;
+begin
+  if ASeries = nil then
+  begin
+    SetLength(FDataPointColors, 0);
+    exit;
+  end;
+
+  SetLength(FDataPointColors, ASeries.DataPointStyles.Count);
+  for i := 0 to High(FDataPointColors) do
+  begin
+    datapointStyle := TsChartDataPointStyle(ASeries.DatapointStyles[i]);
+    FDataPointColors[i] := clTAColor;
+    if (dataPointStyle <> nil) and (datapointStyle.Background.Style = cfsSolid) then
+      FDataPointColors[i] := Convert_sColor_to_Color(dataPointStyle.Background.Color);
+  end;
+end;
+
 {@@ ----------------------------------------------------------------------------
   Setter method for the WorkbookSource
 -------------------------------------------------------------------------------}
@@ -1038,6 +1064,9 @@ begin
     if not ASeries.FillColorRange.IsEmpty then src.SetColorRange(ASeries.FillColorRange);
     src.SetTitleAddr(ASeries.TitleAddr);
 
+    // Copy individual data point colors to the chart series.
+    src.UseDataPointColors(ASeries);
+
     if stackable then begin
       calcSrc := TCalculatedChartSource.Create(self);
       calcSrc.Origin := src;