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 -------------------------------------------------------------------------------}