pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Support pie and ring series. Add piechart demo.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9003 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-10-30 17:41:53 +00:00
parent 1176d41a94
commit 7335cf0733
7 changed files with 218 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

73
components/fpspreadsheet/examples/other/chart/piechart_write_demo.lpi Normal file
View File

@ -0,0 +1,73 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<Title Value="piechart_write_demo"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<RequiredPackages>
<Item>
<PackageName Value="laz_fpspreadsheet"/>
</Item>
</RequiredPackages>
<Units>
<Unit>
<Filename Value="piechart_write_demo.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="piechart_write_demo"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
</Debugging>
</Linking>
<Other>
<ConfigFile>
<WriteConfigFilePath Value=""/>
</ConfigFile>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

60
components/fpspreadsheet/examples/other/chart/piechart_write_demo.lpr Normal file
View File

@ -0,0 +1,60 @@
program piechart_write_demo;
{.$DEFINE DARK_MODE}
uses
SysUtils,
fpspreadsheet, fpstypes, fpsUtils, fpschart, xlsxooxml, fpsopendocument;
var
b: TsWorkbook;
sheet: TsWorksheet;
ch: TsChart;
ser: TsChartSeries;
begin
b := TsWorkbook.Create;
try
// worksheet
sheet := b.AddWorksheet('pie_series');
// Enter data
sheet.WriteText(0, 0, 'World population');
sheet.WriteFont(0, 0, '', 12, [fssBold], scBlack);
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.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);
sheet.WriteText(7, 0, 'Europe'); sheet.WriteNumber(7, 1, 747); // sheet.WriteChartColor(7, 2, scSilver);
sheet.WriteText(8, 0, 'Oceania'); sheet.WriteNumber(8, 1, 42); // sheet.WriteChartColor(8, 2, $FF8080);
// Create chart: left/top in cell D4, 120 mm x 100 mm
ch := b.AddChart(sheet, 2, 3, 120, 100);
// Chart properties
ch.Border.Style := clsNoLine;
ch.Title.Caption := 'World Population';
ch.Title.Font.Style := [fssBold];
ch.Legend.Border.Style := clsNoLine;
// Add pie series
ser := TsPieSeries.Create(ch); // Select one of these...
//ser := TsRingSeries.Create(ch);
// Series properties
ser.SetTitleAddr(0, 0);
ser.SetLabelRange(4, 0, 8, 0);
ser.SetYRange(4, 1, 8, 1);
ser.DataLabels := [cdlCategory, cdlValue];
ser.LabelSeparator := '\n'; // this is the symbol for a line-break
ser.LabelPosition := lpOutside;
ser.Line.Color := scWhite;
//ser.SetFillColorRange(4, 2, 8, 2);
b.WriteToFile('world-population.xlsx', true); // Excel fails to open the file
b.WriteToFile('world-population.ods', true);
finally
b.Free;
end;
end.

3
components/fpspreadsheet/examples/other/chart/write_chart_demo.lpr
View File

@ -10,7 +10,8 @@ const
// SERIES_CLASS: TsChartSeriesClass = TsBubbleSeries;
// SERIES_CLASS: TsChartSeriesClass = TsLineSeries;
// SERIES_CLASS: TsChartSeriesClass = TsScatterSeries;
SERIES_CLASS: TsChartSeriesClass = TsRadarSeries;
// SERIES_CLASS: TsChartSeriesClass = TsRadarSeries;
SERIES_CLASS: TsChartSeriesClass = TsPieSeries;
r1 = 1;
r2 = 8;
FILL_COLORS: array[0..r2-r1] of TsColor = (scRed, scGreen, scBlue, scYellow, scMagenta, scSilver, scBlack, scOlive);

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

