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

fpspreadsheet: Chart link as well as ods reader/writer support individual data point colors

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9063 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-12-01 23:54:16 +00:00
parent fb4abdab4d
commit 8919da735c
4 changed files with 265 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -25,6 +25,7 @@ begin
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.WriteFontStyle(3, 0, [fssBold]); sheet.WriteFontStyle(3, 1, [fssBold]);
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);
@ -53,6 +54,15 @@ begin
ser.LabelPosition := lpOutside;
ser.Line.Color := scWhite;
ser.LabelFormat := '#,##0';
// Individual sector colors
// Must be complete, otherwise will be ignored by Calc and replaced by default colors
ser.AddDataPointStyle(scYellow);
ser.AddDataPointStyle(scMaroon);
ser.AddDataPointStyle(scRed);
ser.AddDataPointStyle(scWhite);
ser.AddDatapointStyle(scBlue);
//ser.SetFillColorRange(4, 2, 8, 2);
{

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

@ -40,6 +40,7 @@ type
Width: Double; // mm
Color: TsColor; // in hex: $00bbggrr, r=red, g=green, b=blue
Transparency: Double; // in percent
procedure CopyFrom(ALine: TsChartLine);
end;
TsChartGradientStyle = (cgsLinear, cgsAxial, cgsRadial, cgsElliptic, cgsSquare, cgsRectangular);
@ -135,6 +136,7 @@ type
Hatch: Integer;
Image: Integer;
Transparency: Double; // 0.0 ... 1.0
procedure CopyFrom(AFill: TsChartFill);
end;
TsChartLineSegment = record
@ -312,6 +314,8 @@ type
TsChartDataLabels = set of TsChartDataLabel;
TsChartLabelPosition = (lpDefault, lpOutside, lpInside, lpCenter);
TsChartDataPointStyle = class(TsChartFillElement);
TsChartSeries = class(TsChartElement)
private
FChartType: TsChartType;
@ -331,11 +335,14 @@ type
FLine: TsChartLine;
FFill: TsChartFill;
FDataLabels: TsChartDataLabels;
FDataPointStyles: TFPObjectList;
protected
function GetChartType: TsChartType; virtual;
public
constructor Create(AChart: TsChart); virtual;
destructor Destroy; override;
procedure AddDataPointStyle(AFill: TsChartFill; ALine: TsChartLine; ACount: Integer = 1);
procedure AddDataPointStyle(AColor: TsColor; ACount: Integer = 1);
function GetCount: Integer;
function GetXCount: Integer;
function GetYCount: Integer;
@ -361,6 +368,7 @@ type
property ChartType: TsChartType read GetChartType;
property Count: Integer read GetCount;
property DataLabels: TsChartDataLabels read FDataLabels write FDataLabels;
property DataPointStyles: TFPObjectList read FDataPointStyles;
property FillColorRange: TsChartRange read FFillColorRange write FFillColorRange;
property LabelBackground: TsChartFill read FLabelBackground write FLabelBackground;
property LabelBorder: TsChartLine read FLabelBorder write FLabelBorder;
@ -659,6 +667,20 @@ implementation
uses
fpSpreadsheet;
{ TsChartLine }
procedure TsChartLine.CopyFrom(ALine: TsChartLine);
begin
if ALine <> nil then
begin
Style := ALine.Style;
Width := ALine.Width;
Color := ALine.Color;
Transparency := ALine.Transparency;
end;
end;
{ TsChartGradient }
constructor TsChartGradient.Create;
@ -900,6 +922,22 @@ begin
end;
{ TsChartFill }
procedure TsChartFill.CopyFrom(AFill: TsChartFill);
begin
if AFill <> nil then
begin
Style := AFill.Style;
Color := AFill.Color;
Gradient := AFill.Gradient;
Hatch := AFill.Hatch;
Image := AFill.Image;
Transparency := AFill.Transparency;
end;
end;
{ TsChartLineStyle }
function TsChartLineStyle.GetID: String;
@ -1194,6 +1232,8 @@ begin
FLine.Width := PtsToMM(DEFAULT_CHART_LINEWIDTH);
FLine.Color := DEFAULT_SERIES_COLORS[idx mod Length(DEFAULT_SERIES_COLORS)];
FDataPointStyles := TFPObjectList.Create;
FLabelFont := TsFont.Create;
FLabelFont.Size := 9;
@ -1213,6 +1253,7 @@ begin
FLabelBackground.Free;
FLabelBorder.Free;
FLabelFont.Free;
FDataPointStyles.Free;
FLine.Free;
FFill.Free;
FTitleAddr.Free;
@ -1224,6 +1265,39 @@ begin
inherited;
end;
procedure TsChartSeries.AddDataPointStyle(AFill: TsChartFill; ALine: TsChartLine;
ACount: Integer = 1);
var
i: Integer;
dataPointStyle: TsChartDataPointStyle;
begin
if (AFill = nil) and (ALine = nil) then
for i := 1 to ACount do
FDataPointStyles.Add(nil)
else
for i := 1 to ACount do
begin
dataPointStyle := TsChartDataPointStyle.Create(FChart);
dataPointStyle.Background.CopyFrom(AFill);
dataPointStyle.Border.CopyFrom(ALine);
FDataPointStyles.Add(dataPointStyle);
end;
end;
procedure TsChartSeries.AddDataPointStyle(AColor: TsColor; ACount: Integer = 1);
var
i: Integer;
datapointStyle: TsChartDataPointStyle;
begin
for i := 1 to ACount do
begin
datapointStyle := TsChartDatapointStyle.Create(FChart);
dataPointStyle.Background.Style:= cfsSolid;
dataPointStyle.Background.Color := AColor;
FDataPointStyles.Add(datapointStyle);
end;
end;
function TsChartSeries.GetChartType: TsChartType;
begin
Result := FChartType;

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

@ -26,8 +26,8 @@ type
FPieSeriesStartAngle: Integer;
FStreamList: TFPObjectList;
function FindStyleNode(AStyleNodes: TDOMNode; AStyleName: String): TDOMNode;
procedure GetChartFillProps(ANode: TDOMNode; AChart: TsChart; AFill: TsChartFill);
procedure GetChartLineProps(ANode: TDOMNode; AChart: TsChart; ALine: TsChartLine);
function GetChartFillProps(ANode: TDOMNode; AChart: TsChart; AFill: TsChartFill): Boolean;
function GetChartLineProps(ANode: TDOMNode; AChart: TsChart; ALine: TsChartLine): Boolean;
procedure GetChartTextProps(ANode: TDOMNode; AFont: TsFont);
procedure ReadChartAxisGrid(ANode, AStyleNode: TDOMNode; AChart: TsChart; Axis: TsChartAxis);
@ -45,6 +45,8 @@ type
procedure ReadChartRegressionEquationStyle(AStyleNode: TDOMNode; AChart: TsChart; ASeries: TsChartSeries);
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);
procedure ReadChartSeriesProps(ANode, AStyleNode: TDOMNode; AChart: TsChart);
procedure ReadChartSeriesStyle(AStyleNode: TDOMNode; AChart: TsChart; ASeries: TsChartSeries);
procedure ReadChartTitleProps(ANode, AStyleNode: TDOMNode; AChart: TsChart; ATitle: TsChartText);
@ -89,6 +91,7 @@ type
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 GetNumberFormatID(ANumFormat: String): String;
@ -403,11 +406,16 @@ begin
FChartFiles.Add(AFileList);
end;
procedure TsSpreadOpenDocChartReader.GetChartFillProps(ANode: TDOMNode;
AChart: TsChart; AFill: TsChartFill);
{@@ ----------------------------------------------------------------------------
Reads the fill style properties from the specified node. Returns FALSE, if
the node contains no fill-specific attributes.
-------------------------------------------------------------------------------}
function TsSpreadOpenDocChartReader.GetChartFillProps(ANode: TDOMNode;
AChart: TsChart; AFill: TsChartFill): Boolean;
var
{%H-}nodeName: String;
s: String;
sFill: String;
sOpac: String;
sc: String;
sn: String;
opacity: Double;
@ -417,8 +425,8 @@ var
begin
nodeName := ANode.NodeName;
s := GetAttrValue(ANode, 'draw:fill');
case s of
sFill := GetAttrValue(ANode, 'draw:fill');
case sFill of
'none':
AFill.Style := cfsNoFill;
'', 'solid':
@ -472,13 +480,19 @@ begin
end;
end;
s := GetAttrValue(ANode, 'draw:opacity');
if (s <> '') and TryPercentStrToFloat(s, opacity) then
sOpac := GetAttrValue(ANode, 'draw:opacity');
if (sOpac <> '') and TryPercentStrToFloat(sOpac, opacity) then
AFill.Transparency := 1.0 - opacity;
Result := (sFill <> '') or (sc <> '') or (sn <> '') or (sOpac <> '');
end;
procedure TsSpreadOpenDocChartReader.GetChartLineProps(ANode: TDOMNode;
AChart: TsChart; ALine: TsChartLine);
{ ------------------------------------------------------------------------------
Reads the line formatting properties from the specified node.
Returns FALSE, if there are no line-related attributes.
-------------------------------------------------------------------------------}
function TsSpreadOpenDocChartReader.GetChartLineProps(ANode: TDOMNode;
AChart: TsChart; ALine: TsChartLine): Boolean;
var
{%H-}nodeName: String;
s: String;
@ -517,9 +531,11 @@ begin
if (sw <> '') and EvalLengthStr(sw, value, rel) then
ALine.Width := value;
so := 'draw:stroke-opacity';
so := GetAttrValue(ANode, 'draw:stroke-opacity');
if (so <> '') and TryPercentStrToFloat(so, value) then
ALine.Transparency := 1.0 - value*0.01;
Result := (s <> '') or (sc <> '') or (sw <> '') or (so <> '');
end;
procedure TsSpreadOpenDocChartReader.GetChartTextProps(ANode: TDOMNode;
@ -1192,14 +1208,42 @@ begin
end;
end;
procedure TsSpreadOpenDocChartReader.ReadChartSeriesDataPointStyle(AStyleNode: TDOMNode;
AChart: TsChart; ASeries: TsChartSeries; var AFill: TsChartFill; var ALine: TsChartLine);
var
nodeName: string;
grNode: TDOMNode;
begin
AFill := nil;
ALine := nil;
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);
end;
AStyleNode := AStyleNode.NextSibling;
end;
end;
procedure TsSpreadOpenDocChartReader.ReadChartSeriesProps(ANode, AStyleNode: TDOMNode;
AChart: TsChart);
var
s, nodeName: String;
series: TsChartSeries;
fill: TsChartFill;
line: TsChartLine;
subNode: TDOMNode;
styleNode: TDOMNode;
xyCounter: Integer;
n: Integer;
begin
s := GetAttrValue(ANode, 'chart:class');
case s of
@ -1252,6 +1296,24 @@ begin
end;
'chart:regression-curve':
ReadChartRegressionProps(subNode, AStyleNode, AChart, series);
'chart:data-point':
begin
fill := nil;
line := nil;
n := 1;
s := GetAttrValue(subnode, 'chart:style-name');
if s <> '' then
begin
styleNode := FindStyleNode(AStyleNode, s);
ReadChartSeriesDataPointStyle(styleNode, AChart, series, fill, line); // creates fill and line!
end;
s := GetAttrValue(subnode, 'chart:repeated');
if (s <> '') then
n := StrToIntDef(s, 1);
series.AddDataPointStyle(fill, line, n);
fill.Free; // the styles have been copied to the series datapoint list and are not needed any more.
line.Free;
end;
end;
subnode := subNode.NextSibling;
end;
@ -2247,6 +2309,37 @@ begin
);
end;
function TsSpreadOpenDocChartWriter.GetChartSeriesDataPointStyleAsXML(AChart: TsChart;
ASeriesIndex, APointIndex, AIndent, AStyleID: Integer): String;
var
series: TsChartSeries;
indent: String;
chartProps: String;
graphProps: String = '';
dataPointStyle: TsChartDataPointStyle;
begin
Result := '';
indent := DupeString(' ', AIndent);
series := AChart.Series[ASeriesIndex];
dataPointStyle := TsChartDataPointStyle(series.DataPointStyles[APointIndex]);
chartProps := 'chart:solid-type="cuboid" ';
if dataPointStyle.Background <> nil then
graphProps := graphProps + GetChartFillStyleGraphicPropsAsXML(AChart, dataPointStyle.Background);
if dataPointStyle.Border <> nil then
graphProps := graphProps + GetChartLineStyleGraphicPropsAsXML(AChart, dataPointStyle.Border);
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;
{ <style:style style:name="ch1400" style:family="chart" style:data-style-name="N0">
<style:chart-properties
@ -2326,9 +2419,9 @@ begin
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;
indent + ' <chart:label-separator>' + LE +
indent + ' <text:p>' + labelSeparator + '</text:p>' + LE +
indent + ' </chart:label-separator>' + LE;
end;
if series.LabelBorder.Style <> clsNoLine then
@ -2338,9 +2431,9 @@ begin
end;
if labelSeparator <> '' then
chartProps := ' <style:chart-properties ' + chartProps + '>' + LE + labelSeparator + ' </style:chart-properties>'
chartProps := indent + ' <style:chart-properties ' + chartProps + '>' + LE + labelSeparator + indent + ' </style:chart-properties>'
else
chartProps := ' <style:chart-properties ' + chartProps + '/>';
chartProps := indent + ' <style:chart-properties ' + chartProps + '/>';
// Graphic properties
lineProps := GetChartLineStyleGraphicPropsAsXML(AChart, series.Line);
@ -2361,7 +2454,7 @@ begin
Result := Format(
indent + '<style:style style:name="ch%d" style:family="chart" style:data-style-name="%s">' + LE +
indent + chartProps + LE +
chartProps + LE +
indent + ' <style:graphic-properties %s/>' + LE +
indent + ' <style:text-properties %s/>' + LE +
indent + '</style:style>' + LE,
@ -3196,9 +3289,11 @@ var
needRegressionEquationStyle: Boolean = false;
regression: TsChartRegression = nil;
titleAddr: String;
count: Integer;
i, count: Integer;
styleID, dpStyleID: Integer;
begin
indent := DupeString(' ', AChartIndent);
styleID := AStyleID;
series := AChart.Series[ASeriesIndex];
@ -3324,6 +3419,7 @@ begin
begin
regressionEquation := regressionEquation + Format('chart:style-name="ch%d" ', [AStyleID + 2]);
needRegressionEquationStyle := true;
styleID := AStyleID + 2;
end;
end;
if regression.DisplayEquation then
@ -3345,20 +3441,43 @@ begin
indent + ' <chart:equation %s />' + LE +
indent + ' </chart:regression-curve>' + LE,
[ AStyleID + 1, regressionEquation ]
))
));
end else
AppendToStream(AChartStream, Format(
indent + ' <chart:regression-curve chart:style-name="ch%d"/>',
[ AStyleID + 1 ]
));
needRegressionStyle := true;
if styleID = AStyleID then
styleID := AStyleID + 1;
end;
end;
AppendToStream(AChartStream, Format(
indent + ' <chart:data-point chart:repeated="%d"/>' + LE,
[ count ]
));
// Individual data point styles
if series.DataPointStyles.Count = 0 then
AppendToStream(AChartStream, Format(
indent + ' <chart:data-point chart:repeated="%d"/>' + LE,
[ count ]
))
else
begin
dpStyleID := styleID + 1;
for i := 0 to count - 1 do
begin
if (i >= series.DataPointStyles.Count) or (series.DataPointStyles[i] = nil) then
AppendToStream(AChartStream,
indent + ' <chart:data-point chart:repeated="1">' + LE
)
else
begin
AppendToStream(AChartStream, Format(
indent + ' <chart:data-point chart:style-name="ch%d" />' + LE, // ToDo: could contain "chart:repeated"
[ dpStyleID ]
));
inc(dpStyleID);
end;
end;
end;
AppendToStream(AChartStream,
indent + '</chart:series>' + LE
);
@ -3386,6 +3505,15 @@ begin
end;
end;
// Data point styles
for i := 0 to series.DataPointStyles.Count - 1 do
begin
inc(AStyleID);
AppendToStream(AStyleStream,
GetChartSeriesDataPointStyleAsXML(AChart, ASeriesIndex, i, AStyleIndent, AStyleID)
);
end;
// Next style
inc(AStyleID);
end;

