paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fpspreadsheet: Exploded sectors in pie series.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9213 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2024-02-05 18:38:42 +00:00
parent 5c3be57541
commit 1ebdbb15d8
6 changed files with 210 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
components/fpspreadsheet/examples/other/chart/barchart_write_demo.lpr
View File

@ -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;

15
components/fpspreadsheet/examples/other/chart/piechart_write_demo.lpr
View File

@ -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);

4
components/fpspreadsheet/examples/other/chart/run_write_demos.bat
View File

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

100
components/fpspreadsheet/source/common/fpschart.pas
View File

@ -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;

120
components/fpspreadsheet/source/common/fpsopendocumentchart.pas
View File

@ -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 + '<style:style style:name="ch%d" style:family="chart">' + LE +
indent + ' <style:chart-properties/>' + LE +
indent + ' <style:graphic-properties/>' + LE +
indent + '</style:style>' + 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 <chart:data-point> node with individual format
for i := 0 to count - 1 do
begin
AppendToStream(AChartStream, Format(
indent + ' <chart:data-point chart:style.name="ch%d"/>' + 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 + '</chart:series>' + 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;

49
components/fpspreadsheet/source/common/xlsxooxmlchart.pas
View File

@ -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('<c:explosion val="%d"/>', [dps.PieOffset]);
AppendToStream(AStream,
indent + '<c:dPt>' + LE +
indent + ' <c:idx val="' + IntToStr(i) + '"/>' + LE +
explosionStr + // to do: read explosion value from worksheet!
explosionStr +
indent + ' <c:spPr>' + LE +
GetChartFillAndLineXML(AIndent + 4, ASeries.Chart, dps.Background, dps.Border) + LE +
indent + ' </c:spPr>' + LE +
indent + '</c:dPt>' + LE
);
end;
end;
end;