@ -113,7 +113,7 @@ type
TsChartAxisPosition = (capStart, capEnd, capValue);
TsChartAxisTick = (catInside, catOutside);
TsChartAxisTicks = set of TsChartAxisTick;
TsChartType = (ctEmpty, ctBar, ctLine, ctArea, ctBarLine, ctScatter, ctBubble, ctRadar);
TsChartType = (ctEmpty, ctBar, ctLine, ctArea, ctBarLine, ctScatter, ctBubble, ctRadar, ctPie, ctRing);
TsChartAxis = class(TsChartFillElement)
private
@ -191,6 +191,7 @@ type
TsChartAxisLink = (alPrimary, alSecondary);
TsChartDataLabel = (cdlValue, cdlPercentage, cdlValueAndPercentage, cdlCategory, cdlSeriesName, cdlSymbol);
TsChartDataLabels = set of TsChartDataLabel;
TsChartLabelPosition = (lpDefault, lpOutside, lpInside, lpCenter);
TsChartSeries = class(TsChartElement)
private
@ -199,6 +200,8 @@ type
FYRange: TsCellRange;
FLabelRange: TsCellRange;
FLabelFont: TsFont;
FLabelPosition: TsChartLabelPosition;
FLabelSeparator: string;
FFillColorRange: TsCellRange;
FYAxis: TsChartAxisLink;
FTitleAddr: TsCellCoord;
@ -230,8 +233,10 @@ type
property FillColorRange: TsCellRange read FFillColorRange;
property LabelFont: TsFont read FLabelFont write FLabelFont;
property LabelFormat: String read FLabelFormat write FLabelFormat; // Number format in Excel notation, e.g. '0.00'
property LabelPosition: TsChartLabelPosition read FLabelPosition write FLabelPosition;
property LabelRange: TsCellRange read FLabelRange;
property TitleAddr: TsCellCoord read FTitleAddr write FTitleAddr;
property LabelSeparator: string read FLabelSeparator write FLabelSeparator;
property TitleAddr: TsCellCoord read FTitleAddr write FTitleAddr; // use '\n' for line-break
property XRange: TsCellRange read FXRange;
property YRange: TsCellRange read FYRange;
property YAxis: TsChartAxisLink read FYAxis write FYAxis;
@ -287,11 +292,21 @@ type
property ShowSymbols: Boolean read FShowSymbols write FShowSymbols;
end;
TsPieSeries = class(TsChartSeries)
public
constructor Create(AChart: TsChart); override;
end;
TsRadarSeries = class(TsLineSeries)
public
constructor Create(AChart: TsChart); override;
end;
TsRingSeries = class(TsChartSeries)
public
constructor Create(AChart: TsChart); override;
end;
TsScatterSeries = class(TsLineSeries)
public
constructor Create(AChart: TsChart); override;
@ -804,6 +819,15 @@ begin
end;
{ TsPieSeries }
constructor TsPieSeries.Create(AChart: TsChart);
begin
inherited Create(AChart);
FChartType := ctPie;
FLine.Color := scBlack;
end;
{ TsRadarSeries }
constructor TsRadarSeries.Create(AChart: TsChart);
begin
@ -812,6 +836,15 @@ begin
end;
{ TsRingSeries }
constructor TsRingSeries.Create(AChart: TsChart);
begin
inherited Create(AChart);
FChartType := ctRing;
FLine.Color := scBlack;
end;
{ TsScatterSeries }
constructor TsScatterSeries.Create(AChart: TsChart);

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

