fpspreadsheet: Support individual fill colors of bars, bubbles, symbols. Fix dash line pattern broken after previous commit.

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

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

@@ -3,11 +3,15 @@ program write_chart_demo;
 {.$DEFINE DARK_MODE}
 
 uses
-  SysUtils, fpspreadsheet, fpstypes, fpschart, xlsxooxml, fpsopendocument;
+  SysUtils, fpspreadsheet, fpstypes, fpsUtils, fpschart, xlsxooxml, fpsopendocument;
 const
-  SERIES_CLASS: TsChartSeriesClass = TsBubbleSeries; //TsScatterSeries;
+  SERIES_CLASS: TsChartSeriesClass = TsAreaSeries;
+//  SERIES_CLASS: TsChartSeriesClass = TsBarSeries;
+//  SERIES_CLASS: TsChartSeriesClass = TsBubbleSeries;
+//  SERIES_CLASS: TsChartSeriesClass = TsLineSeries;
   r1 = 1;
   r2 = 8;
+  FILL_COLORS: array[0..r2-r1] of TsColor = (scRed, scGreen, scBlue, scYellow, scMagenta, scSilver, scBlack, scOlive);
 var
   b: TsWorkbook;
   sheet1, sheet2, sheet3: TsWorksheet;
@@ -21,13 +25,23 @@ begin
     sheet1 := b.AddWorksheet('test1');
     sheet1.WriteText(0, 1, '1+sin(x)');
     sheet1.WriteText(0, 2, '1+sin(x/2)');
-    sheet1.WriteText(0, 3, 'Bubble');
+    sheet1.WriteText(0, 3, 'Bubble Radius');
+    sheet1.WriteText(0, 4, 'Fill Color');
+    sheet1.WriteText(0, 5, 'Border Color');
     for i := r1 to r2-1 do
     begin
+      // x values or labels
       sheet1.WriteNumber(i, 0, i-1);
+      // 1st series y values
       sheet1.WriteNumber(i, 1, 1+sin(i-1));
+      // 2nd series y values
       sheet1.WriteNumber(i, 2, 1+sin((i-1)/2));
-      sheet1.WriteNumber(i, 3, i*i);   // Bubble series radii
+      // Bubble radii
+      sheet1.WriteNumber(i, 3, i*i);
+      // Fill colors
+      sheet1.WriteNumber(i, 4, FlipColorBytes(FILL_COLORS[i-r1]));  // !! ODS need red and blue channels exchanged !!
+      // Border colors
+      sheet1.WriteNumber(i, 5, FlipColorBytes(FILL_COLORS[r2-i]));
     end;
     sheet1.WriteNumber(r2, 0, 9);
     sheet1.WriteNumber(r2, 1, 2);
@@ -45,6 +59,7 @@ begin
     ser.SetYRange(r1, 1, r2, 1);
     ser.Line.Color := scBlue;
     ser.Fill.FgColor := scBlue;
+    ser.SetFillColorRange(r1, 4, r2, 4);
     if (ser is TsLineSeries) then
     begin
       TsLineSeries(ser).ShowSymbols := true;

components/fpspreadsheet/source/common/fpschart.pas

@@ -193,6 +193,7 @@ type
     FXRange: TsCellRange;          // cell range containing the x data
     FYRange: TsCellRange;
     FLabelRange: TsCellRange;
+    FFillColorRange: TsCellRange;
     FYAxis: TsChartAxisLink;
     FTitleAddr: TsCellCoord;
     FLabelFormat: String;
@@ -211,12 +212,14 @@ type
     procedure SetLabelRange(ARow1, ACol1, ARow2, ACol2: Cardinal);
     procedure SetXRange(ARow1, ACol1, ARow2, ACol2: Cardinal);
     procedure SetYRange(ARow1, ACol1, ARow2, ACol2: Cardinal);
+    procedure SetFillColorRange(ARow1, ACol1, ARow2, ACol2: Cardinal);
     function LabelsInCol: Boolean;
     function XValuesInCol: Boolean;
     function YValuesInCol: Boolean;
 
     property ChartType: TsChartType read FChartType;
     property Count: Integer read GetCount;
