fpspreadsheet: Introducing ChartStyles for ods writer.

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

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

@@ -8,6 +8,8 @@ var
   ch: TsChart;
   ser: TsChartSeries;
   i: Integer;
+  bg: TsChartFill;
+  frm: TsChartLine;
 begin
   b := TsWorkbook.Create;
   try
@@ -25,6 +27,15 @@ begin
     ser.SetTitleAddr(0, 1);
     ser.SetLabelRange(1, 0, 7, 0);
     ser.SetYRange(1, 1, 7, 1);
+
+    bg.FgColor := scYellow;
+    bg.Style := fsSolidFill;
+    ch.Background := bg;
+
+    frm.color := scRed;
+    frm.Style := clsSolid;
+    ch.Border := frm;
+
     ch.Title.Caption := 'HALLO';
     ch.Title.Visible := true;
     ch.SubTitle.Caption := 'hallo';

components/fpspreadsheet/laz_fpspreadsheet.lpk

@@ -33,7 +33,7 @@
 This package is all you need if you don't want graphical components (such as grids and charts)."/>
     <License Value="LGPL with static linking exception. This is the same license as is used in the LCL (Lazarus Component Library)."/>
     <Version Major="1" Minor="17"/>
-    <Files Count="58">
+    <Files Count="59">
       <Item1>
         <Filename Value="source\fps.inc"/>
         <Type Value="Include"/>
@@ -305,6 +305,10 @@ This package is all you need if you don&apos;t want graphical components (such a
         <Filename Value="source\common\fpspreadsheet_chart.inc"/>
         <Type Value="Binary"/>
       </Item58>
+      <Item59>
+        <Filename Value="source\common\fpschartstyles.pas"/>
+        <UnitName Value="fpschartstyles"/>
+      </Item59>
     </Files>
     <CompatibilityMode Value="True"/>
     <i18n>

components/fpspreadsheet/source/common/fpschart.pas

@@ -1,6 +1,7 @@
 unit fpschart;
 
 {$mode objfpc}{$H+}
+{$modeswitch advancedrecords}
 
 interface
 
@@ -13,7 +14,7 @@ const
 
 {@@ Pre-defined chart line styles given as indexes into the chart's LineStyles
   list. Get their value in the constructor of TsChart. Default here to -1
-  while is the code for a solid line, just in case that something goes wrong }
+  which is the code for a solid line, just in case that something goes wrong }
 var
   clsFineDot: Integer = -1;
   clsDot: Integer = -1;
@@ -30,6 +31,7 @@ type
     Style: TsFillStyle;
     FgColor: TsColor;
     BgColor: TsColor;
+    class operator = (A, B: TsChartFill): Boolean;
   end;
 
   TsChartLineSegment = record
@@ -193,7 +195,8 @@ type
   end;
 
   TsChartSeriesSymbol = (
-    cssRect, cssDiamond, cssTriangle, cssTriangleDown, cssCircle, cssStar
+    cssRect, cssDiamond, cssTriangle, cssTriangleDown, cssTriangleLeft,
+    cssTriangleRight, cssCircle, cssStar, cssX, cssPlus, cssAsterisk
   );
 
   TsLineSeries = class(TsChartSeries)
@@ -282,6 +285,10 @@ type
     { Height of the chart, in mm }
     property Height: double read FHeight write FHeight;
 
+    { Attributes of the entire chart background }
+    property Background: TsChartFill read FBackground write FBackground;
+    property Border: TsChartLine read FBorder write FBorder;
+
     { Attributes of the plot area (rectangle enclosed by axes) }
     property PlotArea: TsChartFillElement read FPlotArea write FPlotArea;
     { Attributes of the floor of a 3D chart }
@@ -323,6 +330,14 @@ implementation
 const
   DEFAULT_LINE_WIDTH = 0.75;  // pts
 
+{ TsChartFill }
+
+class operator TsChartFill.= (A, B: TsChartFill): Boolean;
+begin
+  Result := (A.Style = B.Style) and (A.FgColor = B.FgColor) and (A.BgColor = B.BgColor);
+end;
+
+
 { TsChartLineStyle }
 
 function TsChartLineStyle.GetID: String;
@@ -648,6 +663,9 @@ begin
   FWidth := 12;
   FHeight := 9;
 
+  FBackground.Style := fsNoFill;
+  FBorder.Style := clsNoLine;
+
   FPlotArea := TsChartFillElement.Create(self);
   FFloor := TsChartFillElement.Create(self);
 

components/fpspreadsheet/source/common/fpschartstyles.pas

