From 1ebdbb15d847ca8a83fd260c54de4472899f7656 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Mon, 5 Feb 2024 18:38:42 +0000 Subject: [PATCH] fpspreadsheet: Exploded sectors in pie series. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9213 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../other/chart/barchart_write_demo.lpr | 6 +- .../other/chart/piechart_write_demo.lpr | 15 +-- .../examples/other/chart/run_write_demos.bat | 4 +- .../fpspreadsheet/source/common/fpschart.pas | 100 ++++++++++----- .../source/common/fpsopendocumentchart.pas | 120 +++++++++++++++--- .../source/common/xlsxooxmlchart.pas | 49 ++++--- 6 files changed, 210 insertions(+), 84 deletions(-) diff --git a/components/fpspreadsheet/examples/other/chart/barchart_write_demo.lpr b/components/fpspreadsheet/examples/other/chart/barchart_write_demo.lpr index f9bc845b7..94e7aabd8 100644 --- a/components/fpspreadsheet/examples/other/chart/barchart_write_demo.lpr +++ b/components/fpspreadsheet/examples/other/chart/barchart_write_demo.lpr @@ -9,8 +9,8 @@ uses procedure WriteHelp; begin WriteLn('SYNTAX: barchart_write_demo [horz|vert] [side-by-side|stacked|percent-stacked] '); - WriteLn(' (no argument) ..... vertical bars'); - WriteLn(' rotated ........... horizontal bars'); + WriteLn(' vert .............. vertical bars'); + WriteLn(' horiz ............. horizontal bars'); WriteLn(' side-by-side ...... bars side-by-side (default)'); WriteLn(' stacked ........... stacked bars'); WriteLn(' percent-stacked ... stacked by percentage'); @@ -36,7 +36,7 @@ begin for i := 1 to ParamCount do case lowercase(ParamStr(i)) of - 'horz', 'horizontal': + 'horiz', 'horizontal': rotated := true; 'vert', 'vertical', 'rotated': rotated := false; diff --git a/components/fpspreadsheet/examples/other/chart/piechart_write_demo.lpr b/components/fpspreadsheet/examples/other/chart/piechart_write_demo.lpr index 008b4892f..068a0be78 100644 --- a/components/fpspreadsheet/examples/other/chart/piechart_write_demo.lpr +++ b/components/fpspreadsheet/examples/other/chart/piechart_write_demo.lpr @@ -58,18 +58,17 @@ begin ser.LabelPosition := lpOutside; ser.LabelFormat := '#,##0'; - // Individual sector colors, with white border + // Individual slice colors, with white border, sector index 1 "exploded" // Must be complete, otherwise will be ignored by Calc and replaced by default colors line := TsChartline.CreateSolid(scWhite, 0.8); fill := TsChartFill.CreateHatchFill(ch.Hatches.AddLineHatch('ltHorz', chsSingle, $00C0FF, 1, 0.1, 0), scWhite); - ser.DataPointStyles.AddSolidFill($C47244, line); - ser.DataPointStyles.AddSolidFill($317DED, line); - ser.DataPointStyles.AddSolidFill($A5A5A5, line); - ser.DataPointStyles.AddFillAndLine(fill, line); -// ser.DataPointStyles.AddSolidFill($00C0FF, line); - line.Color := scWhite; - ser.DataPointStyles.AddSolidFill($D69B5B, line); + ser.DataPointStyles.AddSolidFill(0, $C47244, line); + ser.DataPointStyles.AddSolidFill(1, $317DED, line, 10); // with explode offset, as percentage + ser.DataPointStyles.AddSolidFill(2, $A5A5A5, line); + ser.DataPointStyles.AddFillAndLine(3, fill, line); + ser.DataPointStyles.AddSolidFill(4, $D69B5B, line, 20); line.Free; + fill.Free; //ser.SetFillColorRange(4, 2, 8, 2); diff --git a/components/fpspreadsheet/examples/other/chart/run_write_demos.bat b/components/fpspreadsheet/examples/other/chart/run_write_demos.bat index 40a31b423..0a2138f70 100644 --- a/components/fpspreadsheet/examples/other/chart/run_write_demos.bat +++ b/components/fpspreadsheet/examples/other/chart/run_write_demos.bat @@ -10,8 +10,8 @@ areachart_write_demo stacked rotated areachart_write_demo percentage rotated echo. echo Bar series... -barchart_write_demo -barchart_write_demo rotated +barchart_write_demo vert +barchart_write_demo horiz barchart_2axes_write_demo barchart_2axes_write_demo rotated barchart_stacked_write_demo diff --git a/components/fpspreadsheet/source/common/fpschart.pas b/components/fpspreadsheet/source/common/fpschart.pas index a3358e318..2456535ae 100644 --- a/components/fpspreadsheet/source/common/fpschart.pas +++ b/components/fpspreadsheet/source/common/fpschart.pas @@ -6,7 +6,7 @@ unit fpsChart; interface uses - Classes, SysUtils, Contnrs, FPImage, fpsTypes, fpsUtils; + Classes, SysUtils, Types, Contnrs, FPImage, fpsTypes, fpsUtils; const clsNoLine = -2; @@ -401,7 +401,15 @@ type lcsRectangleWedge, lcsRoundRectWedge, lcsEllipseWedge ); - TsChartDataPointStyle = class(TsChartFillElement); + TsChartDataPointStyle = class(TsChartFillElement) + private + FDataPointIndex: Integer; + FPieOffset: Integer; + public + procedure CopyFrom(ASource: TsChartElement); + property DataPointIndex: Integer read FDataPointIndex write FDataPointIndex; + property PieOffset: Integer read FPieOffset write FPieOffset; // Percentage + end; TsChartDataPointStyleList = class(TFPObjectList) private @@ -410,8 +418,8 @@ type procedure SetItem(AIndex: Integer; AValue: TsChartDataPointStyle); public constructor Create(AChart: TsChart); - function AddFillAndLine(AFill: TsChartFill; ALine: TsChartline; ACount: Integer = 1): Integer; - function AddSolidFill(AColor: TsColor; ALine: TsChartLine = nil; ACount: Integer = 1): Integer; + function AddFillAndLine(ADataPointIndex: Integer; AFill: TsChartFill; ALine: TsChartline; APieOffset: Integer = 0): Integer; + function AddSolidFill(ADataPointIndex: Integer; AColor: TsColor; ALine: TsChartLine = nil; APieOffset: Integer = 0): Integer; property Items[AIndex: Integer]: TsChartDataPointStyle read GetItem write SetItem; default; end; @@ -642,11 +650,13 @@ type TsPieSeries = class(TsChartSeries) private - FStartAngle: Integer; // degrees FSliceOrder: TsSliceOrder; + FStartAngle: Integer; // degrees + function GetSliceOffset(ASliceIndex: Integer): Integer; public constructor Create(AChart: TsChart); override; property StartAngle: Integer read FStartAngle write FStartAngle; + property SliceOffset[ASliceIndex: Integer]: Integer read GetSliceOffset; // Percentage property SliceOrder: TsSliceOrder read FSliceOrder write FSliceOrder; end; @@ -1929,6 +1939,19 @@ begin end; +{ TsChartDataPointStyle } + +procedure TsChartDataPointStyle.CopyFrom(ASource: TsChartElement); +begin + inherited CopyFrom(ASource); + if ASource is TsChartDataPointStyle then + begin + FDataPointIndex := tsChartDataPointStyle(ASource).DataPointIndex; + FPieOffset := TsChartDataPointStyle(ASource).PieOffset; + end; +end; + + { TsChartDataPointStyleList } constructor TsChartDataPointStyleList.Create(AChart: TsChart); @@ -1939,39 +1962,36 @@ end; { Note: You have the responsibility to destroy the AFill and ALine instances after calling AddFillAndLine ! } -function TsChartDataPointStyleList.AddFillAndLine(AFill: TsChartFill; ALine: TsChartLine; - ACount: Integer = 1): Integer; +function TsChartDataPointStyleList.AddFillAndLine(ADatapointIndex: Integer; + AFill: TsChartFill; ALine: TsChartLine; APieOffset: Integer = 0): Integer; var dataPointStyle: TsChartDataPointStyle; - i: Integer; begin - if (AFill = nil) and (ALine = nil) then - for i := 1 to ACount do - Result := inherited Add(nil) + dataPointStyle := TsChartDataPointStyle.Create(FChart); + dataPointStyle.PieOffset := APieOffset; + dataPointStyle.FDataPointIndex := ADataPointIndex; + + if AFill <> nil then + dataPointStyle.Background.CopyFrom(AFill) else - for i := 1 to ACount do - begin - dataPointStyle := TsChartDataPointStyle.Create(FChart); - if AFill <> nil then - dataPointStyle.Background.CopyFrom(AFill) - else - begin - dataPointStyle.Background.Free; - dataPointStyle.Background := nil; - end; - if ALine <> nil then - dataPointStyle.Border.CopyFrom(ALine) - else - begin - dataPointStyle.Border.Free; - dataPointStyle.Border := nil; - end; - Result := inherited Add(dataPointStyle); - end; + begin + dataPointStyle.Background.Free; + dataPointStyle.Background := nil; + end; + + if ALine <> nil then + dataPointStyle.Border.CopyFrom(ALine) + else + begin + dataPointStyle.Border.Free; + dataPointStyle.Border := nil; + end; + + Result := inherited Add(dataPointStyle); end; -function TsChartDataPointStyleList.AddSolidFill(AColor: TsColor; - ALine: TsChartLine = nil; ACount: Integer = 1): Integer; +function TsChartDataPointStyleList.AddSolidFill(ADataPointIndex: Integer; + AColor: TsColor; ALine: TsChartLine = nil; APieOffset: Integer = 0): Integer; var fill: TsChartFill; begin @@ -1979,7 +1999,7 @@ begin try fill.Style := cfsSolid; fill.Color := AColor; - Result := AddFillAndLine(fill, ALine, ACount); + Result := AddFillAndLine(ADataPointIndex, fill, ALine, APieOffset); finally fill.Free; end; @@ -2485,6 +2505,20 @@ begin FLine.Color := scBlack; end; +function TsPieSeries.GetSliceOffset(ASliceIndex: Integer): Integer; +var + i: Integer; + datapointstyle: TsChartDatapointStyle; +begin + Result := 0; + if (ASliceIndex >= 0) and (ASliceIndex < FDataPointStyles.Count) then + begin + datapointstyle := FDatapointStyles[ASliceIndex]; + if datapointstyle <> nil then + Result := datapointstyle.PieOffset; + end; +end; + { TsRadarSeries } function TsRadarSeries.GetChartType: TsChartType; diff --git a/components/fpspreadsheet/source/common/fpsopendocumentchart.pas b/components/fpspreadsheet/source/common/fpsopendocumentchart.pas index 000f7f6ce..045047696 100644 --- a/components/fpspreadsheet/source/common/fpsopendocumentchart.pas +++ b/components/fpspreadsheet/source/common/fpsopendocumentchart.pas @@ -52,7 +52,7 @@ type 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); + ASeries: TsChartSeries; var AFill: TsChartFill; var ALine: TsChartLine; var APieOffset: Integer); procedure ReadChartSeriesErrorBarProps(ANode, AStyleNode: TDOMNode; AChart: TsChart; ASeries: TsChartSeries); procedure ReadChartSeriesErrorBarStyle(AStyleNode: TDOMNode; AChart: TsChart; @@ -108,7 +108,7 @@ type function GetChartRegressionStyleAsXML(AChart: TsChart; ASeriesIndex, AIndent, AStyleID: Integer): String; function GetChartSeriesDataPointStyleAsXML(AChart: TsChart; - ASeriesIndex, APointIndex, AIndent, AStyleID: Integer): String; + ASeriesIndex, ADataPointStyleIndex, AIndent, AStyleID: Integer): String; function GetChartSeriesStyleAsXML(AChart: TsChart; ASeriesIndex, AIndent, AStyleID: integer): String; function GetChartStockSeriesStyleAsXML(AChart: TsChart; @@ -1356,25 +1356,36 @@ begin end; procedure TsSpreadOpenDocChartReader.ReadChartSeriesDataPointStyle(AStyleNode: TDOMNode; - AChart: TsChart; ASeries: TsChartSeries; var AFill: TsChartFill; var ALine: TsChartLine); + AChart: TsChart; ASeries: TsChartSeries; var AFill: TsChartFill; var ALine: TsChartLine; + var APieOffset: Integer); var - nodeName: string; - grNode: TDOMNode; + nodeName, s: string; + value: Double; begin AFill := nil; ALine := nil; + APieOffset := 0; 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); + case nodeName of + 'style:graphic-properties': + 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; + 'style:chart-properties': + if ASeries is TsPieSeries then + begin + s := GetAttrValue(AStyleNode, 'chart:pie-offset'); + if TryStrToFloat(s, value, FPointSeparatorSettings) then + APieOffset := round(value); + end; end; AStyleNode := AStyleNode.NextSibling; end; @@ -1467,7 +1478,7 @@ var subNode: TDOMNode; styleNode: TDOMNode; xyCounter: Integer; - n: Integer; + i, n, pieOffset, ptIndex: Integer; begin s := GetAttrValue(ANode, 'chart:class'); if (FChartType = ctStock) and (s = '') then @@ -1523,6 +1534,7 @@ begin xyCounter := 0; subnode := ANode.FirstChild; + ptIndex := 0; while subnode <> nil do begin nodeName := subNode.NodeName; @@ -1557,16 +1569,21 @@ begin fill := nil; line := nil; n := 1; + pieOffset := 0; s := GetAttrValue(subnode, 'chart:style-name'); if s <> '' then begin styleNode := FindStyleNode(AStyleNode, s); - ReadChartSeriesDataPointStyle(styleNode, AChart, series, fill, line); // creates fill and line! + ReadChartSeriesDataPointStyle(styleNode, AChart, series, fill, line, pieOffset); // creates fill and line! end; s := GetAttrValue(subnode, 'chart:repeated'); if (s <> '') then n := StrToIntDef(s, 1); - series.DataPointStyles.AddFillAndLine(fill, line, n); + for i := 1 to n do + begin + series.DataPointStyles.AddFillAndLine(ptIndex, fill, line, pieOffset); + inc(ptIndex); + end; fill.Free; // the styles have been copied to the series datapoint list and are not needed any more. line.Free; end; @@ -2692,11 +2709,11 @@ begin end; {@@ ---------------------------------------------------------------------------- - Creates an xml string which contains the individual style of the - datapoint with index APointIndex of the series with index ASeriesIndex. + Creates an xml string which contains the individual datapoint style with index + ADataPointStyleIndex for the series with index ASeriesIndex. -------------------------------------------------------------------------------} function TsSpreadOpenDocChartWriter.GetChartSeriesDataPointStyleAsXML(AChart: TsChart; - ASeriesIndex, APointIndex, AIndent, AStyleID: Integer): String; + ASeriesIndex, ADataPointStyleIndex, AIndent, AStyleID: Integer): String; var series: TsChartSeries; indent: String; @@ -2708,11 +2725,29 @@ begin indent := DupeString(' ', AIndent); series := AChart.Series[ASeriesIndex]; - dataPointStyle := series.DataPointStyles[APointIndex]; + + if ADataPointStyleIndex > -1 then + dataPointStyle := series.DataPointStyles[ADataPointStyleIndex] + else + dataPointStyle := nil; + if dataPointStyle = nil then + begin + // The series process by the caller has not individual style format. + // We must write a node nevertheless... + Result := Format( + indent + '' + LE + + indent + ' ' + LE + + indent + ' ' + LE + + indent + '' + LE, + [ AStyleID ] + ); exit; + end; chartProps := 'chart:solid-type="cuboid" '; + if datapointstyle.PieOffset > 0 then + chartProps := chartProps + Format('chart:pie-offset="%d" ', [datapointStyle.PieOffset]); if dataPointStyle.Background <> nil then graphProps := graphProps + GetChartFillStyleGraphicPropsAsXML(AChart, dataPointStyle.Background); @@ -3709,9 +3744,10 @@ var trendlineEquation: String = ''; trendline: TsChartTrendline = nil; titleAddr: String; - i, count: Integer; + i, j, idx, count: Integer; nextStyleID, seriesStyleID, trendlineStyleID, trendlineEquStyleID: Integer; xErrStyleID, yErrStyleID, dataStyleID: Integer; + datapointStyle: TsChartDataPointStyle; begin indent := DupeString(' ', AChartIndent); @@ -3862,7 +3898,7 @@ begin inc(nextStyleID); end; - // Regression + // Trend line if (series is TsScatterSeries) then begin trendline := TsScatterSeries(series).trendline; @@ -3920,6 +3956,18 @@ begin else begin dataStyleID := nextStyleID; + // Every data point gets a node with individual format + for i := 0 to count - 1 do + begin + AppendToStream(AChartStream, Format( + indent + ' ' + LE, + [ dataStyleID + i ] + )); + inc(nextStyleID); + end; + end; + +{ for i := 0 to count - 1 do begin if (i >= series.DataPointStyles.Count) or (series.DataPointStyles[i] = nil) then @@ -3936,16 +3984,19 @@ begin end; end; end; + } AppendToStream(AChartStream, indent + '' + LE ); + // --------------------------------------------------------------------------- + // Series style AppendToStream(AStyleStream, GetChartSeriesStyleAsXML(AChart, ASeriesIndex, AStyleIndent, seriesStyleID) ); - // Regression style + // Trend line style if trendlineStyleID <> -1 then begin AppendToStream(AStyleStream, @@ -3973,13 +4024,40 @@ begin ); // Data point styles + if series.DataPointStyles.Count > 0 then + begin + for i := 0 to count - 1 do + begin + idx := -1; + for j := 0 to series.DataPointStyles.Count-1 do + begin + dataPointStyle := series.DataPointstyles[j]; + if (dataPointStyle <> nil) and (dataPointStyle.DataPointIndex = i) then + begin + idx := j; + break; + end; + end; + + AppendToStream(AStyleStream, + GetChartSeriesDataPointStyleAsXML(AChart, ASeriesIndex, idx, AStyleIndent, dataStyleID) + ); + inc(dataStyleID); + end; + end; + (* + for i := 0 to series.DataPointStyles.Count - 1 do begin + datapointStyle := series.DatapointStyles[i]; + for j := prevIdx+1 to datapointStyle.DataPointIndex-1 then; + AppendToStream(AStyleStream, GetChartSeriesDataPointStyleAsXML(AChart, ASeriesIndex, i, AStyleIndent, dataStyleID) ); inc(dataStyleID); end; + *) // Next style AStyleID := nextStyleID; diff --git a/components/fpspreadsheet/source/common/xlsxooxmlchart.pas b/components/fpspreadsheet/source/common/xlsxooxmlchart.pas index d2abcf77b..c2e438301 100644 --- a/components/fpspreadsheet/source/common/xlsxooxmlchart.pas +++ b/components/fpspreadsheet/source/common/xlsxooxmlchart.pas @@ -1061,26 +1061,34 @@ var nodename, s: String; fill: TsChartFill; line: TsChartLine; + idx: Integer; + explosion: Integer = 0; begin if ANode = nil then exit; - while Assigned(ANode) do - begin - nodeName := ANode.NodeName; - case nodeName of - 'c:spPr': - begin - fill := TsChartFill.Create; - line := TsChartLine.Create; + + fill := TsChartFill.Create; + line := TsChartLine.Create; + try + while Assigned(ANode) do + begin + nodeName := ANode.NodeName; + s := GetAttrValue(ANode, 'val'); + case nodeName of + 'c:idx': + if not TryStrToInt(s, idx) then // This is an error condition! + exit; + 'c:spPr': ReadChartFillAndLineProps(ANode.FirstChild, ASeries.Chart, fill, line); - ASeries.DataPointStyles.AddFillAndLine(fill, line); // fill and line are copied here - line.Free; - fill.Free; - end; - 'c:explosion': - ; // in case of pie series: movement of individual sector away from center + 'c:explosion': + explosion := StrToIntDef(s, 0); + end; + ANode := ANode.NextSibling; end; - ANode := ANode.NextSibling; + ASeries.DataPointStyles.AddFillAndLine(idx, fill, line, explosion); // fill and line are copied here + finally + line.Free; + fill.Free; end; end; @@ -1867,9 +1875,11 @@ procedure TsSpreadOOXMLChartReader.ReadChartSeriesProps(ANode: TDOMNode; ASeries var nodeName, s: String; n: Integer; + idx: Integer; begin if ANode = nil then exit; + idx := 0; while Assigned(ANode) do begin nodeName := ANode.NodeName; @@ -4081,22 +4091,27 @@ var indent: String; i: Integer; dps: TsChartDatapointStyle; - explosionStr: String = ''; + explosionStr: String; begin indent := DupeString(' ', AIndent); for i := 0 to ASeries.DataPointStyles.Count-1 do begin dps := ASeries.DataPointStyles[i]; + explosionStr := ''; if dps <> nil then + begin + if dps.PieOffset > 0 then + explosionStr := Format('', [dps.PieOffset]); AppendToStream(AStream, indent + '' + LE + indent + ' ' + LE + - explosionStr + // to do: read explosion value from worksheet! + explosionStr + indent + ' ' + LE + GetChartFillAndLineXML(AIndent + 4, ASeries.Chart, dps.Background, dps.Border) + LE + indent + ' ' + LE + indent + '' + LE ); + end; end; end;