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

fpspreadsheet: Support filled radar series. Add radar series demo.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9004 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-10-30 22:37:44 +00:00
parent 7335cf0733
commit 3fc925936c
4 changed files with 216 additions and 41 deletions
Download Patch File Download Diff File Expand all files Collapse all files

73
components/fpspreadsheet/examples/other/chart/radarchart_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="radarchart_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="radarchart_write_demo.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="radarchart_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>

69
components/fpspreadsheet/examples/other/chart/radarchart_write_demo.lpr Normal file
View File

@ -0,0 +1,69 @@
program radarchart_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('radar_series');
// Enter data
sheet.WriteText( 0, 0, 'School Grades');
sheet.WriteFont( 0, 0, '', 12, [fssBold], scBlack);
sheet.WriteText( 2, 0, ''); sheet.WriteText ( 2, 1, 'Student 1'); sheet.WriteText ( 2, 2, 'Student 2');
sheet.WriteText( 3, 0, 'Biology'); sheet.WriteNumber( 3, 1, 12); sheet.WriteNumber( 3, 2, 15);
sheet.WriteText( 4, 0, 'History'); sheet.WriteNumber( 4, 1, 11); sheet.WriteNumber( 4, 2, 13);
sheet.WriteText( 5, 0, 'French'); sheet.WriteNumber( 5, 1, 16); sheet.WriteNumber( 5, 2, 11);
sheet.WriteText( 6, 0, 'English'); sheet.WriteNumber( 6, 1, 18); sheet.WriteNumber( 6, 2, 11);
sheet.WriteText( 7, 0, 'Sports'); sheet.WriteNumber( 7, 1, 16); sheet.WriteNumber( 7, 2, 7);
sheet.WriteText( 8, 0, 'Maths'); sheet.WriteNumber( 8, 1, 10); sheet.WriteNumber( 8, 2, 17);
sheet.WriteText( 9, 0, 'Physics'); sheet.WriteNumber( 9, 1, 12); sheet.WriteNumber( 9, 2, 19);
sheet.WriteText(10, 0, 'Computer'); sheet.WriteNumber(10, 1, 16); sheet.WriteNumber(10, 2, 18);
// Create chart: left/top in cell D4, 160 mm x 100 mm
ch := b.AddChart(sheet, 2, 3, 120, 100);
// Chart properties
ch.Border.Style := clsNoLine;
ch.Title.Caption := 'School Grades';
ch.Title.Font.Style := [fssBold];
ch.Legend.Border.Style := clsNoLine;
ch.XAxis.Caption := '';
ch.YAxis.Caption := '';
ch.YAxis.AxisLine.Color := scSilver;
ch.YAxis.MajorTicks := [];
// Add 1st radar series ("Student 1")
ser := TsRadarSeries.Create(ch);
ser.SetTitleAddr(2, 1);
ser.SetLabelRange(3, 0, 10, 0);
ser.SetYRange(3, 1, 10, 1);
ser.Line.Color := scDarkRed;
ser.Fill.FgColor := scRed;
ser.Fill.Transparency := 0.35;
// Add 2nd radar series ("Student 2")
ser := TsRadarSeries.Create(ch);
ser.SetTitleAddr(2, 2);
ser.SetLabelRange(3, 0, 10, 0);
ser.SetYRange(3, 2, 10, 2);
ser.Line.Color := scDarkBlue;
ser.Fill.FgColor := scBlue;
ser.Fill.Transparency := 0.35;
b.WriteToFile('school-grades.xlsx', true); // Excel fails to open the file
b.WriteToFile('school-grades.ods', true);
finally
b.Free;
end;
end.

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

@ -46,6 +46,7 @@ type
Style: TsFillStyle;
FgColor: TsColor;
BgColor: TsColor;
Transparency: Double; // 0.0 ... 1.0
end;
TsChartLineSegment = record
@ -113,7 +114,8 @@ type
TsChartAxisPosition = (capStart, capEnd, capValue);
TsChartAxisTick = (catInside, catOutside);
TsChartAxisTicks = set of TsChartAxisTick;
TsChartType = (ctEmpty, ctBar, ctLine, ctArea, ctBarLine, ctScatter, ctBubble, ctRadar, ctPie, ctRing);
TsChartType = (ctEmpty, ctBar, ctLine, ctArea, ctBarLine, ctScatter, ctBubble,
ctRadar, ctFilledRadar, ctPie, ctRing);
TsChartAxis = class(TsChartFillElement)
private
@ -209,6 +211,8 @@ type
FLine: TsChartLine;
FFill: TsChartFill;
FDataLabels: TsChartDataLabels;
protected
function GetChartType: TsChartType; virtual;
public
constructor Create(AChart: TsChart); virtual;
destructor Destroy; override;
@ -227,7 +231,7 @@ type
function XValuesInCol: Boolean;
function YValuesInCol: Boolean;
property ChartType: TsChartType read FChartType;
property ChartType: TsChartType read GetChartType;
property Count: Integer read GetCount;
property DataLabels: TsChartDataLabels read FDataLabels write FDataLabels;
property FillColorRange: TsCellRange read FFillColorRange;
@ -298,8 +302,8 @@ type
end;
TsRadarSeries = class(TsLineSeries)
public
constructor Create(AChart: TsChart); override;
protected
function GetChartType: TsChartType; override;
end;
TsRingSeries = class(TsChartSeries)
@ -634,6 +638,11 @@ begin
inherited;
end;
function TsChartSeries.GetChartType: TsChartType;
begin
Result := FChartType;
end;
function TsChartSeries.GetCount: Integer;
begin
Result := GetYCount;
@ -829,13 +838,14 @@ end;
{ TsRadarSeries }
constructor TsRadarSeries.Create(AChart: TsChart);
function TsRadarSeries.GetChartType: TsChartType;
begin
inherited Create(AChart);
FChartType := ctRadar;
if Fill.Style <> fsNoFill then
Result := ctFilledRadar
else
Result := ctRadar;
end;
{ TsRingSeries }
constructor TsRingSeries.Create(AChart: TsChart);
begin

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