@@ -0,0 +1,98 @@
+unit fpsChartStyles;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpsTypes, fpsChart;
+
+type
+  TsChartStyle = class
+  public
+    procedure ApplyToChart(AChart: TsChart); virtual; abstract;
+    procedure ExtractFromChart(AChart: TsChart); virtual; abstract;
+  end;
+
+  TsChartBackgroundStyle = class(TsChartStyle)
+  private
+    FBackground: TsChartFill;
+    FBorder: TsChartLine;
+  public
+    procedure ApplyToChart(AChart: TsChart); override;
+    procedure ExtractFromChart(AChart: TsChart); override;
+    property Background: TsChartFill read FBackground;
+    property Border: TsChartLine read FBorder;
+  end;
+
+  TsChartStyleList = class(TFPList)
+  public
+    destructor Destroy; override;
+    procedure Clear;
+    function FindChartBackgroundStyle(AChart: TsChart): Integer;
+  end;
+
+implementation
+
+{ TsChartBackgroundstyle }
+
+procedure TsChartBackgroundStyle.ApplyToChart(AChart: TsChart);
+begin
+  AChart.Background := FBackground;
+  AChart.Border := FBorder;
+end;
+
+procedure TsChartBackgroundStyle.ExtractFromChart(AChart: TsChart);
+begin
+  FBackground := AChart.Background;
+  FBorder := AChart.Border;
+end;
+
+{ TsChartStyleList }
+
+destructor TsChartStyleList.Destroy;
+begin
+  Clear;
+  inherited;
+end;
+
+procedure TsChartStyleList.Clear;
+var
+  j: Integer;
+begin
+  for j := 0 to Count-1 do
+    TsChartStyle(Items[j]).Free;
+  inherited Clear;
+end;
+
+{ Searches whether the background style of the specified chart is already in the
+  list. If not, a new style is created and added.
+  Returns the index of the style. }
+function TsChartStyleList.FindChartBackgroundStyle(AChart: TsChart): Integer;
+var
+  newStyle, style: TsChartBackgroundStyle;
+  i: Integer;
+begin
+  Result := -1;
+  newStyle := TsChartBackgroundStyle.Create;
+  newStyle.ExtractFromChart(AChart);
+  for i := 0 to Count-1 do
+  begin
+    if (TsChartStyle(Items[i]) is TsChartBackgroundStyle) then
+    begin
+       style := TsChartBackgroundStyle(Items[i]);
+       if style.FBackground = newStyle.FBackground then
+       begin
+         Result := i;
+         break;
+       end;
+    end;
+  end;
+  if Result = -1 then
+    Result := Add(newStyle)
+  else
+    newStyle.Free;
+end;
+
+end.
+

components/fpspreadsheet/source/common/fpsopendocument.pas

@@ -224,6 +224,7 @@ type
 
   TsSpreadOpenDocWriter = class(TsCustomSpreadWriter)
   private
+    FChartStyleList: TFPList;
     FColumnStyleList: TFPList;
     FRowStyleList: TFPList;
     FRichTextFontList: TStringList;
@@ -318,6 +319,7 @@ type
       out AStyleName: String; out AHeight: Single);
     }
     procedure InternalWriteToStream(AStream: TStream);
+    procedure ListAllChartStyles;
     procedure ListAllColumnStyles;
     procedure ListAllHeaderFooterFonts;
     procedure ListAllNumFormats; override;
@@ -374,7 +376,7 @@ uses
   StrUtils, Variants, LazFileUtils, URIParser, LazUTF8,
   {%H-}fpsPatches,
   fpsStrings, fpsStreams, fpsCrypto, fpsClasses, fpspreadsheet,
-  fpsExprParser, fpsImages, fpsConditionalFormat;
+  fpsExprParser, fpsImages, fpsConditionalFormat, fpsChartStyles;
 
 const
   LE = LineEnding;
@@ -509,6 +511,11 @@ const
     '', 'bar', 'line', 'area', 'barLine', 'scatter'
   );
 
+  CHART_SYMBOL_NAMES: array[TsChartSeriesSymbol] of String = (
+    'square', 'diamond', 'arrow-up', 'arrow-down', 'arrow-left',
+    'arrow-right', 'circle', 'star', 'x', 'plus', 'asterisk'
+  );  // unsupported: bow-tie, hourglass, horizontal-bar, vertical-bar
+
 
 function CFOperandToStr(v: variant; AWorksheet: TsWorksheet;
   const AFormatSettings: TFormatSettings): String;
@@ -5823,6 +5830,7 @@ var
 begin
   { Analyze the workbook and collect all information needed }
   ListAllNumFormats;
+  ListAllChartStyles;
   ListAllColumnStyles;
   ListAllRowStyles;
   ListAllHeaderFooterFonts;
@@ -5864,6 +5872,22 @@ begin
   end;
 end;
 