@ -73,8 +73,10 @@ const
OPENDOC_PATH_CHART_STYLES = 'Object %d/styles.xml';
CHART_TYPE_NAMES: array[TsChartType] of string = (
'', 'bar', 'line', 'area', 'barLine', 'scatter', 'bubble', 'radar'
'', 'bar', 'line', 'area', 'barLine', 'scatter', 'bubble', 'radar', 'circle', 'ring'
);
// Note: a ring series has chart:class = 'circle' at the series level, but 'ring' at the chart level.
// This is taken care of.
CHART_SYMBOL_NAMES: array[TsChartSeriesSymbol] of String = (
'square', 'diamond', 'arrow-up', 'arrow-down', 'arrow-left',
@ -469,7 +471,7 @@ begin
ciStepCenterY: interpolationStr := 'chart:interpolation="step-center-y" ';
end;
if AChart.GetChartType <> ctRadar then
if not (AChart.GetChartType in [ctRadar, ctPie]) then
rightAngledAxes := 'chart:right-angled-axes="true" ';
Result := Format(
@ -504,6 +506,9 @@ end;
</style:style> }
function TsSpreadOpenDocChartWriter.GetChartSeriesStyleAsXML(AChart: TsChart;
ASeriesIndex, AIndent, AStyleID: Integer): String;
const
LABEL_POSITION: array[TsChartLabelPosition] of string = (
'', 'outside', 'inside', 'center');
var
series: TsChartSeries;
lineser: TsLineSeries = nil;
@ -513,6 +518,7 @@ var
textProps: String = '';
lineProps: String = '';
fillProps: String = '';
labelSeparator: String = '';
begin
Result := '';
@ -550,6 +556,26 @@ begin
chartProps := chartProps + 'chart:data-label-series="true" ';
if (cdlSymbol in series.DataLabels) then
chartProps := chartProps + 'chart:data-label-symbol="true" ';
if series.LabelPosition <> lpDefault then
chartProps := chartProps + 'chart:label-position="' + LABEL_POSITION[series.LabelPosition] + '" ';
if series.LabelSeparator = ' ' then
labelSeparator := ''
else
begin
labelSeparator := series.LabelSeparator;
if pos('\n', labelSeparator) > 0 then
labelSeparator := StringReplace(labelSeparator, '\n', '<text:line-break/>', [rfReplaceAll, rfIgnoreCase]);
labelSeparator :=
' <chart:label-separator>' + LE +
' <text:p>' + labelSeparator + '</text:p>' + LE +
' </chart:label-separator>' + LE;
end;
if labelSeparator <> '' then
chartProps := ' <style:chart-properties ' + chartProps + '>' + LE + labelSeparator + ' </style:chart-properties>'
else
chartProps := ' <style:chart-properties ' + chartProps + '/>';
// Graphic properties
lineProps := GetChartLineStyleGraphicPropsAsXML(AChart, series.Line);
@ -568,11 +594,11 @@ begin
Result := Format(
indent + '<style:style style:name="ch%d" style:family="chart" style:data-style-name="N0">' + LE +
indent + ' <style:chart-properties %s/>' + LE +
indent + chartProps + LE +
indent + ' <style:graphic-properties %s/>' + LE +
indent + ' <style:text-properties %s/>' + LE +
indent + '</style:style>' + LE,
[ AStyleID, chartProps, graphProps, textProps ]
[ AStyleID, graphProps, textProps ]
);
end;
@ -1244,6 +1270,7 @@ var
domainRangeX: String = '';
domainRangeY: String = '';
fillColorRange: String = '';
chartClass: String = '';
titleAddr: String;
count: Integer;
begin
@ -1307,6 +1334,10 @@ begin
);
count := series.YRange.Row2 - series.YRange.Row1 + 1;
if series is TsRingSeries then
chartClass := 'circle'
else
chartClass := CHART_TYPE_NAMES[series.ChartType];
// Store the series properties
@ -1315,7 +1346,7 @@ begin
'chart:values-cell-range-address="%s" ' + // y values
'chart:label-cell-address="%s" ' + // series title
'chart:class="chart:%s">' + LE,
[ AStyleID, valuesRange, titleAddr, CHART_TYPE_NAMES[series.ChartType] ]
[ AStyleID, valuesRange, titleAddr, chartClass ]
));
if domainRangeY <> '' then
AppendToStream(AChartStream, Format(

12
components/fpspreadsheet/source/common/fpspreadsheet.pas
View File

@ -251,6 +251,8 @@ type
procedure WriteNumber(ACell: PCell; ANumber: Double;
ANumFormat: TsNumberFormat; ANumFormatString: String); overload;
function WriteChartColor(ARow, Acol: Cardinal; AColor: TsColor): PCell;
function WriteRPNFormula(ARow, ACol: Cardinal;
AFormula: TsRPNFormula): PCell; overload;
procedure WriteRPNFormula(ACell: PCell;
@ -4378,6 +4380,16 @@ begin
end;
end;
{@@ ----------------------------------------------------------------------------
Writes an rgb color value as number to the specified cell. As requested by
the chart module the bytes for red and blue are exchanged.
-------------------------------------------------------------------------------}
function TsWorksheet.WriteChartColor(ARow, ACol: Cardinal; AColor: TsColor): PCell;
begin
Result := WriteNumber(ARow, ACol, FlipColorBytes(AColor));
end;
{@@ ----------------------------------------------------------------------------
Writes an empty cell

1
components/fpspreadsheet/source/common/fpspreadsheet_numfmt.inc
View File

@ -272,7 +272,6 @@ begin
ChangedCell(ACell^.Row, ACell^.Col);
end;
{@@ ----------------------------------------------------------------------------
Adds a number format to the formatting of a cell