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

fpspreadsheet: ods reader supports chart series.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9021 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-11-10 23:31:27 +00:00
parent 0a956f3056
commit 927d08783d
4 changed files with 248 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files

48
components/fpspreadsheet/examples/other/chart/read_chart_demo.lpr
View File

@ -7,13 +7,16 @@ uses
const
// FILE_NAME = 'test.ods';
// FILE_NAME = 'area.ods';
FILE_NAME = 'bars.ods';
// FILE_NAME = 'bars.ods';
FILE_NAME = 'regression.ods';
// FILE_NAME = 'pie.ods';
// FILE_NAME = 'radar.ods';
var
book: TsWorkbook;
sheet: TsWorksheet;
chart: TsChart;
series: TsChartSeries;
i, j: Integer;
s: String;
isODS: Boolean;
begin
isODS := ExtractFileExt(FILE_NAME) = '.ods';
@ -194,6 +197,47 @@ begin
' Width:', chart.YAxis.MinorGridLines.Width:0:0, 'mm',
' Color:', IntToHex(chart.YAxis.MinorGridLines.Color, 6),
' Transparency:', chart.YAxis.MinorGridLines.Transparency:0:2);
for j := 0 to chart.Series.Count-1 do
begin
series := chart.Series[j];
WriteLn;
WriteLn(' SERIES #', j, ': ', series.ClassName);
with series.TitleAddr do
WriteLn(' TITLE: ', GetCellRangeString(Sheet, Sheet, Row, Col, Row, Col, rfAllRel, false));
with series.LabelRange do
WriteLn(' LABEL RANGE: ', GetCellRangeString(Sheet1, Sheet2, Row1, Col1, Row2, Col2, rfAllRel, false));
if (series is TsScatterSeries) or (series is TsBubbleSeries) then with series.XRange do
WriteLn(' X RANGE: ', GetCellRangeString(Sheet1, Sheet2, Row1, Col1, Row2, Col2, rfAllRel, false));
with series.YRange do
WriteLn(' Y RANGE: ', GetCellRangeString(Sheet1, Sheet2, Row1, Col1, Row2, Col2, rfAllRel, false));
with series.FillColorRange do
WriteLn(' FILL COLOR RANGE: ', GetCellRangeString(Sheet1, Sheet2, Row1, Col1, Row2, Col2, rfAllRel, false));
with series.LineColorRange do
WriteLn(' LINE COLOR RANGE: ', GetCellRangeString(Sheet1, Sheet2, Row1, Col1, Row2, Col2, rfAllRel, false));
if series is TsBubbleSeries then with TsBubbleSeries(series).BubbleRange do
WriteLn(' BUBBLE RANGE: ', GetCellRangeString(Sheet1, Sheet2, Row1, Col1, Row2, Col2, rfAllRel, false));
if series is TsLineSeries then with TsLineSeries(series) do
begin
Write(' SYMBOLS: ');
if ShowSymbols then
WriteLn('Symbol:', GetEnumName(TypeInfo(TsChartSeriesSymbol), ord(Symbol)),
' Width:', SymbolWidth:0:1, 'mm',
' Height:', SymbolHeight:0:1, 'mm')
else
WriteLn('none');
end;
WriteLn(' FILL: Style:', GetEnumName(TypeInfo(TsChartFillStyle), ord(series.Fill.Style)),
' Color:', IntToHex(series.Fill.Color, 6),
' Gradient:', series.Fill.Gradient,
' Hatch:', series.Fill.Hatch,
' Transparency:', series.Fill.Transparency:0:2);
WriteLn(' LINES: Style:', series.Line.Style,
' Width:', series.Line.Width:0:0, 'mm',
' Color:', IntToHex(series.Line.Color, 6),
' Transparency:', series.Line.Transparency:0:2);
end;
end;
finally

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