+procedure TsSpreadOpenDocWriter.ListAllChartStyles;
+var
+  book: TsWorkbook;
+  chart: TsChart;
+  i: Integer;
+  styles: TsChartStyleList;
+begin
+  book := TsWorkbook(FWorkbook);
+  styles := TsChartStyleList(FChartStyleList);
+  for i := 0 to book.GetChartCount-1 do
+  begin
+    chart := book.GetChartByIndex(i);
+    styles.FindChartBackGroundStyle(chart);
+   end;
+end;
+
 procedure TsSpreadOpenDocWriter.ListAllColumnStyles;
 var
   i, j, c: Integer;
@@ -6677,6 +6701,7 @@ end;
 procedure TsSpreadOpenDocWriter.WriteChart(AStream: TStream; AChart: TsChart);
 var
   chartClass: String;
+  idx: Integer;
 begin
   AppendToStream(AStream,
     XML_HEADER + LE);
@@ -6731,12 +6756,14 @@ begin
   if chartClass <>  '' then
     chartClass := ' chart:class="chart:' + chartClass + '"';
 
+  idx := TsChartStyleList(FChartStyleList).FindChartBackgroundStyle(AChart);
   AppendToStream(AStream, Format(
     '      <chart:chart svg:width="%.3fmm" svg:height="%.3fmm" xlink:href=".." ' + LE +
-    '          xlink:type="simple"' + chartClass + ' chart:style-name="ch1"> ' + LE,
+    '          xlink:type="simple"' + chartClass + ' chart:style-name="ch%d"> ' + LE,
     [
     AChart.Width,      // Width, Height are in mm
-    AChart.Height
+    AChart.Height,
+    idx + 1
     ],  FPointSeparatorSettings
   ));
 
@@ -6941,6 +6968,45 @@ end;
 { To do: The list of styles must be updated to the real chart element settings. }
 procedure TsSpreadOpenDocWriter.WriteChartStyles(AStream: TStream;
   AChart: TsChart; AIndent: Integer);
+
+  function GetChartBackgroundStyleXML(AIndent: Integer): String;
+  var
+    ind: String;
+    idx: Integer;
+    style: TsChartBackgroundStyle;
+    s, drawStroke, strokeColor, drawFillColor: String;
+  begin
+    idx := TsChartStyleList(FChartStyleList).FindChartBackgroundStyle(AChart);
+    if idx = -1 then
+      raise Exception.Create('Chart background style not found.');
+    style := TsChartBackgroundStyle(FChartStyleList[idx]);
+
+    case style.Border.Style of
+      clsNoLine: s := 'none';
+      clsSolid: s := 'solid';
+      else s := 'none';   // FIXME: get correct line styles from chart
+    end;
+    drawStroke := 'draw:stroke="' + s + '" ';
+
+    if style.Border.Style <> clsNoLine then
+      strokeColor := 'svg:stroke-color="' + ColorToHTMLColorStr(style.Border.Color) + '" '
+    else
+      strokeColor := '';
+
+    if style.Background.Style = fsSolidFill then
+      drawFillColor := 'draw:fill-color="' + ColorToHTMLColorStr(style.Background.FGColor) + '" '
+    else
+      drawFillColor := '';
+
+    ind := DupeString(' ', AIndent);
+    Result := Format(
+      ind + '<style:style style:name="ch%d" style:family="chart">' + LE +
+      ind + '  <style:graphic-properties %s%s%s />' + LE +
+      ind + '</style:style>' + LE,
+      [ idx+1, drawStroke, strokeColor, drawFillColor ]
+    );
+  end;
+
 var
   ind: String;
 begin
@@ -6953,10 +7019,12 @@ begin
     ind + '  </number:number-style>' + LE +
 
     // ch1: style for <chart:chart> element
+    GetChartBackgroundStyleXML(AIndent + 2) +
+    {
     ind + '  <style:style style:name="ch1" style:family="chart">' + LE +
-    ind + '    <style:graphic-properties draw:stroke="none"/>' + LE +
+    ind + '    <style:graphic-properties draw:stroke="solid"/>' + LE +     // '
     ind + '  </style:style>' + LE +
-
+     }
     // ch2: style for <chart:title> element
     ind + '  <style:style style:name="ch2" style:family="chart">' + LE +
     ind + '    <style:chart-properties chart:auto-position="true" style:rotation-angle="0"/>' + LE +
@@ -8956,6 +9024,7 @@ constructor TsSpreadOpenDocWriter.Create(AWorkbook: TsBasicWorkbook);
 begin
   inherited Create(AWorkbook);
 
+  FChartStyleList := TsChartStyleList.Create;
   FColumnStyleList := TFPList.Create;
   FRowStyleList := TFPList.Create;
   FRichTextFontList := TStringList.Create;
@@ -8980,6 +9049,7 @@ begin
 
   FRichTextFontList.Free;    // Do not destroy fonts, they are owned by Workbook
   FHeaderFooterFontList.Free;
+  FChartStyleList.Free;
 
   inherited Destroy;
 end;