+    property FillColorRange: TsCellRange read FFillColorRange;
     property LabelFormat: String read FLabelFormat write FLabelFormat;  // Number format in Excel notation, e.g. '0.00'
     property LabelRange: TsCellRange read FLabelRange;
     property TitleAddr: TsCellCoord read FTitleAddr write FTitleAddr;
@@ -654,6 +657,16 @@ begin
   FTitleAddr.Col := ACol;
 end;
 
+procedure TsChartSeries.SetFillColorRange(ARow1, ACol1, ARow2, ACol2: Cardinal);
+begin
+  if (ARow1 <> ARow2) and (ACol1 <> ACol2) then
+    raise Exception.Create('Series fill color values can only be located in a single column or row.');
+  FFillColorRange.Row1 := ARow1;
+  FFillColorRange.Col1 := ACol1;
+  FFillColorRange.Row2 := ARow2;
+  FFillColorRange.Col2 := ACol2;
+end;
+
 procedure TsChartSeries.SetLabelRange(ARow1, ACol1, ARow2, ACol2: Cardinal);
 begin
   if (ARow1 <> ARow2) and (ACol1 <> ACol2) then
@@ -725,6 +738,7 @@ begin
   FChartType := ctBar;
 end;
 
+
 { TsBubbleSeries }
 
 constructor TsBubbleSeries.Create(AChart: TsChart);
@@ -736,13 +750,14 @@ end;
 procedure TsBubbleSeries.SetBubbleRange(ARow1, ACol1, ARow2, ACol2: Cardinal);
 begin
   if (ARow1 <> ARow2) and (ACol1 <> ACol2) then
-    raise Exception.Create('Series bubble values can only be located in a single column or row.');
+    raise Exception.Create('Bubble series values can only be located in a single column or row.');
   FBubbleRange.Row1 := ARow1;
   FBubbleRange.Col1 := ACol1;
   FBubbleRange.Row2 := ARow2;
   FBubbleRange.Col2 := ACol2;
 end;
 
+
 { TsLineSeries }
 
 constructor TsLineSeries.Create(AChart: TsChart);

components/fpspreadsheet/source/common/fpsopendocument.pas

@@ -277,7 +277,6 @@ type
     function WriteDefaultGraphicStyleXMLAsString: String; overload;
     function WriteDocumentProtectionXMLAsString: String;
     function WriteFontStyleXMLAsString(const AFormat: TsCellFormat): String; overload;
-//    function WriteFontStyleXMLAsString(AFont: TsFont): String; overload;
     function WriteHeaderFooterFontXMLAsString(AFont: TsHeaderFooterFont): String;
     function WriteHorAlignmentStyleXMLAsString(const AFormat: TsCellFormat): String;
     function WriteNumFormatStyleXMLAsString(const AFormat: TsCellFormat): String;
@@ -296,8 +295,6 @@ type
     // Streams with the contents of files
     FSMeta, FSSettings, FSStyles, FSContent: TStream;
     FSMimeType, FSMetaInfManifest: TStream;
-//    FSCharts: array of TStream;
-//    FSObjectStyles: array of TStream;
 
     { Helpers }
     procedure AddBuiltinNumFormats; override;
@@ -6120,32 +6117,18 @@ begin
   begin
     embObj := TsWorkbook(FWorkbook).GetEmbeddedObj(i);
     imgtype := embObj.ImageType;
-    if imgtype = itUnknown then
+    if imgtype <> itUnknown then
-      continue;
+    begin
-    mime := GetImageMimeType(imgtype);
+      mime := GetImageMimeType(imgtype);
-    ext := GetImageTypeExt(imgType);
+      ext := GetImageTypeExt(imgType);
-    AppendToStream(FSMetaInfManifest, Format(
+      AppendToStream(FSMetaInfManifest, Format(
-      '  <manifest:file-entry manifest:media-type="%s" manifest:full-path="Pictures/%d.%s" />' + LE,
+        '  <manifest:file-entry manifest:media-type="%s" manifest:full-path="Pictures/%d.%s" />' + LE,
-      [mime, i+1, ext]
+        [mime, i+1, ext]
-    ));
+      ));
+    end;
   end;
 