@ -165,7 +165,7 @@ type
procedure Assign(ASource: TsChartRange);
function GetSheet1Name: String;
function GetSheet2Name: String;
function IsUsed: Boolean;
function IsEmpty: Boolean;
end;
TsChartElement = class
@ -298,6 +298,7 @@ type
FXRange: TsChartRange; // cell range containing the x data
FYRange: TsChartRange;
FFillColorRange: TsChartRange;
FLineColorRange: TsChartRange;
FLabelRange: TsChartRange;
FLabelFont: TsFont;
FLabelPosition: TsChartLabelPosition;
@ -329,6 +330,8 @@ type
procedure SetYRange(ASheet1: String; ARow1, ACol1: Cardinal; ASheet2: String; ARow2, ACol2: Cardinal);
procedure SetFillColorRange(ARow1, ACol1, ARow2, ACol2: Cardinal);
procedure SetFillColorRange(ASheet1: String; ARow1, ACol1: Cardinal; ASheet2: String; ARow2, ACol2: Cardinal);
procedure SetLineColorRange(ARow1, ACol1, ARow2, ACol2: Cardinal);
procedure SetLineColorRange(ASheet1: String; ARow1, ACol1: Cardinal; ASheet2: String; ARow2, ACol2: Cardinal);
function LabelsInCol: Boolean;
function XValuesInCol: Boolean;
function YValuesInCol: Boolean;
@ -336,15 +339,16 @@ type
property ChartType: TsChartType read GetChartType;
property Count: Integer read GetCount;
property DataLabels: TsChartDataLabels read FDataLabels write FDataLabels;
property FillColorRange: TsChartRange read FFillColorRange;
property FillColorRange: TsChartRange read FFillColorRange write 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: TsChartRange read FLabelRange;
property LabelRange: TsChartRange read FLabelRange write FLabelRange;
property LabelSeparator: string read FLabelSeparator write FLabelSeparator;
property LineColorRange: TsChartRange read FLineColorRange write FLineColorRange;
property TitleAddr: TsChartCellAddr read FTitleAddr write FTitleAddr; // use '\n' for line-break
property XRange: TsChartRange read FXRange;
property YRange: TsChartRange read FYRange;
property XRange: TsChartRange read FXRange write FXRange;
property YRange: TsChartRange read FYRange write FYRange;
property YAxis: TsChartAxisLink read FYAxis write FYAxis;
property Fill: TsChartFill read FFill write FFill;
@ -898,11 +902,11 @@ begin
Result := FChart.GetWorksheet.Name;
end;
function TsChartRange.IsUsed: Boolean;
function TsChartRange.IsEmpty: Boolean;
begin
Result :=
(Row1 <> UNASSIGNED_ROW_COL_INDEX) and (Col1 <> UNASSIGNED_ROW_COL_INDEX) and
(Row2 <> UNASSIGNED_ROW_COL_INDEX) and (Col2 <> UNASSIGNED_ROW_COL_INDEX);
(Row1 = UNASSIGNED_ROW_COL_INDEX) and (Col1 = UNASSIGNED_ROW_COL_INDEX) and
(Row2 = UNASSIGNED_ROW_COL_INDEX) and (Col2 = UNASSIGNED_ROW_COL_INDEX);
end;
@ -1044,6 +1048,7 @@ begin
FXRange := TsChartRange.Create(AChart);
FYRange := TsChartRange.Create(AChart);
FFillColorRange := TsChartRange.Create(AChart);
FLineColorRange := TsChartRange.Create(AChart);
FLabelRange := TsChartRange.Create(AChart);
FTitleAddr := TsChartCellAddr.Create(AChart);
@ -1070,6 +1075,7 @@ begin
FFill.Free;
FTitleAddr.Free;
FLabelRange.Free;
FLineColorRange.Free;
FFillColorRange.Free;
FYRange.Free;
FXRange.Free;
@ -1173,6 +1179,24 @@ begin
FLabelRange.Col2 := ACol2;
end;
procedure TsChartSeries.SetLineColorRange(ARow1, ACol1, ARow2, ACol2: Cardinal);
begin
SetLineColorRange('', ARow1, ACol1, '', ARow2, ACol2);
end;
procedure TsChartSeries.SetLineColorRange(ASheet1: String; ARow1, ACol1: Cardinal;
ASheet2: String; ARow2, ACol2: Cardinal);
begin
if (ARow1 <> ARow2) and (ACol1 <> ACol2) then
raise Exception.Create('Series line color values can only be located in a single column or row.');
FLineColorRange.Sheet1 := ASHeet1;
FLineColorRange.Row1 := ARow1;
FLineColorRange.Col1 := ACol1;
FLineColorRange.Sheet2 := ASheet2;
FLineColorRange.Row2 := ARow2;
FLineColorRange.Col2 := ACol2;
end;
procedure TsChartSeries.SetXRange(ARow1, ACol1, ARow2, ACol2: Cardinal);
begin
SetXRange('', ARow1, ACol1, '', ARow2, ACol2);

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

