fpspreadsheet: ods writer supports error bars.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9102 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-12-24 23:23:34 +00:00
parent d1eec6730d
commit 03417e642f
9 changed files with 346 additions and 53 deletions

View File

@ -0,0 +1,68 @@
<?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="errorbars_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="errorbars_write_demo.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="regressionchart_write_demo"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="errorbars_write_demo"/>
</Target>
<SearchPaths>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
</Debugging>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,78 @@
program regressionchart_write_demo;
{$mode objfpc}{$H+}
uses
SysUtils,
fpspreadsheet, fpstypes, fpsUtils, fpschart, xlsxooxml, fpsopendocument;
const
FILE_NAME = 'errorbars';
var
book: TsWorkbook;
sheet: TsWorksheet;
ch: TsChart;
ser: TsScatterSeries;
fn: String;
rotated: Boolean;
begin
fn := FILE_NAME;
book := TsWorkbook.Create;
try
// Worksheet
sheet := book.AddWorksheet('errorbars_test');
// Enter data
sheet.WriteText(0, 0, 'Data');
sheet.WriteFont(0, 0, '', 12, [fssBold], scBlack);
sheet.WriteText (2, 0, 'x'); sheet.Writetext (2, 1, 'y');
sheet.WriteNumber(3, 0, 1.1); sheet.WriteNumber(3, 1, 9.0);
sheet.WriteNumber(4, 0, 1.9); sheet.WriteNumber(4, 1, 20.5);
sheet.WriteNumber(5, 0, 2.5); sheet.WriteNumber(5, 1, 24.5);
sheet.WriteNumber(6, 0, 3.1); sheet.WriteNumber(6, 1, 33.2);
sheet.WriteNumber(7, 0, 5.2); sheet.WriteNumber(7, 1, 49.4);
sheet.WriteNumber(8, 0, 6.8); sheet.WriteNumber(8, 1, 71.3);
// Create chart: left/top in cell D4, 150 mm x 100 mm
ch := book.AddChart(sheet, 2, 3, 150, 100);
// Chart properties
ch.Border.Style := clsNoLine;
ch.Legend.Border.Style := clsNoLine;
// Add scatter series
ser := TsScatterSeries.Create(ch);
// Series properties
ser.SetTitleAddr(0, 0);
ser.SetXRange(3, 0, 8, 0);
ser.SetYRange(3, 1, 8, 1);
ser.ShowLines := false;
ser.ShowSymbols := true;
ser.Symbol := cssCircle;
ser.XErrorBars.Visible := true;
ser.XErrorBars.Kind := cebkConstant;
ser.XErrorBars.ValuePos := 0.5;
ser.XErrorBars.ValueNeg := 0.5;
ser.XErrorBars.Line.Color := scRed;
ser.YErrorBars.Visible := true;
ser.YErrorBars.Kind := cebkPercentage;
ser.YErrorBars.ValuePos := 10; // percent
ser.YErrorBars.ValueNeg := 10; // percent
ser.YErrorBars.Line.Color := scRed;
{
book.WriteToFile(fn + '.xlsx', true); // Excel fails to open the file
WriteLn('Data saved with chart to ', fn, '.xlsx');
}
book.WriteToFile(fn + '.ods', true);
WriteLn('Data saved with chart to ', fn, '.ods');
finally
book.Free;
end;
end.

View File

@ -51,11 +51,6 @@
<DebugInfoType Value="dsDwarf3"/>
</Debugging>
</Linking>
<Other>
<ConfigFile>
<WriteConfigFilePath Value=""/>
</ConfigFile>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions>

View File

@ -32,13 +32,15 @@ begin
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 := book.AddChart(sheet, 2, 3, 120, 100);
// Create chart: left/top in cell D4, 150 mm x 150 mm
ch := book.AddChart(sheet, 2, 3, 150, 150);
// Chart properties
ch.Border.Style := clsNoLine;
ch.Title.Caption := 'World Population';
ch.Title.Font.Style := [fssBold];
ch.SubTitle.Caption := '(in millions)';
ch.SubTitle.Font.Size := 10;
ch.Legend.Border.Style := clsNoLine;
// Add pie series

View File

@ -25,6 +25,9 @@ scatter_write_demo lin
scatter_write_demo log
scatter_write_demo log-log
echo.
echo Scatter series with error bars
errorbars_write_demo
echo.
echo Scatter series and regression demo...
regressionchart_write_demo
regressionchart_write_demo rotated

