diff --git a/components/fpspreadsheet/examples/other/chart/write_chart_demo.lpr b/components/fpspreadsheet/examples/other/chart/write_chart_demo.lpr
index b14fae548..7bccd8bf9 100644
--- a/components/fpspreadsheet/examples/other/chart/write_chart_demo.lpr
+++ b/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;
diff --git a/components/fpspreadsheet/source/common/fpschart.pas b/components/fpspreadsheet/source/common/fpschart.pas
index 97a840be8..3180a2be3 100644
--- a/components/fpspreadsheet/source/common/fpschart.pas
+++ b/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);
diff --git a/components/fpspreadsheet/source/common/fpsopendocument.pas b/components/fpspreadsheet/source/common/fpsopendocument.pas
index d9edd41be..3117b55cd 100644
--- a/components/fpspreadsheet/source/common/fpsopendocument.pas
+++ b/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
- continue;
- mime := GetImageMimeType(imgtype);
- ext := GetImageTypeExt(imgType);
- AppendToStream(FSMetaInfManifest, Format(
- ' ' + LE,
- [mime, i+1, ext]
- ));
+ if imgtype <> itUnknown then
+ begin
+ mime := GetImageMimeType(imgtype);
+ ext := GetImageTypeExt(imgType);
+ AppendToStream(FSMetaInfManifest, Format(
+ ' ' + LE,
+ [mime, i+1, ext]
+ ));
+ end;
end;
- for i:=0 to (FWorkbook as TsWorkbook).GetChartCount-1 do
- begin
- AppendToStream(FSMetaInfManifest, Format(
- ' ' + LE,
- [i+1]
- ));
- AppendToStream(FSMetaInfManifest, Format(
- ' ' + LE,
- [i+1]
- ));
- AppendToStream(FSMetaInfManifest, Format(
- ' ' + LE,
- [i+1]
- ));
- // Object X/meta.xml and ObjectReplacement/Object X not needed necessarily
- end;
+ TsSpreadOpenDocChartWriter(FChartWriter).AddToMetaInfManifest(FSMetaInfManifest);
AppendToStream(FSMetaInfManifest,
'');
@@ -6461,30 +6444,6 @@ begin
''
);
-{
- '' +
- '');
-}
// Fonts
AppendToStream(FSContent,
'');
diff --git a/components/fpspreadsheet/source/common/fpsopendocumentchart.pas b/components/fpspreadsheet/source/common/fpsopendocumentchart.pas
index 41cad6025..d84ad3c6e 100644
--- a/components/fpspreadsheet/source/common/fpsopendocumentchart.pas
+++ b/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(
+ ' ' + LE,
+ [i+1]
+ ));
+ AppendToStream(AStream, Format(
+ ' ' + LE,
+ [i+1]
+ ));
+ AppendToStream(AStream, Format(
+ ' ' + 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 + '' + LE,
[ domainRangeX ]
));
+ if fillColorRange <> '' then
+ AppendToStream(AChartStream, Format(
+ indent + '' + LE,
+ [ fillColorRange ]
+ ));
+
+ { --- not working...
+ if borderColorRange <> '' then
+ AppendToStream(AChartStream, Format(
+ indent + '' + LE,
+ [ borderColorRange ]
+ ));
+ }
AppendToStream(AChartStream, Format(
indent + ' ' + 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.
diff --git a/components/fpspreadsheet/source/common/fpsutils.pas b/components/fpspreadsheet/source/common/fpsutils.pas
index 176103d13..078486fc5 100644
--- a/components/fpspreadsheet/source/common/fpsutils.pas
+++ b/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
-------------------------------------------------------------------------------}