-  for i:=0 to (FWorkbook as TsWorkbook).GetChartCount-1 do
+  TsSpreadOpenDocChartWriter(FChartWriter).AddToMetaInfManifest(FSMetaInfManifest);
-  begin
-    AppendToStream(FSMetaInfManifest, Format(
-      '  <manifest:file-entry manifest:media-type="application/vnd.oasis.opendocument.chart" manifest:full-path="Object %d/" />' + LE,
-      [i+1]
-    ));
-    AppendToStream(FSMetaInfManifest, Format(
-      '  <manifest:file-entry manifest:media-type="text/xml" manifest:full-path="Object %d/content.xml" />' + LE,
-      [i+1]
-    ));
-    AppendToStream(FSMetaInfManifest, Format(
-      ' <manifest:file-entry manifest:media-type="text/xml" manifest:full-path="Object %d/styles.xml" />' + LE,
-      [i+1]
-    ));
-    // Object X/meta.xml and ObjectReplacement/Object X not needed necessarily
-  end;
 
   AppendToStream(FSMetaInfManifest,
     '</manifest:manifest>');
@@ -6461,30 +6444,6 @@ begin
     '<office:scripts />'
   );
 
-{
-    '<office:document-content xmlns:office="' + SCHEMAS_XMLNS_OFFICE +
-        '" xmlns:fo="'     + SCHEMAS_XMLNS_FO +
-        '" xmlns:xlink="http://www.w3.org/1999/xlink" xmlns:dc="http://purl.org/dc/elements/1.1/' +
-        '" xmlns:style="'  + SCHEMAS_XMLNS_STYLE +
-        '" xmlns:text="'   + SCHEMAS_XMLNS_TEXT +
-        '" xmlns:table="'  + SCHEMAS_XMLNS_TABLE +
-        '" xmlns:svg="'    + SCHEMAS_XMLNS_SVG +
-        '" xmlns:number="' + SCHEMAS_XMLNS_NUMBER +
-        '" xmlns:meta="'   + SCHEMAS_XMLNS_META +
-        '" xmlns:chart="'  + SCHEMAS_XMLNS_CHART +
-        '" xmlns:dr3d="'   + SCHEMAS_XMLNS_DR3D +
-        '" xmlns:math="'   + SCHEMAS_XMLNS_MATH +
-        '" xmlns:form="'   + SCHEMAS_XMLNS_FORM +
-        '" xmlns:script="' + SCHEMAS_XMLNS_SCRIPT +
-        '" xmlns:ooo="'    + SCHEMAS_XMLNS_OOO +
-        '" xmlns:ooow="'   + SCHEMAS_XMLNS_OOOW +
-        '" xmlns:oooc="'   + SCHEMAS_XMLNS_OOOC +
-        '" xmlns:dom="'    + SCHEMAS_XMLNS_DOM +
-        '" xmlns:xforms="' + SCHEMAS_XMLNS_XFORMS +
-        '" xmlns:xsd="'    + SCHEMAS_XMLNS_XSD +
-        '" xmlns:xsi="'    + SCHEMAS_XMLNS_XSI + '">' +
-      '<office:scripts />');
-}
   // Fonts
   AppendToStream(FSContent,
       '<office:font-face-decls>');

components/fpspreadsheet/source/common/fpsopendocumentchart.pas

@@ -56,6 +56,7 @@ type
   public
     constructor Create(AWriter: TsBasicSpreadWriter);
     procedure AddChartsToZip(AZip: TZipper);
+    procedure AddToMetaInfManifest(AStream: TStream);
     procedure CreateStreams; override;
     procedure DestroyStreams; override;
     procedure ResetStreams; override;
@@ -119,6 +120,30 @@ begin
   end;
 end;
 