@ -54,7 +54,7 @@ type
var AStyleID: Integer);
public
constructor Create(AWriter: TsBasicSpreadWriter);
constructor Create(AWriter: TsBasicSpreadWriter); override;
procedure AddChartsToZip(AZip: TZipper);
procedure AddToMetaInfManifest(AStream: TStream);
procedure CreateStreams; override;
@ -68,21 +68,35 @@ implementation
uses
fpsOpenDocument;
type
TAxisKind = 3..6;
const
OPENDOC_PATH_CHART_CONTENT = 'Object %d/content.xml';
OPENDOC_PATH_CHART_STYLES = 'Object %d/styles.xml';
CHART_TYPE_NAMES: array[TsChartType] of string = (
'', 'bar', 'line', 'area', 'barLine', 'scatter', 'bubble', 'radar', 'circle', 'ring'
'', 'bar', 'line', 'area', 'barLine', 'scatter', 'bubble',
'radar', 'filled-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 = (
SYMBOL_NAMES: array[TsChartSeriesSymbol] of String = (
'square', 'diamond', 'arrow-up', 'arrow-down', 'arrow-left',
'arrow-right', 'circle', 'star', 'x', 'plus', 'asterisk'
); // unsupported: bow-tie, hourglass, horizontal-bar, vertical-bar
LABEL_POSITION: array[TsChartLabelPosition] of string = (
'', 'outside', 'inside', 'center');
LEGEND_POSITION: array[TsChartLegendPosition] of string = (
'end', 'top', 'bottom', 'start'
);
AXIS_ID: array[TAxisKind] of string = ('x', 'y', 'x', 'y');
AXIS_LEVEL: array[TAxisKind] of string = ('primary', 'primary', 'secondary', 'secondary');
FALSE_TRUE: array[boolean] of string = ('false', 'true');
LE = LineEnding;
function ASCIIName(AName: String): String;
@ -190,53 +204,71 @@ begin
chart := Axis.Chart;
// Special number format for numerical axis labels
if (Axis = chart.YAxis) and (chart.StackMode = csmStackedPercentage) then
numStyle := 'N10010';
// Show axis labels
if Axis.ShowLabels then
chartProps := chartProps + 'chart:display-label="true" ';
// Logarithmic axis
if Axis.Logarithmic then
chartProps := chartProps + 'chart:logarithmic="true" ';
// Axis scaling: minimum, maximum, tick intervals
if not Axis.AutomaticMin then
chartProps := chartProps + Format('chart:minimum="%g" ', [Axis.Min], FPointSeparatorSettings);
if not Axis.AutomaticMax then
chartProps := chartProps + Format('chart:maximum="%g" ', [Axis.Max], FPointSeparatorSettings);
if not Axis.AutomaticMajorInterval then
chartProps := chartProps + Format('chart:interval-major="%g" ', [Axis.MajorInterval], FPointSeparatorSettings);
if not Axis.AutomaticMinorSteps then
chartProps := chartProps + Format('chart:interval-minor-divisor="%d" ', [Axis.MinorSteps]);
// Position of the axis
case Axis.Position of
capStart: chartProps := chartProps + 'chart:axis-position="start" ';
capEnd: chartProps := chartProps + 'chart:axis-position="end" ';
capValue: chartProps := chartProps + Format('chart:axis-position="%g" ', [Axis.PositionValue], FPointSeparatorSettings);
end;
if (catInside in Axis.MajorTicks) then
chartProps := chartProps + 'chart:tick-marks-major-inner="true" ';
if (catOutside in Axis.MajorTicks) then
chartProps := chartProps + 'chart:tick-marks-major-outer="true" ';
if (catInside in Axis.MinorTicks) then
chartProps := chartProps + 'chart:tick-marks-minor-inner="true" ';
if (catOutside in Axis.MinorTicks) then
chartProps := chartProps + 'chart:tick-marks-minor-outer="true" ';
// Tick marks
if (chart.GetChartType in [ctRadar, ctFilledRadar]) and (Axis = chart.YAxis) then
begin
// Radar series needs a "false" to hide the tick-marks
chartProps := chartProps + Format('chart:tick-marks-major-inner="%s" ', [FALSE_TRUE[catInside in Axis.MajorTicks]]);
chartProps := chartProps + Format('chart:tick-marks-major-outer="%s" ', [FALSE_TRUE[catOutside in Axis.MajorTicks]]);
chartProps := chartProps + Format('chart:tick-marks-minor-inner="%s" ', [FALSE_TRUE[catInside in Axis.MinorTicks]]);
chartProps := chartProps + Format('chart:tick-marks-minor-outer="%s" ', [FALSE_TRUE[catOutside in Axis.MinorTicks]]);
end else
begin
// The other series hide the tick-marks by default.
if (catInside in Axis.MajorTicks) then
chartProps := chartProps + 'chart:tick-marks-major-inner="true" ';
if (catOutside in Axis.MajorTicks) then
chartProps := chartProps + 'chart:tick-marks-major-outer="true" ';
if (catInside in Axis.MinorTicks) then
chartProps := chartProps + 'chart:tick-marks-minor-inner="true" ';
if (catOutside in Axis.MinorTicks) then
chartProps := chartProps + 'chart:tick-marks-minor-outer="true" ';
end;
// Inverted axis direction
if Axis.Inverted then
chartProps := chartProps + 'chart:reverse-direction="true" ';
// Rotated axis labels
angle := Axis.LabelRotation;
chartProps := chartProps + Format('style:rotation-angle="%d" ', [angle]);
// Label orientation
graphProps := 'svg:stroke-color="' + ColorToHTMLColorStr(Axis.AxisLine.Color) + '" ';
// Label font
textProps := TsSpreadOpenDocWriter(Writer).WriteFontStyleXMLAsString(Axis.LabelFont);
// Putting it all together...
indent := DupeString(' ', AIndent);
Result := Format(
indent + '<style:style style:name="ch%d" style:family="chart" style:data-style-name="%s">' + LE +
@ -337,6 +369,7 @@ function TsSpreadOpenDocChartWriter.GetChartFillStyleGraphicPropsAsXML(AChart: T
var
fillStr: String;
fillColorStr: String;
fillOpacity: String = '';
begin
if AFill.Style = fsNoFill then
begin
@ -347,8 +380,10 @@ begin
// To do: extend with hatched and gradient fills
fillStr := 'draw:fill="solid" ';
fillColorStr := 'draw:fill-color="' + ColorToHTMLColorStr(AFill.FgColor) + '" ';
if AFill.Transparency > 0 then
fillOpacity := Format('draw:opacity="%.0f%%" ', [(1.0 - AFill.Transparency)*100], FPointSeparatorSettings);
Result := fillStr + fillColorStr;
Result := fillStr + fillColorStr + fillOpacity;
end;
{
@ -506,9 +541,6 @@ 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;
@ -527,13 +559,13 @@ begin
// Chart properties
chartProps := 'chart:symbol-type="none" ';
if (series is TsLineSeries) then
if (series is TsLineSeries) and (series.ChartType <> ctFilledRadar) then
begin
lineser := TsLineSeries(series);
if lineser.ShowSymbols then
chartProps := Format(
'chart:symbol-type="named-symbol" chart:symbol-name="%s" chart:symbol-width="%.1fmm" chart:symbol-height="%.1fmm" ',
[CHART_SYMBOL_NAMES[lineSer.Symbol], lineSer.SymbolWidth, lineSer.SymbolHeight ],
[SYMBOL_NAMES[lineSer.Symbol], lineSer.SymbolWidth, lineSer.SymbolHeight ],
FPointSeparatorSettings
);
end;
@ -580,7 +612,7 @@ begin
// Graphic properties
lineProps := GetChartLineStyleGraphicPropsAsXML(AChart, series.Line);
fillProps := GetChartFillStyleGraphicPropsAsXML(AChart, series.Fill);
if (series is TsLineSeries) then
if (series is TsLineSeries) and (series.ChartType <> ctFilledRadar) then
begin
if lineSer.ShowSymbols then
graphProps := graphProps + fillProps;
@ -897,11 +929,6 @@ procedure TsSpreadOpenDocChartWriter.WriteChartAxis(
AChartStream, AStyleStream: TStream;
AChartIndent, AStyleIndent: Integer; Axis: TsChartAxis;
var AStyleID: Integer);
type
TAxisKind = 3..6;
const
AXIS_ID: array[TAxisKind] of string = ('x', 'y', 'x', 'y');
AXIS_LEVEL: array[TAxisKind] of string = ('primary', 'primary', 'secondary', 'secondary');
var
indent: String;
captionKind: Integer;
@ -1049,10 +1076,6 @@ end;
{ Writes the chart's legend to the xml stream }
procedure TsSpreadOpenDocChartWriter.WriteChartLegend(AChartStream, AStyleStream: TStream;
AChartIndent, AStyleIndent: Integer; AChart: TsChart; var AStyleID: Integer);
const
LEGEND_POSITION: array[TsChartLegendPosition] of string = (
'end', 'top', 'bottom', 'start'
);
var
indent: String;
canOverlap: String = '';