View File

@ -47,6 +47,11 @@
<Mode Name="Default"/>
</BuildModes>
</Target>
<Target FileName="errorbars_write_demo.lpi">
<BuildModes>
<Mode Name="Default"/>
</BuildModes>
</Target>
</Targets>
</ProjectGroup>
</CONFIG>

View File

@ -92,7 +92,7 @@ object Form1: TForm1
Width = 1161
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 6
DropDownCount = 32
DropDownCount = 50
ItemHeight = 15
Items.Strings = (
'../../../other/chart/bars.ods'
@ -104,6 +104,7 @@ object Form1: TForm1
'../../../other/chart/bars-2axes.ods'
'../../../other/chart/bars-2axes-rotated.ods'
'../../../other/chart/bubble.ods'
'../../../other/chart/errorbars.ods'
'../../../other/chart/pie.ods'
'../../../other/chart/radar.ods'
'../../../other/chart/regression.ods'

View File

@ -34,6 +34,7 @@ const
type
TsChart = class;
TsChartSeries = class;
TsChartLine = class
Style: Integer; // index into chart's LineStyle list or predefined clsSolid/clsNoLine
@ -199,11 +200,14 @@ type
private
FChart: TsChart;
FVisible: Boolean;
protected
function GetVisible: Boolean; virtual;
procedure SetVisible(AValue: Boolean); virtual;
public
constructor Create(AChart: TsChart);
procedure CopyFrom(ASource: TsChartElement); virtual;
property Chart: TsChart read FChart;
property Visible: Boolean read FVisible write FVisible;
property Visible: Boolean read GetVisible write SetVisible;
end;
TsChartFillElement = class(TsChartElement)
@ -351,6 +355,7 @@ type
TsChartErrorBars = class(TsChartElement)
private
FSeries: TsChartSeries;
FKind: TsChartErrorBarKind;
FLine: TsChartLine;
FRange: Array[0..1] of TsChartRange;
@ -366,8 +371,11 @@ type
procedure SetRange(AIndex: Integer; AValue: TsChartRange);
procedure SetShow(AIndex: Integer; AValue: Boolean);
procedure SetValue(AIndex: Integer; AValue: Double);
protected
function GetVisible: Boolean; override;
procedure SetVisible(AValue: Boolean); override;
public
constructor Create(AChart: TsChart);
constructor Create(ASeries: TsChartSeries);
destructor Destroy; override;
procedure CopyFrom(ASource: TsChartElement); override;
procedure SetErrorBarRangePos(ARow1, ACol1, ARow2, ACol2: Cardinal);
@ -378,6 +386,7 @@ type
property Line: TsChartLine read FLine write SetLine;
property RangePos: TsChartRange index 0 read GetRange write SetRange;
property RangeNeg: TsChartRange index 1 read GetRange write SetRange;
property Series: TsChartSeries read FSeries;
property ShowPos: Boolean index 0 read GetShow write SetShow;
property ShowNeg: Boolean index 1 read GetShow write SetShow;
property ValuePos: Double index 0 read GetValue write SetValue;
@ -1244,6 +1253,16 @@ begin
Visible := ASource.Visible;
end;
function TsChartElement.GetVisible: Boolean;
begin
Result := FVisible;
end;
procedure TsChartElement.SetVisible(AValue: Boolean);
begin
FVisible := AValue;
end;
{ TsChartFillElement }
@ -1557,16 +1576,17 @@ end;
{ TsChartErrorBars }
constructor TsChartErrorBars.Create(AChart: TsChart);
constructor TsChartErrorBars.Create(ASeries: TsChartSeries);
begin
inherited;
inherited Create(ASeries.Chart);
FSeries := ASeries;
FLine := TsChartLine.Create;
FLine.Style := clsSolid;
FLine.Color := scBlack;
FRange[0] := TsChartRange.Create(AChart);
FRange[1] := TsChartRange.Create(AChart);
FShow[0] := true;
FShow[1] := true;
FRange[0] := TsChartRange.Create(ASeries.Chart);
FRange[1] := TsChartRange.Create(ASeries.Chart);
FShow[0] := false;
FShow[1] := false;
end;
destructor TsChartErrorBars.Destroy;
@ -1598,6 +1618,11 @@ begin
Result := FRange[AIndex];
end;
function TsChartErrorBars.GetVisible: Boolean;
begin
Result := ShowPos or ShowNeg;
end;
function TsChartErrorBars.GetShow(AIndex: Integer): Boolean;
begin
Result := FShow[AIndex];
@ -1664,6 +1689,12 @@ begin
FValue[AIndex] := AValue;
end;
procedure TsChartErrorBars.SetVisible(AValue: Boolean);
begin
ShowPos := AValue;
ShowNeg := AValue;
end;
{ TsChartSeries }
@ -1708,8 +1739,8 @@ begin
FLabelSeparator := ' ';
FXErrorBars := TsChartErrorBars.Create(AChart);
FYErrorBars := TsChartErrorBars.Create(AChart);
FXErrorBars := TsChartErrorBars.Create(Self);
FYErrorBars := TsChartErrorBars.Create(Self);
end;
destructor TsChartSeries.Destroy;

View File

@ -84,9 +84,12 @@ type
FNumberFormatList: TStrings;
FPointSeparatorSettings: TFormatSettings;
function GetChartAxisStyleAsXML(Axis: TsChartAxis; AIndent, AStyleID: Integer): String;
function GetChartBackgroundStyleAsXML(AChart: TsChart; AFill: TsChartFill;
ABorder: TsChartLine; AIndent: Integer; AStyleID: Integer): String;
function GetChartCaptionStyleAsXML(AChart: TsChart; ACaptionKind, AIndent, AStyleID: Integer): String;
function GetChartBackgroundStyleAsXML(AChart: TsChart;
AFill: TsChartFill; ABorder: TsChartLine; AIndent: Integer; AStyleID: Integer): String;
function GetChartCaptionStyleAsXML(AChart: TsChart;
ACaptionKind, AIndent, AStyleID: Integer): String;
function GetChartErrorBarStyleAsXML(AChart: TsChart;
AErrorBar: TsChartErrorBars; AIndent, AStyleID: Integer): String;
function GetChartFillStyleGraphicPropsAsXML(AChart: TsChart;
AFill: TsChartFill): String;
function GetChartLegendStyleAsXML(AChart: TsChart;
@ -95,13 +98,18 @@ type
ALine: TsChartLine; AIndent, AStyleID: Integer): String;
function GetChartLineStyleGraphicPropsAsXML(AChart: TsChart;
ALine: TsChartLine): String;
function GetChartPlotAreaStyleAsXML(AChart: TsChart; AIndent, AStyleID: Integer): String;
function GetChartPlotAreaStyleAsXML(AChart: TsChart;
AIndent, AStyleID: Integer): String;
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 GetChartStockSeriesStyleAsXML(AChart: TsChart; ASeries: TsStockSeries; AKind: Integer; 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 GetChartStockSeriesStyleAsXML(AChart: TsChart;
ASeries: TsStockSeries; AKind: Integer; AIndent, AStyleID: Integer): String;
procedure CheckAxis(AChart: TsChart; Axis: TsChartAxis);
function GetNumberFormatID(ANumFormat: String): String;
@ -2256,6 +2264,70 @@ begin
);
end;
function TsSpreadOpenDocChartWriter.GetChartErrorBarStyleAsXML(AChart: TsChart;
AErrorBar: TsChartErrorBars; AIndent, AStyleID: Integer): String;
var
graphProps: String;
chartProps: String = '';
indent: String;
function GetCellRangeStr(ARange: TsChartRange): String;
var
sheet1, sheet2: String;
r1, c1, r2, c2: Cardinal;
begin
sheet1 := ARange.GetSheet1Name;
sheet2 := ARange.GetSheet2Name;
r1 := ARange.Row1;
c1 := ARange.Col1;
r2 := ARange.Row2;
c2 := ARange.Col2;
Result := GetSheetCellRangeString_ODS(sheet1, sheet2, r1, c1, r2, c2, rfAllRel, false);
end;
begin
case AErrorBar.Kind of
cebkConstant:
begin
chartProps := chartProps + 'chart:error-category="constant" ';
if AErrorBar.ShowPos then
chartProps := chartProps + Format('chart:error-upper-limit="%.9g" ', [ AErrorBar.ValuePos ], FPointSeparatorSettings);
if AErrorBar.ShowNeg then
chartProps := chartProps + Format('chart:error-lower-limit="%.9g" ', [ AErrorBar.ValueNeg ], FPointSeparatorSettings);
end;
cebkPercentage:
begin
chartProps := chartProps + 'chart:error-category="percentage" ';
chartProps := chartProps + Format('chart:error-percentage="%.9g" ', [ AErrorBar.ValuePos ], FPointSeparatorSettings);
chartProps := chartProps + 'loext:std-weight="1" ';
end;
cebkRange:
begin
chartProps := chartProps + 'chart:error-category="cell-range" ';
if AErrorBar.ShowPos then
chartProps := chartProps + 'chart:error-upper-range="' + GetCellRangeStr(AErrorBar.RangePos) + '" ';
if AErrorBar.ShowNeg then
chartProps := chartProps + 'chart:error-lower-range="' + GetCellRangeStr(AErrorBar.RangeNeg) + '" ';
chartProps := chartProps + 'loext:std-weight="1" ';
end;
end;
if AErrorBar.ShowPos then
chartProps := chartProps + 'chart:error-upper-indicator="true" ';
if AErrorBar.ShowNeg then
chartProps := chartProps + 'chart:error-lower-indicator="true" ';
graphProps := GetChartLineStyleGraphicPropsAsXML(AChart, AErrorBar.Line);
indent := DupeString(' ', AIndent);
Result := Format(
indent + '<style:style style:name="ch%d" style:family="chart">' + LE +
indent + ' <style:chart-properties %s/>' + LE +
indent + ' <style:graphic-properties %s/>' + LE +
indent + '</style:style>' + LE,
[ AStyleID, chartProps, graphProps ]
);
end;
function TsSpreadOpenDocChartWriter.GetChartFillStyleGraphicPropsAsXML(AChart: TsChart;
AFill: TsChartFill): String;
var
@ -3563,15 +3635,21 @@ var
chartClass: String = '';
seriesYAxis: String = '';
regressionEquation: String = '';
needRegressionStyle: Boolean = false;
needRegressionEquationStyle: Boolean = false;
regression: TsChartRegression = nil;
titleAddr: String;
i, count: Integer;
styleID, dpStyleID: Integer;
nextStyleID, seriesStyleID, regressionStyleID, regressionEquStyleID: Integer;
xErrStyleID, yErrStyleID, dataStyleID: Integer;
begin
indent := DupeString(' ', AChartIndent);
styleID := AStyleID;
nextstyleID := AStyleID;
seriesStyleID := AStyleID;
regressionStyleID := -1;
regressionEquStyleID := -1;
xErrStyleID := -1;
yErrStyleID := -1;
dataStyleID := -1;
series := AChart.Series[ASeriesIndex];
@ -3666,8 +3744,10 @@ begin
seriesYAxis + // attached y axis
'chart:values-cell-range-address="%s" ' + // y values
'chart:label-cell-address="%s">' + LE, // series title
[ AStyleID, chartClass, valuesRange, titleAddr, chartClass ]
[ seriesStyleID, chartClass, valuesRange, titleAddr, chartClass ]
));
inc(nextStyleID);
if domainRangeY <> '' then
AppendToStream(AChartStream, Format(
indent + '<chart:domain table:cell-range-address="%s"/>' + LE,
@ -3689,12 +3769,36 @@ begin
[ lineColorRange ]
));
// Error bars
if series.XErrorBars.Visible then
begin
xErrStyleID := nextStyleID;
AppendToStream(AChartStream, Format(
indent + '<chart:error-indicator chart:style-name="ch%d" chart:dimension="x" />',
[ xErrStyleID ]
));
inc(nextStyleID);
end;
if series.YErrorBars.Visible then
begin
yErrStyleID := nextStyleID;
AppendToStream(AChartStream, Format(
indent + '<chart:error-indicator chart:style-name="ch%d" chart:dimension="y" />',
[ yErrStyleID ]
));
inc(nextStyleID);
end;
// Regression
if (series is TsScatterSeries) then
begin
regression := TsScatterSeries(series).Regression;
if regression.RegressionType <> rtNone then
begin
regressionStyleID := nextStyleID;
inc(nextStyleID);
if regression.DisplayEquation or regression.DisplayRSquare then
begin
if (not regression.Equation.DefaultXName) or (not regression.Equation.DefaultYName) or
@ -3702,9 +3806,9 @@ begin
(not regression.Equation.DefaultFont) or (not regression.Equation.DefaultNumberFormat) or
(not regression.Equation.DefaultPosition) then
begin
regressionEquation := regressionEquation + Format('chart:style-name="ch%d" ', [AStyleID + 2]);
needRegressionEquationStyle := true;
styleID := AStyleID + 2;
regressionEquStyleID := nextStyleID;
regressionEquation := regressionEquation + Format('chart:style-name="ch%d" ', [ regressionEquStyleID ]);
inc(nextStyleID);
end;
end;
if regression.DisplayEquation then
@ -3725,28 +3829,25 @@ begin
indent + ' <chart:regression-curve chart:style-name="ch%d">' + LE +
indent + ' <chart:equation %s />' + LE +
indent + ' </chart:regression-curve>' + LE,
[ AStyleID + 1, regressionEquation ]
[ regressionStyleID, regressionEquation ]
));
end else
AppendToStream(AChartStream, Format(
indent + ' <chart:regression-curve chart:style-name="ch%d"/>',
[ AStyleID + 1 ]
[ regressionStyleID ]
));
needRegressionStyle := true;
if styleID = AStyleID then
styleID := AStyleID + 1;
end;
end;
// Individual data point styles
if series.DataPointStyles.Count = 0 then
AppendToStream(AChartStream, Format(
indent + ' <chart:data-point chart:repeated="%d"/>' + LE,
indent + ' <chart:data-point chart:repeated="%d" />' + LE,
[ count ]
))
else
begin
dpStyleID := styleID + 1;
dataStyleID := nextStyleID;
for i := 0 to count - 1 do
begin
if (i >= series.DataPointStyles.Count) or (series.DataPointStyles[i] = nil) then
@ -3757,9 +3858,9 @@ begin
begin
AppendToStream(AChartStream, Format(
indent + ' <chart:data-point chart:style-name="ch%d" />' + LE, // ToDo: could contain "chart:repeated"
[ dpStyleID ]
[ dataStyleID + i]
));
inc(dpStyleID);
inc(nextStyleID);
end;
end;
end;
@ -3769,38 +3870,47 @@ begin
// Series style
AppendToStream(AStyleStream,
GetChartSeriesStyleAsXML(AChart, ASeriesIndex, AStyleIndent, AStyleID)
GetChartSeriesStyleAsXML(AChart, ASeriesIndex, AStyleIndent, seriesStyleID)
);
// Regression style
if needRegressionStyle then
if regressionStyleID <> -1 then
begin
inc(AStyleID);
AppendToStream(AStyleStream,
GetChartRegressionStyleAsXML(AChart, ASeriesIndex, AStyleIndent, AStyleID)
GetChartRegressionStyleAsXML(AChart, ASeriesIndex, AStyleIndent, regressionStyleID)
);
// Style of regression equation
if needRegressionEquationStyle then
if regressionEquStyleID <> -1 then
begin
inc(AStyleID);
AppendToStream(AStyleStream,
GetChartRegressionEquationStyleAsXML(AChart, regression.Equation, AStyleIndent, AStyleID)
GetChartRegressionEquationStyleAsXML(AChart, regression.Equation, AStyleIndent, regressionEquStyleID)
);
end;
end;
// Error bar styles
if xErrStyleID <> -1 then
AppendToStream(AStyleStream,
GetChartErrorBarStyleAsXML(AChart, series.XErrorBars, AStyleIndent, xErrStyleID)
);
if yErrStyleID <> -1 then
AppendToStream(AStyleStream,
GetChartErrorBarStyleAsXML(AChart, series.YErrorBars, AStyleIndent, yErrStyleID)
);
// Data point styles
for i := 0 to series.DataPointStyles.Count - 1 do
begin
inc(AStyleID);
AppendToStream(AStyleStream,
GetChartSeriesDataPointStyleAsXML(AChart, ASeriesIndex, i, AStyleIndent, AStyleID)
GetChartSeriesDataPointStyleAsXML(AChart, ASeriesIndex, i, AStyleIndent, dataStyleID)
);
inc(dataStyleID);
end;
// Next style
inc(AStyleID);
AStyleID := nextStyleID;
end;
procedure TsSpreadOpenDocChartWriter.WriteChartStockSeries(