@ -15,6 +15,9 @@ uses
fpsTypes, fpSpreadsheet, fpsChart, fpsUtils, fpsReaderWriter, fpsXMLCommon;
type
{ TsSpreadOpenDocChartReader }
TsSpreadOpenDocChartReader = class(TsBasicSpreadChartReader)
private
FChartFiles: TStrings;
@ -27,12 +30,15 @@ type
procedure ReadChartAxisProps(ANode, AStyleNode: TDOMNode; AChart: TsChart);
procedure ReadChartAxisStyle(AStyleNode: TDOMNode; AChart: TsChart; Axis: TsChartAxis);
procedure ReadChartBackgroundStyle(AStyleNode: TDOMNode; AChart: TsChart);
procedure ReadChartCellAddr(ANode: TDOMNode; ANodeName: String; ACellAddr: TsChartCellAddr);
procedure ReadChartCellRange(ANode: TDOMNode; ANodeName: String; ARange: TsChartRange);
procedure ReadChartProps(AChartNode, AStyleNode: TDOMNode; AChart: TsChart);
procedure ReadChartPlotAreaProps(ANode, AStyleNode: TDOMNode; AChart: TsChart);
procedure ReadChartPlotAreaStyle(AStyleNode: TDOMNode; AChart: TsChart);
procedure ReadChartLegendProps(ANode, AStyleNode: TDOMNode; AChart: TsChart);
procedure ReadChartLegendStyle(AStyleNode: TDOMNode; AChart: TsChart);
procedure ReadChartSeriesProps(ANode, AStyleNode: TDOMNode; AChart: TsChart);
procedure ReadChartSeriesStyle(AStyleNode: TDOMNode; AChart: TsChart; ASeries: TsChartSeries);
procedure ReadChartTitleProps(ANode, AStyleNode: TDOMNode; AChart: TsChart; ATitle: TsChartText);
procedure ReadChartTitleStyle(AStyleNode: TDOMNode; AChart: TsChart; ATitle: TsChartText);
@ -78,7 +84,7 @@ type
function GetNumberFormatID(ANumFormat: String): String;
procedure ListAllNumberFormats(AChart: TsChart);
procedure PrepareChartTable(AChart: TsChart; AWorksheet: TsBasicWorksheet);
// procedure PrepareChartTable(AChart: TsChart; AWorksheet: TsBasicWorksheet);
protected
// Object X/styles.xml
@ -633,6 +639,23 @@ begin
end;
end;
procedure TsSpreadOpenDocChartReader.ReadChartCellAddr(ANode: TDOMNode;
ANodeName: String; ACellAddr: TsChartCellAddr);
var
s: String;
sh1, sh2: String;
r1, c1, r2, c2: Cardinal;
relFlags: TsRelFlags;
begin
s := GetAttrValue(ANode, ANodeName);
if (s <> '') and TryStrToCellRange_ODS(s, sh1, sh2, r1, c1, r2, c2, relFlags) then
begin
ACellAddr.Sheet := sh1;
ACellAddr.Row := r1;
ACellAddr.Col := c1;
end;
end;
procedure TsSpreadOpenDocChartReader.ReadChartCellRange(ANode: TDOMNode;
ANodeName: String; ARange: TsChartRange);
var
@ -768,6 +791,8 @@ begin
case nodeName of
'chart:axis':
ReadChartAxisProps(ANode, AStyleNode, AChart);
'chart:series':
ReadChartSeriesProps(ANode, AStyleNode, AChart);
end;
ANode := ANode.NextSibling;
end;
@ -855,6 +880,127 @@ begin
end;
end;
procedure TsSpreadOpenDocChartReader.ReadChartSeriesProps(ANode, AStyleNode: TDOMNode;
AChart: TsChart);
var
s, nodeName: String;
series: TsChartSeries;
subNode: TDOMNode;
styleNode: TDOMNode;
xyCounter: Integer;
begin
s := GetAttrValue(ANode, 'chart:class');
case s of
'chart:area': series := TsAreaSeries.Create(AChart);
'chart:bar': series := TsBarSeries.Create(AChart);
'chart:bubble': series := TsBubbleSeries.Create(AChart);
'chart:circle': series := TsPieSeries.Create(AChart);
'chart:filled-radar': series := TsRadarSeries.Create(AChart);
'chart:line': series := TsLineSeries.Create(AChart);
'chart:radar': series := TsRadarSeries.Create(AChart);
'chart:ring': series := TsRingSeries.Create(AChart);
'chart:scatter': series := TsScatterSeries.Create(AChart);
else raise Exception.Create('Unknown/unsupported series type.');
end;
AChart.AddSeries(series);
ReadChartCellAddr(ANode, 'chart:label-cell-address', series.TitleAddr);
if (series is TsBubbleSeries) then
ReadChartCellRange(ANode, 'chart:values-cell-range-address', TsBubbleSeries(series).BubbleRange)
else
ReadChartCellRange(ANode, 'chart:values-cell-range-address', series.YRange);
xyCounter := 0;
subnode := ANode.FirstChild;
while subnode <> nil do
begin
nodeName := subNode.NodeName;
case nodeName of
'chart:domain':
begin
if xyCounter = 0 then
begin
ReadChartCellRange(subnode, 'table:cell-range-address', series.XRange);
inc(xyCounter);
end else
if xyCounter = 1 then
begin
series.YRange.Assign(series.XRange);
ReadChartCellRange(subnode, 'table:cell-range-address', series.XRange)
end;
end;
'loext:property-mapping':
begin
s := GetAttrValue(subnode, 'loext:property');
case s of
'FillColor':
ReadChartCellRange(subNode, 'loext:cell-range-address', series.FillColorRange);
'BorderColor':
ReadChartCellRange(subNode, 'loext:cell-range-address', series.LineColorRange);
end;
end;
end;
subnode := subNode.NextSibling;
end;
if series.LabelRange.IsEmpty then series.LabelRange.Assign(AChart.XAxis.CategoryRange);
s := GetAttrValue(ANode, 'chart:style-name');
styleNode := FindStyleNode(AStyleNode, s);
ReadChartSeriesStyle(styleNode, AChart, series);
end;
procedure TsSpreadOpenDocChartReader.ReadChartSeriesStyle(AStyleNode: TDOMNode;
AChart: TsChart; ASeries: TsChartSeries);
var
nodeName: String;
s: String;
css: TsChartSeriesSymbol;
value: Double;
rel: Boolean;
begin
nodeName := AStyleNode.NodeName;
AStyleNode := AStyleNode.FirstChild;
while AStyleNode <> nil do begin
nodeName := AStyleNode.NodeName;
case nodeName of
'style:graphic-properties':
begin
GetChartLineProps(AStyleNode, AChart, ASeries.Line);
GetChartFillProps(AStyleNode, AChart, ASeries.Fill);
end;
'style:text-properties':
TsSpreadOpenDocReader(Reader).ReadFont(AStyleNode, ASeries.LabelFont);
'style:chart-properties':
begin
if (ASeries is TsLineSeries) then
begin
s := GetAttrValue(AStyleNode, 'chart:symbol-name');
if s <> '' then
begin
TsLineSeries(ASeries).ShowSymbols := true;
for css in TsChartSeriesSymbol do
if SYMBOL_NAMES[css] = s then
begin
TsLineSeries(ASeries).Symbol := css;
break;
end;
s := GetAttrValue(AStyleNode, 'symbol-width');
if (s <> '') and EvalLengthStr(s, value, rel) then
TsLineSeries(ASeries).SymbolWidth := value;
s := GetAttrValue(AStyleNode, 'symbol-height');
if (s <> '') and EvalLengthStr(s, value, rel) then
TsLineSeries(ASeries).SymbolHeight := value;
end else
TsLineSeries(ASeries).ShowSymbols := false;
end;
end;
end;
AStyleNode := AStyleNode.NextSibling;
end;
end;
procedure TsSpreadOpenDocChartReader.ReadChartTitleProps(ANode, AStyleNode: TDOMNode;
AChart: TsChart; ATitle: TsChartText);
var
@ -1823,6 +1969,7 @@ begin
end;
end;
(* DO NOT DELETE THIS! MAYBE NEEDED LATER...
{ Extracts the cells needed by the given chart from the chart's worksheet and
copies their values into a temporary worksheet, AWorksheet, so that these
@ -1998,6 +2145,7 @@ begin
auxSheet.WriteComment(1, destCol, refStr); // Store y range reference as comment for svg node
end;
end;
*)
procedure TsSpreadOpenDocChartWriter.ResetStreams;
var
@ -2594,6 +2742,7 @@ var
domainRangeX: String = '';
domainRangeY: String = '';
fillColorRange: String = '';
lineColorRange: String = '';
chartClass: String = '';
regressionEquation: String = '';
needRegressionStyle: Boolean = false;
@ -2656,6 +2805,15 @@ begin
rfAllRel, false
);
// Line colors for bars, line series symbols, bubbles etc.
if not series.LineColorRange.IsEmpty then
lineColorRange := GetSheetCellRangeString_ODS(
series.LineColorRange.GetSheet1Name, series.LineColorRange.GetSheet2Name,
series.LineColorRange.Row1, series.LineColorRange.Col1,
series.LineColorRange.Row2, series.LineColorRange.Col2,
rfAllRel, false
);
// And this is the title of the series for the legend
titleAddr := GetSheetCellRangeString_ODS(
series.TitleAddr.GetSheetName, series.TitleAddr.GetSheetName,
@ -2675,7 +2833,6 @@ begin
else
chartClass := CHART_TYPE_NAMES[series.ChartType];
// Store the series properties
AppendToStream(AChartStream, Format(
indent + '<chart:series chart:style-name="ch%d" ' +
@ -2696,17 +2853,14 @@ begin
));
if fillColorRange <> '' then
AppendToStream(AChartStream, Format(
indent + '<loext:propertry-mapping loext:property="FillColor" loext:cell-range-address="%s"/>' + LE,
indent + '<loext:property-mapping loext:property="FillColor" loext:cell-range-address="%s"/>' + LE,
[ fillColorRange ]
));
{ --- not working...
if borderColorRange <> '' then
if lineColorRange <> '' then
AppendToStream(AChartStream, Format(
indent + '<loext:property-mapping loext:property="BorderColor" loext:cell-range-address="%s"/>' + LE,
[ borderColorRange ]
[ lineColorRange ]
));
}
// Regression
if (series is TsScatterSeries) then

8
components/fpspreadsheet/source/common/fpsutils.pas
View File

@ -1300,6 +1300,14 @@ end;
function GetCellRangeString(ASheet1, ASheet2: String; ARow1, ACol1, ARow2, ACol2: Cardinal;
AFlags: TsRelFlags = rfAllRel; Compact: Boolean = false): String;
begin
if (ASheet1 = '') and (ASheet2 = '') and
(ARow1 = UNASSIGNED_ROW_COL_INDEX) and (ACol1 = UNASSIGNED_ROW_COL_INDEX) and
(ARow2 = UNASSIGNED_ROW_COL_INDEX) and (ACol2 = UNASSIGNED_ROW_COL_INDEX) then
begin
Result := '';
exit;
end;
Result := GetCellRangeString(ARow1, ACol1, ARow2, ACol2, AFlags, Compact);
if (ASheet1 = '') and (ASheet2 = '') then
exit;