+{ Writes the chart entries needed in the META-INF/manifest.xml file }
+procedure TsSpreadOpenDocChartWriter.AddToMetaInfManifest(AStream: TStream);
+var
+  i: Integer;
+begin
+  for i:=0 to TsWorkbook(Writer.Workbook).GetChartCount-1 do
+  begin
+    AppendToStream(AStream, Format(
+      '  <manifest:file-entry manifest:media-type="application/vnd.oasis.opendocument.chart" manifest:full-path="Object %d/" />' + LE,
+      [i+1]
+    ));
+    AppendToStream(AStream, Format(
+      '  <manifest:file-entry manifest:media-type="text/xml" manifest:full-path="Object %d/content.xml" />' + LE,
+      [i+1]
+    ));
+    AppendToStream(AStream, Format(
+      ' <manifest:file-entry manifest:media-type="text/xml" manifest:full-path="Object %d/styles.xml" />' + LE,
+      [i+1]
+    ));
+
+    // Object X/meta.xml and ObjectReplacement/Object X are not necessarily needed.
+  end;
+end;
+
 procedure TsSpreadOpenDocChartWriter.CreateStreams;
 var
   i, n: Integer;
@@ -1167,6 +1192,8 @@ var
   valuesRange: String;
   domainRangeX: String = '';
   domainRangeY: String = '';
+  fillColorRange: String = '';
+  borderColorRange: String = '';
   rangeStr: String = '';
   titleAddr: String;
   count: Integer;
@@ -1211,6 +1238,17 @@ begin
       rfAllRel, false
     );
 
+  // Fill colors for bars, line series symbols, bubbles
+  if (series.FillColorRange.Row1 <> series.FillColorRange.Row2) or
+     (series.FillColorRange.Col1 <> series.FillColorRange.Col2)
+  then
+    fillColorRange := GetSheetCellRangeString_ODS(
+      sheet.Name, sheet.Name,
+      series.FillColorRange.Row1, series.FillColorRange.Col1,
+      series.FillColorRange.Row2, series.FillColorRange.Col2,
+      rfAllRel, false
+    );
+
   // And these are the data point labels.
   titleAddr := GetSheetCellRangeString_ODS(
     sheet.Name, sheet.Name,
@@ -1238,6 +1276,19 @@ begin
       indent + '<chart:domain table:cell-range-address="%s"/>' + LE,
       [ domainRangeX ]
     ));
+  if fillColorRange <> '' then
+    AppendToStream(AChartStream, Format(
+      indent + '<loext:propertry-mapping loext:property="FillColor" loext:cell-range-address="%s"/>' + LE,
+      [ fillColorRange ]
+    ));
+
+  { --- not working...
+  if borderColorRange <> '' then
+    AppendToStream(AChartStream, Format(
+      indent + '<loext:propertry-mapping loext:property="BorderColor" loext:cell-range-address="%s"/>' + LE,
+      [ borderColorRange ]
+    ));
+  }
 
   AppendToStream(AChartStream, Format(
     indent + '  <chart:data-point chart:repeated="%d"/>' + LE,
@@ -1265,6 +1316,7 @@ begin
     begin
       chart := TsWorkbook(Writer.Workbook).GetChartByIndex(i);
       WriteChart(FSCharts[i], chart);
+      WriteObjectStyles(FSObjectStyles[i], chart);
     end;
 end;
 
@@ -1450,6 +1502,5 @@ begin
   inc(AStyleID);
 end;
 
-
 end.
 

components/fpspreadsheet/source/common/fpsutils.pas

@@ -189,6 +189,7 @@ function HTMLLengthStrToPts(AValue: String; DefaultUnits: String = 'pt'): Double
 function ColorToHTMLColorStr(AValue: TsColor; AExcelDialect: Boolean = false): String;
 function HTMLColorStrToColor(AValue: String): TsColor;
 
+function FlipColorBytes(AColor: TsColor): TsColor;
 function GetColorName(AColor: TsColor): String;
 function HighContrastColor(AColor: TsColor): TsColor;
 function IsPaletteIndex(AColor: TsColor): Boolean;
@@ -2213,6 +2214,16 @@ begin
     raise EFPSpreadsheet.Create('Unknown length units');
 end;
 
+function FlipColorBytes(AColor: TsColor): TsColor;
+var
+  r,g,b: Byte;
+begin
+  r := (AColor and $0000FF);
+  g := (AColor and $00FF00) shr 8;
+  b := (AColor and $FF0000) shr 16;
+  Result := b + g shl 8 + r shl 16;
+end;
+
 {@@ ----------------------------------------------------------------------------
   Determines the name of a color from its rgb value
 -------------------------------------------------------------------------------}