paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fpspreadsheet: Chart link supports background colors, legend and axes.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9035 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2023-11-21 21:59:26 +00:00
parent c256e13a50
commit db823f8fcf
2 changed files with 248 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -30,7 +30,8 @@ type
procedure ReadChartAxisGrid(ANode, AStyleNode: TDOMNode; AChart: TsChart; Axis: TsChartAxis);
procedure ReadChartAxisProps(ANode, AStyleNode: TDOMNode; AChart: TsChart);
procedure ReadChartAxisStyle(AStyleNode: TDOMNode; AChart: TsChart; Axis: TsChartAxis);
procedure ReadChartBackgroundStyle(AStyleNode: TDOMNode; AChart: TsChart);
procedure ReadChartBackgroundProps(ANode, AStyleNode: TDOMNode; AChart: TsChart; AElement: TsChartFillElement);
procedure ReadChartBackgroundStyle(AStyleNode: TDOMNode; AChart: TsChart; AElement: TsChartFillElement);
procedure ReadChartCellAddr(ANode: TDOMNode; ANodeName: String; ACellAddr: TsChartCellAddr);
procedure ReadChartCellRange(ANode: TDOMNode; ANodeName: String; ARange: TsChartRange);
procedure ReadChartProps(AChartNode, AStyleNode: TDOMNode; AChart: TsChart);
@ -106,7 +107,7 @@ type
procedure WriteChartLegend(AChartStream, AStyleStream: TStream;
AChartIndent, AStyleIndent: Integer; AChart: TsChart; var AStyleID: Integer);
procedure WriteChartNumberStyles(AStream: TStream;
AIndent: Integer; AChart: TsChart);
AIndent: Integer; {%H-}AChart: TsChart);
procedure WriteChartPlotArea(AChartStream, AStyleStream: TStream;
AChartIndent, AStyleIndent: Integer; AChart: TsChart; var AStyleID: Integer);
procedure WriteChartSeries(AChartStream, AStyleStream: TStream;
@ -358,16 +359,19 @@ end;
procedure TsSpreadOpenDocChartReader.GetChartFillProps(ANode: TDOMNode;
AChart: TsChart; AFill: TsChartFill);
var
{%H-}nodeName: String;
s: String;
sc: String;
sn: String;
opacity: Double;
begin
nodeName := ANode.NodeName;
s := GetAttrValue(ANode, 'draw:fill');
case s of
'none':
AFill.Style := cfsNoFill;
'solid':
'', 'solid':
begin
AFill.Style := cfsSolid;
sc := GetAttrValue(ANode, 'draw:fill-color');
@ -402,6 +406,7 @@ end;
procedure TsSpreadOpenDocChartReader.GetChartLineProps(ANode: TDOMNode;
AChart: TsChart; ALine: TsChartLine);
var
{%H-}nodeName: String;
s: String;
sn: String;
sc: String;
@ -410,33 +415,37 @@ var
value: Double;
rel: Boolean;
begin
nodeName := ANode.NodeName;
s := GetAttrValue(ANode, 'draw:stroke');
if s = 'none' then
ALine.Style := clsNoLine
else
begin
if s = 'solid' then
ALine.Style := clsSolid
else
if s = 'dash' then
begin
sn := GetAttrValue(ANode, 'draw:stroke-dash');
if sn <> '' then
ALine.Style := AChart.LineStyles.IndexOfName(UnASCIIName(sn));
end;
sc := 'draw:stroke-color';
if sc <> '' then
ALine.Color := HTMLColorStrToColor(sc);
sw := 'draw:stroke-width';
if (sw <> '') and EvalLengthStr(sw, value, rel) then
ALine.Width := value;
so := 'draw:stroke-opacity';
if (so <> '') and TryPercentStrToFloat(so, value) then
ALine.Transparency := 1.0 - value*0.01;
case s of
'none':
ALine.Style := clsNoLine;
'solid':
ALine.Style := clsSolid;
'dash':
begin
sn := GetAttrValue(ANode, 'draw:stroke-dash');
if sn <> '' then
ALine.Style := AChart.LineStyles.IndexOfName(UnASCIIName(sn));
end;
end;
sc := GetAttrValue(ANode, 'svg:stroke-color');
if sc = '' then
sc := GetAttrValue(ANode, 'draw:stroke-color');
if sc <> '' then
ALine.Color := HTMLColorStrToColor(sc);
sw := GetAttrValue(ANode, 'svg:stroke-width');
if sw = '' then
sw := GetAttrValue(ANode, 'draw:stroke-width');
if (sw <> '') and EvalLengthStr(sw, value, rel) then
ALine.Width := value;
so := 'draw:stroke-opacity';
if (so <> '') and TryPercentStrToFloat(so, value) then
ALine.Transparency := 1.0 - value*0.01;
end;
(*
@ -508,10 +517,13 @@ end;
procedure TsSpreadOpenDocChartReader.ReadChartAxisGrid(ANode, AStyleNode: TDOMNode;
AChart: TsChart; Axis: TsChartAxis);
var
nodeName: String;
s: String;
styleNode: TDOMNode;
styleNode, subNode: TDOMNode;
grid: TsChartLine;
begin
nodeName := ANode.NodeName;
s := GetAttrValue(ANode, 'chart:class');
case s of
'major': grid := Axis.MajorGridLines;
@ -519,15 +531,28 @@ begin
else exit;
end;
// Set default
grid.Style := clsSolid;
s := GetAttrValue(ANode, 'chart:style-name');
styleNode := FindStyleNode(AStyleNode, s);
GetChartLineProps(styleNode, AChart, grid);
if styleNode <> nil then
begin
subnode := styleNode.FirstChild;
while (subNode <> nil) do
begin
nodeName := subNode.NodeName;
if nodeName = 'style:graphic-properties' then
GetChartLineProps(subNode, AChart, grid);
subNode := subNode.NextSibling;
end;
end;
end;
procedure TsSpreadOpenDocChartReader.ReadChartAxisProps(ANode, AStyleNode: TDOMNode;
AChart: TsChart);
var
s, styleName, nodeName: String;
s, nodeName: String;
styleNode, subNode: TDOMNode;
axis: TsChartAxis;
begin
@ -540,6 +565,13 @@ begin
else raise Exception.Create('Unknown chart axis.');
end;
// Default values
axis.Title.Caption := '';
axis.MajorGridLines.Style := clsNoLine;
axis.MinorGridLines.Style := clsNoLine;
axis.MajorTicks := [catOutside];
axis.MinorTicks := [catOutside];
s := GetAttrValue(ANode, 'chart:style-name');
styleNode := FindStyleNode(AStyleNode, s);
ReadChartAxisStyle(styleNode, AChart, axis);
@ -598,7 +630,7 @@ begin
Axis.Logarithmic := true;
s := GetAttrValue(AStyleNode, 'chart:minimum');
if (s = 'true') and TryStrToFloat(s, value, FPointSeparatorSettings) then
if (s <> '') and TryStrToFloat(s, value, FPointSeparatorSettings) then
begin
Axis.Min := value;
Axis.AutomaticMin := false;
@ -606,7 +638,7 @@ begin
Axis.AutomaticMin := true;
s := GetAttrValue(AStyleNode, 'chart:maximum');
if (s = 'true') and TryStrToFloat(s, value, FPointSeparatorSettings) then
if (s <> '') and TryStrToFloat(s, value, FPointSeparatorSettings) then
begin
Axis.Max := value;
Axis.AutomaticMax := false;
@ -661,8 +693,19 @@ begin
end;
end;
procedure TsSpreadOpenDocChartReader.ReadChartBackgroundProps(ANode, AStyleNode: TDOMNode;
AChart: TsChart; AElement: TsChartFillElement);
var
s: String;
styleNode: TDOMNode;
begin
s := GetAttrValue(ANode, 'chart:style-name');
styleNode := FindStyleNode(AStyleNode, s);
ReadChartBackgroundStyle(styleNode, AChart, AElement);
end;
procedure TsSpreadOpenDocChartReader.ReadChartBackgroundStyle(AStyleNode: TDOMNode;
AChart: TsChart);
AChart: TsChart; AElement: TsChartFillElement);
var
nodeName: String;
begin
@ -672,8 +715,8 @@ begin
nodeName := AStyleNode.NodeName;
if nodeName = 'style:graphic-properties' then
begin
GetChartLineProps(AStyleNode, AChart, AChart.Border);
GetChartFillProps(AStyleNode, AChart, AChart.Background);
GetChartLineProps(AStyleNode, AChart, AElement.Border);
GetChartFillProps(AStyleNode, AChart, AElement.Background);
end;
AStyleNode := AStyleNode.NextSibling;
end;
@ -810,7 +853,7 @@ var
begin
styleName := GetAttrValue(AChartNode, 'chart:style-name');
styleNode := FindStyleNode(AStyleNode, styleName);
ReadChartBackgroundStyle(styleNode, AChart);
ReadChartBackgroundStyle(styleNode, AChart, AChart);
end;
procedure TsSpreadOpenDocChartReader.ReadChartPlotAreaProps(ANode, AStyleNode: TDOMNode;
@ -824,6 +867,10 @@ begin
styleNode := FindStyleNode(AStyleNode, styleName);
ReadChartPlotAreaStyle(styleNode, AChart);
// Defaults
AChart.PlotArea.Border.Style := clsNoLine;
AChart.Floor.Border.Style := clsNoLine;
ANode := ANode.FirstChild;
while ANode <> nil do
begin
@ -833,6 +880,10 @@ begin
ReadChartAxisProps(ANode, AStyleNode, AChart);
'chart:series':
ReadChartSeriesProps(ANode, AStyleNode, AChart);
'chart:wall':
ReadChartBackgroundProps(ANode, AStyleNode, AChart, AChart.PlotArea);
'chart:floor':
ReadChartBackgroundProps(ANode, AStyleNode, AChart, AChart.Floor);
end;
ANode := ANode.NextSibling;
end;
@ -1199,7 +1250,6 @@ var
styleNode: TDOMNode;
nodeName: String;
s: String;
lp: TsChartLegendPosition;
value: Double;
rel: Boolean;
begin
@ -1379,7 +1429,6 @@ end;
Object styles.xml file. }
procedure TsSpreadOpenDocChartReader.ReadObjectHatchStyles(ANode: TDOMNode; AChart: TsChart);
var
i: Integer;
s: String;
styleName: String;
hs, hatchStyle: TsChartHatchStyle;
@ -1549,7 +1598,6 @@ var
chart: TsChart;
indent: String;
angle: Integer;
idx: Integer;
textProps: String = '';
graphProps: String = '';
chartProps: String = '';
@ -1833,7 +1881,6 @@ var
strokeStr: String = '';
widthStr: String = '';
colorStr: String = '';
s: String;
linestyle: TsChartLineStyle;
begin
if ALine.Style = clsNoLine then
@ -1910,7 +1957,6 @@ function TsSpreadOpenDocChartWriter.GetChartRegressionEquationStyleAsXML(
AChart: TsChart; AEquation: TsRegressionEquation; AIndent, AStyleID: Integer): String;
var
indent: String;
idx: Integer;
numStyle: String = 'N0';
chartprops: String = '';
lineprops: String = '';
@ -1954,10 +2000,6 @@ var
indent: String;
chartProps: String = '';
graphProps: String = '';
textProps: String = '';
lineProps: String = '';
fillProps: String = '';
labelSeparator: String = '';
begin
Result := '';
series := AChart.Series[ASeriesIndex] as TsScatterSeries;

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

@ -19,7 +19,8 @@ interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
// TChart
TATypes, TATextElements, TACustomSource, TAGraph,
TATypes, TATextElements, TACustomSource,
TAChartAxisUtils, TAChartAxis, TALegend, TAGraph,
// FPSpreadsheet Visual
fpSpreadsheetCtrls, fpSpreadsheetGrid, fpsVisualUtils,
// FPSpreadsheet
@ -97,7 +98,10 @@ type
procedure ClearChart;
function GetWorkbookChart: TsChart;
procedure PopulateChart;
procedure UpdateChartAxis(AWorkbookAxis: TsChartAxis);
procedure UpdateChartBackground(AWorkbookChart: TsChart);
procedure UpdateChartBrush(AWorkbookFill: TsChartFill; ABrush: TBrush);
procedure UpdateChartLegend(AWorkbookLegend: TsChartLegend; ALegend: TChartLegend);
procedure UpdateChartPen(AWorkbookLine: TsChartLine; APen: TPen);
procedure UpdateChartTitle(AWorkbookTitle: TsChartText; AChartTitle: TChartTitle);
@ -535,15 +539,33 @@ begin
end;
procedure TsWorkbookChartLink.ClearChart;
var
i, j: Integer;
begin
if FChart = nil then
exit;
// Clear the title
FChart.Title.Text.Clear;
// Clear the footer
FChart.Foot.Text.Clear;
// Clear the series
FChart.ClearSeries;
// Clear the axes
for i := FChart.AxisList.Count-1 downto 0 do
begin
case FChart.AxisList[i].Alignment of
calLeft, calBottom:
FChart.AxisList[i].Title.Caption := '';
calTop, calRight:
FChart.AxisList.Delete(i);
end;
for j := FChart.AxisList[i].Minors.Count-1 downto 0 do
FChart.AxisList[i].Minors.Delete(j);
end;
// Clear the title
FChart.Title.Text.Clear;
// Clear the footer
FChart.Foot.Text.Clear;
end;
function TsWorkbookChartLink.GetWorkbookChart: TsChart;
@ -591,10 +613,14 @@ begin
end;
ch := GetWorkbookChart;
UpdateChartBackground(ch);
UpdateChartTitle(ch.Title, FChart.Title);
UpdateChartTitle(ch.Subtitle, FChart.Foot);
// ...
UpdateChartLegend(ch.Legend, FChart.Legend);
UpdateChartAxis(ch.XAxis);
UpdateChartAxis(ch.YAxis);
UpdateChartAxis(ch.X2Axis);
UpdateChartAxis(ch.Y2Axis);
end;
procedure TsWorkbookChartLink.SetChart(AValue: TChart);
@ -630,6 +656,94 @@ begin
PopulateChart;
end;
procedure TsWorkbookChartLink.UpdateChartAxis(AWorkbookAxis: TsChartAxis);
var
align: TChartAxisAlignment;
axis: TChartAxis;
minorAxis: TChartMinorAxis;
begin
if AWorkbookAxis = nil then
exit;
if AWorkbookAxis = AWorkbookAxis.Chart.XAxis then
align := calBottom
else if AWorkbookAxis = AWorkbookAxis.Chart.X2Axis then
align := calTop
else if AWorkbookAxis = AWorkbookAxis.Chart.YAxis then
align := calLeft
else if AWorkbookAxis = AWorkbookAxis.Chart.Y2Axis then
align := calRight
else
raise Exception.Create('Unsupported axis alignment');
axis := FChart.AxisList.GetAxisByAlign(align);
if AWorkbookAxis.Visible and (axis = nil) then
begin
axis := FChart.AxisList.Add;
axis.Alignment := align;
end;
if axis = nil then
exit;
// Entire axis visible?
axis.Visible := AWorkbookAxis.Visible;
// Axis title
axis.Title.Caption := AWorkbookAxis.Title.Caption;
axis.Title.Visible := true;
Convert_sFont_to_Font(AWorkbookAxis.Title.Font, axis.Title.LabelFont);
// Labels
Convert_sFont_to_Font(AWorkbookAxis.LabelFont, axis.Marks.LabelFont);
// if not AWorkbookAxis.CategoryRange.IsEmpty then --- fix me
// axis.Marks.Style := smsLabel;
// Axis line
UpdateChartPen(AWorkbookAxis.AxisLine, axis.AxisPen);
axis.AxisPen.Visible := axis.AxisPen.Style <> psClear;
// Major axis grid
UpdateChartPen(AWorkbookAxis.MajorGridLines, axis.Grid);
axis.Grid.Visible := axis.Grid.Style <> psClear;
axis.TickLength := IfThen(catOutside in AWorkbookAxis.MajorTicks, 4, 0);
axis.TickInnerLength := IfThen(catInside in AWorkbookAxis.MajorTicks, 4, 0);
axis.TickColor := axis.Grid.Color;
axis.TickWidth := axis.Grid.Width;
// Minor axis grid
if AWorkbookAxis.MinorGridLines.Style <> clsNoLine then
begin
minorAxis := axis.Minors.Add;
UpdateChartPen(AWorkbookAxis.MinorGridLines, minorAxis.Grid);
minorAxis.Grid.Visible := true;
minorAxis.Intervals.Count := AWorkbookAxis.MinorCount;
minorAxis.TickLength := IfThen(catOutside in AWorkbookAxis.MinorTicks, 2, 0);
minorAxis.TickInnerLength := IfThen(catInside in AWorkbookAxis.MinorTicks, 2, 0);
minorAxis.TickColor := minorAxis.Grid.Color;
minorAxis.TickWidth := minorAxis.Grid.Width;
end;
// Inverted?
axis.Inverted := AWorkbookAxis.Inverted;
// Logarithmic?
// to do....
// Scaling
axis.Range.UseMin := not AWorkbookAxis.AutomaticMin;
axis.Range.UseMax := not AWorkbookAxis.AutomaticMax;
axis.Range.Min := AWorkbookAxis.Min;
axis.Range.Max := AWorkbookAxis.Max;
end;
procedure TsWorkbookChartLink.UpdateChartBackground(AWorkbookChart: TsChart);
begin
FChart.Color := Convert_sColor_to_Color(AWorkbookChart.Background.Color);
FChart.BackColor := Convert_sColor_to_Color(AWorkbookChart.PlotArea.Background.Color);
UpdateChartPen(AWorkbookChart.PlotArea.Border, FChart.Frame);
FChart.Frame.Visible := AWorkbookChart.PlotArea.Border.Style <> clsNoLine;
end;
procedure TsWorkbookChartLink.UpdateChartBrush(AWorkbookFill: TsChartFill;
ABrush: TBrush);
begin
@ -645,6 +759,28 @@ begin
end;
end;
procedure TsWorkbookChartLink.UpdateChartLegend(AWorkbookLegend: TsChartLegend;
ALegend: TChartLegend);
const
LEG_POS: array[TsChartLegendPosition] of TLegendAlignment = (
laCenterRight, // lpRight
laTopCenter, // lpTop
laBottomCenter, // lpBottom
laCenterLeft // lpLeft
);
begin
if (AWorkbookLegend <> nil) and (ALegend <> nil) then
begin
Convert_sFont_to_Font(AWorkbookLegend.Font, ALegend.Font);
UpdateChartPen(AWorkbookLegend.Border, ALegend.Frame);
UpdateChartBrush(AWorkbookLegend.Background, ALegend.BackgroundBrush);
ALegend.Frame.Visible := (ALegend.Frame.Style <> psClear);
ALegend.Alignment := LEG_POS[AWorkbookLegend.Position];
ALegend.UseSidebar := not AWorkbookLegend.CanOverlapPlotArea;
ALegend.Visible := AWorkbookLegend.Visible;
end;
end;
procedure TsWorkbookChartLink.UpdateChartPen(AWorkbookLine: TsChartLine;
APen: TPen);
begin
@ -658,7 +794,20 @@ begin
clsSolid:
APen.Style := psSolid;
else // to be fixed
APen.Style := psSolid;
if (AWorkbookLine.Style in [clsDash, clsLongDash]) then
APen.Style := psDash
else
if (AWorkbookLine.Style = clsDot) then
APen.Style := psDot
else
if (AWorkbookLine.Style in [clsDashDot, clsLongDashDot]) then
APen.Style := psDashDot
else
if (AWorkbookLine.Style in [clsLongDashDotDot]) then
APen.Style := psDashDotDot
else
// to be fixed: create pattern as defined.
APen.Style := psDash;
end;
end;
end;
@ -670,14 +819,15 @@ procedure TsWorkbookChartLink.UpdateChartTitle(AWorkbookTitle: TsChartText;
begin
if (AWorkbookTitle <> nil) and (AChartTitle <> nil) then
begin
AChartTitle.Text.Text := AWorkbookTitle.Caption;
AChartTitle.Text.Clear;
AChartTitle.Text.Add(AWorkbookTitle.Caption);
AChartTitle.Visible := AWorkbookTitle.Visible;
AChartTitle.WordWrap := true;
Convert_sFont_to_Font(AWorkbookTitle.Font, AChartTitle.Font);
UpdateChartPen(AWorkbookTitle.Border, AChartTitle.Frame);
UpdateChartBrush(AWorkbookTitle.Background, AChartTitle.Brush);
AChartTitle.Font.Orientation := round(AWorkbookTitle.RotationAngle * 10);
AChartTitle.Frame.Visible := (AChartTitle.Frame.Style <> psClear);
AChartTitle.Alignment := taCenter;
end;
end;