29
components/fpspreadsheet/source/visual/fpspreadsheetchart.pas
View File

@ -53,6 +53,7 @@ type
FTitleCol, FTitleRow: Cardinal;
FTitleSheetName: String;
FCyclicX: Boolean;
FDataPointColors: array of TsColor;
function GetRange(AIndex: TsXYLRange): String;
function GetTitle: String;
function GetWorkbook: TsWorkbook;
@ -82,6 +83,7 @@ type
procedure SetXRange(XIndex: Integer;ARange: TsChartRange);
procedure SetYRange(YIndex: Integer; ARange: TsChartRange);
procedure SetTitleAddr(Addr: TsChartCellAddr);
procedure UseDataPointColors(ASeries: TsChartSeries);
property PointsNumber: Cardinal read FPointsNumber;
property Workbook: TsWorkbook read GetWorkbook;
public
@ -481,6 +483,8 @@ begin
end;
FCurItem.Color := clTAColor; // = clDefault
if AIndex <= High(FDataPointColors) then
FCurItem.Color := FDataPointColors[AIndex];
if FRanges[rngColor] <> nil then
begin
GetXYItem(rngColor, 0, AIndex, dummyNumber, dummyString);
@ -537,6 +541,7 @@ end;
@param APointIndex Index of the data point for which the data are required
@param ANumber (output) x or y coordinate of the data point
@param AText Data point marks label text
@param AColor Individual data point color
-------------------------------------------------------------------------------}
procedure TsWorkbookChartSource.GetXYItem(ARangeIndex:TsXYLRange;
AListIndex, APointIndex: Integer; out ANumber: Double; out AText: String);
@ -891,6 +896,27 @@ begin
SetRangeFromChart(rngY, YIndex, ARange);
end;
procedure TsWorkbookChartSource.UseDataPointColors(ASeries: TsChartSeries);
var
datapointStyle: TsChartDataPointStyle;
i: Integer;
begin
if ASeries = nil then
begin
SetLength(FDataPointColors, 0);
exit;
end;
SetLength(FDataPointColors, ASeries.DataPointStyles.Count);
for i := 0 to High(FDataPointColors) do
begin
datapointStyle := TsChartDataPointStyle(ASeries.DatapointStyles[i]);
FDataPointColors[i] := clTAColor;
if (dataPointStyle <> nil) and (datapointStyle.Background.Style = cfsSolid) then
FDataPointColors[i] := Convert_sColor_to_Color(dataPointStyle.Background.Color);
end;
end;
{@@ ----------------------------------------------------------------------------
Setter method for the WorkbookSource
-------------------------------------------------------------------------------}
@ -1038,6 +1064,9 @@ begin
if not ASeries.FillColorRange.IsEmpty then src.SetColorRange(ASeries.FillColorRange);
src.SetTitleAddr(ASeries.TitleAddr);
// Copy individual data point colors to the chart series.
src.UseDataPointColors(ASeries);
if stackable then begin
calcSrc := TCalculatedChartSource.Create(self);
calcSrc.Origin := src;