From 8919da735c9296ea0e5bf6554f9e39479649a86c Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Fri, 1 Dec 2023 23:54:16 +0000 Subject: [PATCH] fpspreadsheet: Chart link as well as ods reader/writer support individual data point colors git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9063 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../other/chart/piechart_write_demo.lpr | 10 + .../fpspreadsheet/source/common/fpschart.pas | 74 ++++++++ .../source/common/fpsopendocumentchart.pas | 176 +++++++++++++++--- .../source/visual/fpspreadsheetchart.pas | 29 +++ 4 files changed, 265 insertions(+), 24 deletions(-) diff --git a/components/fpspreadsheet/examples/other/chart/piechart_write_demo.lpr b/components/fpspreadsheet/examples/other/chart/piechart_write_demo.lpr index 69d9b51b3..5021d81ab 100644 --- a/components/fpspreadsheet/examples/other/chart/piechart_write_demo.lpr +++ b/components/fpspreadsheet/examples/other/chart/piechart_write_demo.lpr @@ -25,6 +25,7 @@ begin sheet.WriteText(1, 0, 'https://en.wikipedia.org/wiki/World_population'); sheet.WriteHyperlink(1, 0, 'https://en.wikipedia.org/wiki/World_population'); sheet.WriteText(3, 0, 'Continent'); sheet.WriteText (3, 1, 'Population (millions)'); + sheet.WriteFontStyle(3, 0, [fssBold]); sheet.WriteFontStyle(3, 1, [fssBold]); sheet.WriteText(4, 0, 'Asia'); sheet.WriteNumber(4, 1, 4641); // sheet.WriteChartColor(4, 2, scYellow); sheet.WriteText(5, 0, 'Africa'); sheet.WriteNumber(5, 1, 1340); // sheet.WriteChartColor(5, 2, scBrown); sheet.WriteText(6, 0, 'America'); sheet.WriteNumber(6, 1, 653 + 368); // sheet.WriteChartColor(6, 2, scRed); @@ -53,6 +54,15 @@ begin ser.LabelPosition := lpOutside; ser.Line.Color := scWhite; ser.LabelFormat := '#,##0'; + + // Individual sector colors + // Must be complete, otherwise will be ignored by Calc and replaced by default colors + ser.AddDataPointStyle(scYellow); + ser.AddDataPointStyle(scMaroon); + ser.AddDataPointStyle(scRed); + ser.AddDataPointStyle(scWhite); + ser.AddDatapointStyle(scBlue); + //ser.SetFillColorRange(4, 2, 8, 2); { diff --git a/components/fpspreadsheet/source/common/fpschart.pas b/components/fpspreadsheet/source/common/fpschart.pas index 80dce6b26..ec8375382 100644 --- a/components/fpspreadsheet/source/common/fpschart.pas +++ b/components/fpspreadsheet/source/common/fpschart.pas @@ -40,6 +40,7 @@ type Width: Double; // mm Color: TsColor; // in hex: $00bbggrr, r=red, g=green, b=blue Transparency: Double; // in percent + procedure CopyFrom(ALine: TsChartLine); end; TsChartGradientStyle = (cgsLinear, cgsAxial, cgsRadial, cgsElliptic, cgsSquare, cgsRectangular); @@ -135,6 +136,7 @@ type Hatch: Integer; Image: Integer; Transparency: Double; // 0.0 ... 1.0 + procedure CopyFrom(AFill: TsChartFill); end; TsChartLineSegment = record @@ -312,6 +314,8 @@ type TsChartDataLabels = set of TsChartDataLabel; TsChartLabelPosition = (lpDefault, lpOutside, lpInside, lpCenter); + TsChartDataPointStyle = class(TsChartFillElement); + TsChartSeries = class(TsChartElement) private FChartType: TsChartType; @@ -331,11 +335,14 @@ type FLine: TsChartLine; FFill: TsChartFill; FDataLabels: TsChartDataLabels; + FDataPointStyles: TFPObjectList; protected function GetChartType: TsChartType; virtual; public constructor Create(AChart: TsChart); virtual; destructor Destroy; override; + procedure AddDataPointStyle(AFill: TsChartFill; ALine: TsChartLine; ACount: Integer = 1); + procedure AddDataPointStyle(AColor: TsColor; ACount: Integer = 1); function GetCount: Integer; function GetXCount: Integer; function GetYCount: Integer; @@ -361,6 +368,7 @@ type property ChartType: TsChartType read GetChartType; property Count: Integer read GetCount; property DataLabels: TsChartDataLabels read FDataLabels write FDataLabels; + property DataPointStyles: TFPObjectList read FDataPointStyles; property FillColorRange: TsChartRange read FFillColorRange write FFillColorRange; property LabelBackground: TsChartFill read FLabelBackground write FLabelBackground; property LabelBorder: TsChartLine read FLabelBorder write FLabelBorder; @@ -659,6 +667,20 @@ implementation uses fpSpreadsheet; +{ TsChartLine } + +procedure TsChartLine.CopyFrom(ALine: TsChartLine); +begin + if ALine <> nil then + begin + Style := ALine.Style; + Width := ALine.Width; + Color := ALine.Color; + Transparency := ALine.Transparency; + end; +end; + + { TsChartGradient } constructor TsChartGradient.Create; @@ -900,6 +922,22 @@ begin end; +{ TsChartFill } + +procedure TsChartFill.CopyFrom(AFill: TsChartFill); +begin + if AFill <> nil then + begin + Style := AFill.Style; + Color := AFill.Color; + Gradient := AFill.Gradient; + Hatch := AFill.Hatch; + Image := AFill.Image; + Transparency := AFill.Transparency; + end; +end; + + { TsChartLineStyle } function TsChartLineStyle.GetID: String; @@ -1194,6 +1232,8 @@ begin FLine.Width := PtsToMM(DEFAULT_CHART_LINEWIDTH); FLine.Color := DEFAULT_SERIES_COLORS[idx mod Length(DEFAULT_SERIES_COLORS)]; + FDataPointStyles := TFPObjectList.Create; + FLabelFont := TsFont.Create; FLabelFont.Size := 9; @@ -1213,6 +1253,7 @@ begin FLabelBackground.Free; FLabelBorder.Free; FLabelFont.Free; + FDataPointStyles.Free; FLine.Free; FFill.Free; FTitleAddr.Free; @@ -1224,6 +1265,39 @@ begin inherited; end; +procedure TsChartSeries.AddDataPointStyle(AFill: TsChartFill; ALine: TsChartLine; + ACount: Integer = 1); +var + i: Integer; + dataPointStyle: TsChartDataPointStyle; +begin + if (AFill = nil) and (ALine = nil) then + for i := 1 to ACount do + FDataPointStyles.Add(nil) + else + for i := 1 to ACount do + begin + dataPointStyle := TsChartDataPointStyle.Create(FChart); + dataPointStyle.Background.CopyFrom(AFill); + dataPointStyle.Border.CopyFrom(ALine); + FDataPointStyles.Add(dataPointStyle); + end; +end; + +procedure TsChartSeries.AddDataPointStyle(AColor: TsColor; ACount: Integer = 1); +var + i: Integer; + datapointStyle: TsChartDataPointStyle; +begin + for i := 1 to ACount do + begin + datapointStyle := TsChartDatapointStyle.Create(FChart); + dataPointStyle.Background.Style:= cfsSolid; + dataPointStyle.Background.Color := AColor; + FDataPointStyles.Add(datapointStyle); + end; +end; + function TsChartSeries.GetChartType: TsChartType; begin Result := FChartType; diff --git a/components/fpspreadsheet/source/common/fpsopendocumentchart.pas b/components/fpspreadsheet/source/common/fpsopendocumentchart.pas index bf56dfcf5..cabf369ae 100644 --- a/components/fpspreadsheet/source/common/fpsopendocumentchart.pas +++ b/components/fpspreadsheet/source/common/fpsopendocumentchart.pas @@ -26,8 +26,8 @@ type FPieSeriesStartAngle: Integer; FStreamList: TFPObjectList; function FindStyleNode(AStyleNodes: TDOMNode; AStyleName: String): TDOMNode; - procedure GetChartFillProps(ANode: TDOMNode; AChart: TsChart; AFill: TsChartFill); - procedure GetChartLineProps(ANode: TDOMNode; AChart: TsChart; ALine: TsChartLine); + function GetChartFillProps(ANode: TDOMNode; AChart: TsChart; AFill: TsChartFill): Boolean; + function GetChartLineProps(ANode: TDOMNode; AChart: TsChart; ALine: TsChartLine): Boolean; procedure GetChartTextProps(ANode: TDOMNode; AFont: TsFont); procedure ReadChartAxisGrid(ANode, AStyleNode: TDOMNode; AChart: TsChart; Axis: TsChartAxis); @@ -45,6 +45,8 @@ type procedure ReadChartRegressionEquationStyle(AStyleNode: TDOMNode; AChart: TsChart; ASeries: TsChartSeries); procedure ReadChartRegressionProps(ANode, AStyleNode: TDOMNode; AChart: TsChart; ASeries: TsChartSeries); procedure ReadChartRegressionStyle(AStyleNode: TDOMNode; AChart: TsChart; ASeries: TsChartSeries); + procedure ReadChartSeriesDataPointStyle(AStyleNode: TDOMNode; AChart: TsChart; + ASeries: TsChartSeries; var AFill: TsChartFill; var ALine: TsChartLine); procedure ReadChartSeriesProps(ANode, AStyleNode: TDOMNode; AChart: TsChart); procedure ReadChartSeriesStyle(AStyleNode: TDOMNode; AChart: TsChart; ASeries: TsChartSeries); procedure ReadChartTitleProps(ANode, AStyleNode: TDOMNode; AChart: TsChart; ATitle: TsChartText); @@ -89,6 +91,7 @@ type function GetChartRegressionEquationStyleAsXML(AChart: TsChart; AEquation: TsRegressionEquation; AIndent, AStyleID: Integer): String; function GetChartRegressionStyleAsXML(AChart: TsChart; ASeriesIndex, AIndent, AStyleID: Integer): String; + function GetChartSeriesDataPointStyleAsXML(AChart: TsChart; ASeriesIndex, APointIndex, AIndent, AStyleID: Integer): String; function GetChartSeriesStyleAsXML(AChart: TsChart; ASeriesIndex, AIndent, AStyleID: integer): String; function GetNumberFormatID(ANumFormat: String): String; @@ -403,11 +406,16 @@ begin FChartFiles.Add(AFileList); end; -procedure TsSpreadOpenDocChartReader.GetChartFillProps(ANode: TDOMNode; - AChart: TsChart; AFill: TsChartFill); +{@@ ---------------------------------------------------------------------------- + Reads the fill style properties from the specified node. Returns FALSE, if + the node contains no fill-specific attributes. +-------------------------------------------------------------------------------} +function TsSpreadOpenDocChartReader.GetChartFillProps(ANode: TDOMNode; + AChart: TsChart; AFill: TsChartFill): Boolean; var {%H-}nodeName: String; - s: String; + sFill: String; + sOpac: String; sc: String; sn: String; opacity: Double; @@ -417,8 +425,8 @@ var begin nodeName := ANode.NodeName; - s := GetAttrValue(ANode, 'draw:fill'); - case s of + sFill := GetAttrValue(ANode, 'draw:fill'); + case sFill of 'none': AFill.Style := cfsNoFill; '', 'solid': @@ -472,13 +480,19 @@ begin end; end; - s := GetAttrValue(ANode, 'draw:opacity'); - if (s <> '') and TryPercentStrToFloat(s, opacity) then + sOpac := GetAttrValue(ANode, 'draw:opacity'); + if (sOpac <> '') and TryPercentStrToFloat(sOpac, opacity) then AFill.Transparency := 1.0 - opacity; + + Result := (sFill <> '') or (sc <> '') or (sn <> '') or (sOpac <> ''); end; -procedure TsSpreadOpenDocChartReader.GetChartLineProps(ANode: TDOMNode; - AChart: TsChart; ALine: TsChartLine); +{ ------------------------------------------------------------------------------ + Reads the line formatting properties from the specified node. + Returns FALSE, if there are no line-related attributes. +-------------------------------------------------------------------------------} +function TsSpreadOpenDocChartReader.GetChartLineProps(ANode: TDOMNode; + AChart: TsChart; ALine: TsChartLine): Boolean; var {%H-}nodeName: String; s: String; @@ -517,9 +531,11 @@ begin if (sw <> '') and EvalLengthStr(sw, value, rel) then ALine.Width := value; - so := 'draw:stroke-opacity'; + so := GetAttrValue(ANode, 'draw:stroke-opacity'); if (so <> '') and TryPercentStrToFloat(so, value) then ALine.Transparency := 1.0 - value*0.01; + + Result := (s <> '') or (sc <> '') or (sw <> '') or (so <> ''); end; procedure TsSpreadOpenDocChartReader.GetChartTextProps(ANode: TDOMNode; @@ -1192,14 +1208,42 @@ begin end; end; +procedure TsSpreadOpenDocChartReader.ReadChartSeriesDataPointStyle(AStyleNode: TDOMNode; + AChart: TsChart; ASeries: TsChartSeries; var AFill: TsChartFill; var ALine: TsChartLine); +var + nodeName: string; + grNode: TDOMNode; +begin + AFill := nil; + ALine := nil; + + nodeName := AStyleNode.NodeName; + AStyleNode := AStyleNode.FirstChild; + while AStyleNode <> nil do + begin + nodeName := AStyleNode.NodeName; + if nodeName = 'style:graphic-properties' then + begin + AFill := TsChartFill.Create; + if not GetChartFillProps(AStyleNode, AChart, AFill) then FreeAndNil(AFill); + ALine := TsChartLine.Create; + if not GetChartLineProps(AStyleNode, AChart, ALine) then FreeAndNil(ALine); + end; + AStyleNode := AStyleNode.NextSibling; + end; +end; + procedure TsSpreadOpenDocChartReader.ReadChartSeriesProps(ANode, AStyleNode: TDOMNode; AChart: TsChart); var s, nodeName: String; series: TsChartSeries; + fill: TsChartFill; + line: TsChartLine; subNode: TDOMNode; styleNode: TDOMNode; xyCounter: Integer; + n: Integer; begin s := GetAttrValue(ANode, 'chart:class'); case s of @@ -1252,6 +1296,24 @@ begin end; 'chart:regression-curve': ReadChartRegressionProps(subNode, AStyleNode, AChart, series); + 'chart:data-point': + begin + fill := nil; + line := nil; + n := 1; + s := GetAttrValue(subnode, 'chart:style-name'); + if s <> '' then + begin + styleNode := FindStyleNode(AStyleNode, s); + ReadChartSeriesDataPointStyle(styleNode, AChart, series, fill, line); // creates fill and line! + end; + s := GetAttrValue(subnode, 'chart:repeated'); + if (s <> '') then + n := StrToIntDef(s, 1); + series.AddDataPointStyle(fill, line, n); + fill.Free; // the styles have been copied to the series datapoint list and are not needed any more. + line.Free; + end; end; subnode := subNode.NextSibling; end; @@ -2247,6 +2309,37 @@ begin ); end; +function TsSpreadOpenDocChartWriter.GetChartSeriesDataPointStyleAsXML(AChart: TsChart; + ASeriesIndex, APointIndex, AIndent, AStyleID: Integer): String; +var + series: TsChartSeries; + indent: String; + chartProps: String; + graphProps: String = ''; + dataPointStyle: TsChartDataPointStyle; +begin + Result := ''; + indent := DupeString(' ', AIndent); + + series := AChart.Series[ASeriesIndex]; + dataPointStyle := TsChartDataPointStyle(series.DataPointStyles[APointIndex]); + + chartProps := 'chart:solid-type="cuboid" '; + + if dataPointStyle.Background <> nil then + graphProps := graphProps + GetChartFillStyleGraphicPropsAsXML(AChart, dataPointStyle.Background); + if dataPointStyle.Border <> nil then + graphProps := graphProps + GetChartLineStyleGraphicPropsAsXML(AChart, dataPointStyle.Border); + + Result := Format( + indent + '' + LE + + indent + ' ' + LE + + indent + ' ' + LE + + indent + '' + LE, + [ AStyleID, chartProps, graphProps ] + ); +end; + { 0 then labelSeparator := StringReplace(labelSeparator, '\n', '', [rfReplaceAll, rfIgnoreCase]); labelSeparator := - ' ' + LE + - ' ' + labelSeparator + '' + LE + - ' ' + LE; + indent + ' ' + LE + + indent + ' ' + labelSeparator + '' + LE + + indent + ' ' + LE; end; if series.LabelBorder.Style <> clsNoLine then @@ -2338,9 +2431,9 @@ begin end; if labelSeparator <> '' then - chartProps := ' ' + LE + labelSeparator + ' ' + chartProps := indent + ' ' + LE + labelSeparator + indent + ' ' else - chartProps := ' '; + chartProps := indent + ' '; // Graphic properties lineProps := GetChartLineStyleGraphicPropsAsXML(AChart, series.Line); @@ -2361,7 +2454,7 @@ begin Result := Format( indent + '' + LE + - indent + chartProps + LE + + chartProps + LE + indent + ' ' + LE + indent + ' ' + LE + indent + '' + LE, @@ -3196,9 +3289,11 @@ var needRegressionEquationStyle: Boolean = false; regression: TsChartRegression = nil; titleAddr: String; - count: Integer; + i, count: Integer; + styleID, dpStyleID: Integer; begin indent := DupeString(' ', AChartIndent); + styleID := AStyleID; series := AChart.Series[ASeriesIndex]; @@ -3324,6 +3419,7 @@ begin begin regressionEquation := regressionEquation + Format('chart:style-name="ch%d" ', [AStyleID + 2]); needRegressionEquationStyle := true; + styleID := AStyleID + 2; end; end; if regression.DisplayEquation then @@ -3345,20 +3441,43 @@ begin indent + ' ' + LE + indent + ' ' + LE, [ AStyleID + 1, regressionEquation ] - )) + )); end else AppendToStream(AChartStream, Format( indent + ' ', [ AStyleID + 1 ] )); needRegressionStyle := true; + if styleID = AStyleID then + styleID := AStyleID + 1; end; end; - AppendToStream(AChartStream, Format( - indent + ' ' + LE, - [ count ] - )); + // Individual data point styles + if series.DataPointStyles.Count = 0 then + AppendToStream(AChartStream, Format( + indent + ' ' + LE, + [ count ] + )) + else + begin + dpStyleID := styleID + 1; + for i := 0 to count - 1 do + begin + if (i >= series.DataPointStyles.Count) or (series.DataPointStyles[i] = nil) then + AppendToStream(AChartStream, + indent + ' ' + LE + ) + else + begin + AppendToStream(AChartStream, Format( + indent + ' ' + LE, // ToDo: could contain "chart:repeated" + [ dpStyleID ] + )); + inc(dpStyleID); + end; + end; + end; AppendToStream(AChartStream, indent + '' + LE ); @@ -3386,6 +3505,15 @@ begin end; end; + // Data point styles + for i := 0 to series.DataPointStyles.Count - 1 do + begin + inc(AStyleID); + AppendToStream(AStyleStream, + GetChartSeriesDataPointStyleAsXML(AChart, ASeriesIndex, i, AStyleIndent, AStyleID) + ); + end; + // Next style inc(AStyleID); end; diff --git a/components/fpspreadsheet/source/visual/fpspreadsheetchart.pas b/components/fpspreadsheet/source/visual/fpspreadsheetchart.pas index 94bc40134..c69b42fa0 100644 --- a/components/fpspreadsheet/source/visual/fpspreadsheetchart.pas +++ b/components/fpspreadsheet/source/visual/fpspreadsheetchart.pas @@ -53,6 +53,7 @@ type FTitleCol, FTitleRow: Cardinal; FTitleSheetName: String; FCyclicX: Boolean; + FDataPointColors: array of TsColor; function GetRange(AIndex: TsXYLRange): String; function GetTitle: String; function GetWorkbook: TsWorkbook; @@ -82,6 +83,7 @@ type procedure SetXRange(XIndex: Integer;ARange: TsChartRange); procedure SetYRange(YIndex: Integer; ARange: TsChartRange); procedure SetTitleAddr(Addr: TsChartCellAddr); + procedure UseDataPointColors(ASeries: TsChartSeries); property PointsNumber: Cardinal read FPointsNumber; property Workbook: TsWorkbook read GetWorkbook; public @@ -481,6 +483,8 @@ begin end; FCurItem.Color := clTAColor; // = clDefault + if AIndex <= High(FDataPointColors) then + FCurItem.Color := FDataPointColors[AIndex]; if FRanges[rngColor] <> nil then begin GetXYItem(rngColor, 0, AIndex, dummyNumber, dummyString); @@ -537,6 +541,7 @@ end; @param APointIndex Index of the data point for which the data are required @param ANumber (output) x or y coordinate of the data point @param AText Data point marks label text + @param AColor Individual data point color -------------------------------------------------------------------------------} procedure TsWorkbookChartSource.GetXYItem(ARangeIndex:TsXYLRange; AListIndex, APointIndex: Integer; out ANumber: Double; out AText: String); @@ -891,6 +896,27 @@ begin SetRangeFromChart(rngY, YIndex, ARange); end; +procedure TsWorkbookChartSource.UseDataPointColors(ASeries: TsChartSeries); +var + datapointStyle: TsChartDataPointStyle; + i: Integer; +begin + if ASeries = nil then + begin + SetLength(FDataPointColors, 0); + exit; + end; + + SetLength(FDataPointColors, ASeries.DataPointStyles.Count); + for i := 0 to High(FDataPointColors) do + begin + datapointStyle := TsChartDataPointStyle(ASeries.DatapointStyles[i]); + FDataPointColors[i] := clTAColor; + if (dataPointStyle <> nil) and (datapointStyle.Background.Style = cfsSolid) then + FDataPointColors[i] := Convert_sColor_to_Color(dataPointStyle.Background.Color); + end; +end; + {@@ ---------------------------------------------------------------------------- Setter method for the WorkbookSource -------------------------------------------------------------------------------} @@ -1038,6 +1064,9 @@ begin if not ASeries.FillColorRange.IsEmpty then src.SetColorRange(ASeries.FillColorRange); src.SetTitleAddr(ASeries.TitleAddr); + // Copy individual data point colors to the chart series. + src.UseDataPointColors(ASeries); + if stackable then begin calcSrc := TCalculatedChartSource.Create(self); calcSrc.Origin := src;