diff --git a/components/fpspreadsheet/examples/other/chart/write_chart_demo.lpr b/components/fpspreadsheet/examples/other/chart/write_chart_demo.lpr
index 2bf0e3352..adae1f950 100644
--- a/components/fpspreadsheet/examples/other/chart/write_chart_demo.lpr
+++ b/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';
diff --git a/components/fpspreadsheet/laz_fpspreadsheet.lpk b/components/fpspreadsheet/laz_fpspreadsheet.lpk
index a9d3f21da..97366824d 100644
--- a/components/fpspreadsheet/laz_fpspreadsheet.lpk
+++ b/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)."/>
-
+
@@ -305,6 +305,10 @@ This package is all you need if you don't want graphical components (such a
+
+
+
+
diff --git a/components/fpspreadsheet/source/common/fpschart.pas b/components/fpspreadsheet/source/common/fpschart.pas
index a3ec0d3b9..9d02f60de 100644
--- a/components/fpspreadsheet/source/common/fpschart.pas
+++ b/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);
diff --git a/components/fpspreadsheet/source/common/fpschartstyles.pas b/components/fpspreadsheet/source/common/fpschartstyles.pas
new file mode 100644
index 000000000..3a45be860
--- /dev/null
+++ b/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.
+
diff --git a/components/fpspreadsheet/source/common/fpsopendocument.pas b/components/fpspreadsheet/source/common/fpsopendocument.pas
index 12cab99b1..1029eff3e 100644
--- a/components/fpspreadsheet/source/common/fpsopendocument.pas
+++ b/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(
' ' + 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 + '' + LE +
+ ind + ' ' + LE +
+ ind + '' + LE,
+ [ idx+1, drawStroke, strokeColor, drawFillColor ]
+ );
+ end;
+
var
ind: String;
begin
@@ -6953,10 +7019,12 @@ begin
ind + ' ' + LE +
// ch1: style for element
+ GetChartBackgroundStyleXML(AIndent + 2) +
+ {
ind + ' ' + LE +
- ind + ' ' + LE +
+ ind + ' ' + LE + // '
ind + ' ' + LE +
-
+ }
// ch2: style for element
ind + ' ' + LE +
ind + ' ' + 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;