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

fpspreadsheet: ods reader supports chart legend.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9017 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-11-08 18:33:29 +00:00
parent 2aa985a34c
commit f82f76457d
4 changed files with 148 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -26,23 +26,23 @@ begin
'col:', chart.Col, ' (+',chart.OffsetX:0:0, 'mm) ',
'width:', chart.Width:0:0, 'mm height:', chart.Height:0:0, 'mm');
Write(' Line styles: ');
Write(' LINE STYLES: ');
for j := 0 to chart.LineStyles.Count-1 do
Write('"', chart.GetLineStyle(j).Name, '" ');
WriteLn;
WriteLn (' Hatch styles: ');
WriteLn (' HATCH STYLES: ');
for j := 0 to chart.Hatches.Count-1 do
WriteLn(' "', chart.Hatches[j].Name, '" ',
WriteLn(' ', j, ': "', chart.Hatches[j].Name, '" ',
GetEnumName(TypeInfo(TsChartHatchStyle), ord(chart.Hatches[j].Style)), ' ',
'LineColor:', IntToHex(chart.Hatches[j].LineColor, 6), ' ',
'Distance:', chart.Hatches[j].LineDistance:0:0, 'mm ',
'Angle:', chart.Hatches[j].LineAngle:0:0, 'deg ',
'Filled:', chart.Hatches[j].Filled);
WriteLn (' Gradient styles: ');
WriteLn (' GRADIENT STYLES: ');
for j := 0 to chart.Gradients.Count-1 do
WriteLn(' "', chart.Gradients[j].Name, '" ',
WriteLn(' ', j, ': "', chart.Gradients[j].Name, '" ',
GetEnumName(TypeInfo(TsChartGradientStyle), ord(chart.Gradients[j].Style)), ' ',
'StartColor:', IntToHex(chart.Gradients[j].StartColor, 6), ' ',
'EndColor:', IntToHex(chart.Gradients[j].EndColor, 6), ' ',
@ -52,19 +52,35 @@ begin
'Angle:', chart.Gradients[j].Angle:0:0, 'deg ',
'CenterX:', chart.Gradients[j].CenterX*100:0:0, '% ',
'CenterY:', chart.Gradients[j].CenterY*100:0:0, '% ');
WriteLn;
WriteLn(' Chart border:');
WriteLn;
WriteLn(' CHART BORDER');
WriteLn(' Style:', chart.Border.Style,
' Width:', chart.Border.Width:0:0, 'mm',
' Color:', IntToHex(chart.Border.Color, 6),
' Transparency:', chart.Border.Transparency:0:2);
WriteLn(' Chart background:');
WriteLn;
WriteLn(' CHART BACKGROUND');
WriteLn(' Style:', GetEnumName(TypeInfo(TsChartFillStyle), ord(chart.Background.Style)),
' Color:', IntToHex(chart.background.Color, 6),
' Gradient:', chart.Background.Gradient,
' Hatch:', chart.Background.Hatch);
WriteLn;
WriteLn(' CHART LEGEND');
WriteLn(' Position: ', GetEnumName(TypeInfo(TsChartLegendPosition), ord(chart.Legend.Position)),
' CanOverlapPlotArea:', chart.Legend.CanOverlapPlotArea);
WriteLn(' Background: Style:', GetEnumName(TypeInfo(TsChartFillStyle), ord(chart.Legend.Background.Style)),
' Color:', IntToHex(chart.Legend.Background.Color, 6),
' Gradient:', chart.Legend.Background.Gradient,
' Hatch:', chart.Legend.Background.Hatch);
WriteLn(' Border: Style:', chart.Legend.Border.Style,
' Width:', chart.Legend.Border.Width:0:0, 'mm',
' Color:', IntToHex(chart.Legend.Border.Color, 6),
' Transparency:', chart.Legend.Border.Transparency:0:2);
WriteLn(' Font: "', chart.Legend.Font.FontName, '" Size:', chart.Legend.Font.Size:0:0,
' Style:', SetToString(PTypeInfo(TypeInfo(TsFontStyles)), integer(chart.Legend.Font.Style), True),
' Color:', IntToHex(chart.Legend.Font.Color, 6));
end;
finally

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

@ -252,12 +252,15 @@ type
FFont: TsFont;
FCanOverlapPlotArea: Boolean;
FPosition: TsChartLegendPosition;
FPosX, FPosY: Double;
public
constructor Create(AChart: TsChart);
destructor Destroy; override;
property CanOverlapPlotArea: Boolean read FCanOverlapPlotArea write FCanOverlapPlotArea;
property Font: TsFont read FFont write FFont;
property Position: TsChartLegendPosition read FPosition write FPosition;
property PosX: Double read FPosX write FPosX;
property PosY: Double read FPosY write FPosY;
// There is also a "legend-expansion" but this does not seem to have a visual effect in Calc.
end;

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

@ -231,6 +231,7 @@ type
{ Helper methods, public because needed by the chart reader }
function CreateXMLStream: TStream;
procedure ReadFont(ANode: TDOMNode; AFont: TsFont);
end;
{ TsSpreadOpenDocWriter }
@ -2632,6 +2633,13 @@ begin
(Workbook as TsWorkbook).CryptoInfo := cinfo;
end;
{ Reads font data from an xml node and passes the read properties to the
provided font. }
procedure TsSpreadOpenDocReader.ReadFont(ANode: TDOMNode; AFont: TsFont);
begin
ReadFont(ANode, AFont.FontName, AFont.Size, AFont.Style, AFont.Color, AFont.Position);
end;
{ Reads font data from an xml node and returns the font elements. }
procedure TsSpreadOpenDocReader.ReadFont(ANode: TDOMNode; var AFontName: String;
var AFontSize: Single; var AFontStyle: TsFontStyles; var AFontColor: TsColor;

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

@ -23,14 +23,15 @@ type
procedure GetChartFillProps(ANode: TDOMNode; AChart: TsChart; AFill: TsChartFill);
procedure GetChartLineProps(ANode: TDOMNode; AChart: TsChart; ALine: TsChartLine);
procedure ReadChartBackgroundStyle(AStyleNode: TDOMNode; AChart: TsChart);
procedure ReadChartProps(AChartNode, AStyleNode: TDOMNode; AChart: TsChart);
procedure ReadChartPlotAreaProps(ANode, AStyleNode: TDOMNode; AChart: TsChart);
procedure ReadChartLegendProps(ANode, AStyleNode: TDOMNode; AChart: TsChart);
procedure ReadChartLegendStyle(AStyleNode: TDOMNode; AChart: TsChart);
procedure ReadObjectGradientStyles(ANode: TDOMNode; AChart: TsChart);
procedure ReadObjectHatchStyles(ANode: TDOMNode; AChart: TsChart);
procedure ReadObjectLineStyles(ANode: TDOMNode; AChart: TsChart);
procedure ReadChartProps(AChartNode, AStyleNode: TDOMNode; AChart: TsChart);
protected
procedure ReadChartFiles(AStream: TStream; AFileList: String);
procedure ReadChart(AChartNode, AStyleNode: TDOMNode; AChart: TsChart);
@ -155,6 +156,7 @@ const
LE = LineEnding;
// Replaces all non-letters/numbers by their hex ASCII value surrounded by '_'
function ASCIIName(AName: String): String;
var
i: Integer;
@ -167,6 +169,7 @@ begin
Result := Result + Format('_%.2x_', [ord(AName[i])]);
end;
// Reverts the replacement done by ASCIIName.
function UnASCIIName(AName: String): String;
var
i: Integer;
@ -281,6 +284,30 @@ begin
inherited;
end;
{ Searches in the child nodes of AStyleNode for the style:style node with
the attributes style:family = chart and style:name = AStyleName. }
function TsSpreadOpenDocChartReader.FindStyleNode(AStyleNodes: TDOMNode;
AStyleName: String): TDOMNode;
var
nodeName: String;
sn, sf: String;
begin
Result := AStyleNodes.FirstChild;
while (Result <> nil) do
begin
nodeName := Result.NodeName;
if nodeName = 'style:style' then
begin
sn := GetAttrValue(Result, 'style:name');
sf := GetAttrValue(Result, 'style:family');
if (sf = 'chart') and (sn = AStyleName) then
exit;
end;
Result := Result.NextSibling;
end;
Result := nil;
end;
{ AFiles contains a sorted, comma-separated list of all files
belonging to each chart. }
procedure TsSpreadOpenDocChartReader.AddChartFiles(AFileList: String);
@ -339,6 +366,7 @@ var
sn: String;
sc: String;
sw: String;
so: String;
value: Double;
rel: Boolean;
begin
@ -354,16 +382,20 @@ begin
begin
sn := GetAttrValue(ANode, 'draw:stroke-dash');
if sn <> '' then
ALine.Style := AChart.LineStyles.IndexOfName(UnAsciiName(sn));
ALine.Style := AChart.LineStyles.IndexOfName(UnASCIIName(sn));
end;
sc := 'draw:stroke-color';
if sc <> '' then
ALine.Color := HTMLColorStrToColor(sc);
sw := 'draw:strike-width';
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;
end;
end;
@ -391,6 +423,7 @@ procedure TsSpreadOpenDocChartReader.ReadChart(AChartNode, AStyleNode: TDOMNode;
AChart: TsChart);
var
nodeName: String;
node: TDOMNode;
begin
AChartNode := AChartNode.FirstChild.FirstChild; // --> chart:chart
while (AChartNode <> nil) do
@ -399,6 +432,17 @@ begin
if nodeName = 'chart:chart' then
begin
ReadChartProps(AChartNode, AStyleNode, AChart);
node := AChartNode.FirstChild;
while (node <> nil) do
begin
nodeName := node.NodeName;
if nodeName = 'chart:plot-area' then
ReadChartPlotAreaProps(node, AStyleNode, AChart)
else
if nodeName = 'chart:legend' then
ReadChartLegendProps(node, AStyleNode, AChart);
node := node.NextSibling;
end;
end;
AChartNode := AChartNode.NextSibling;
end;
@ -422,28 +466,6 @@ begin
end;
end;
function TsSpreadOpenDocChartReader.FindStyleNode(AStyleNodes: TDOMNode;
AStyleName: String): TDOMNode;
var
nodeName: String;
sn, sf: String;
begin
Result := AStyleNodes.FirstChild;
while (Result <> nil) do
begin
nodeName := Result.NodeName;
if nodeName = 'style:style' then
begin
sn := GetAttrValue(Result, 'style:name');
sf := GetAttrValue(Result, 'style:family');
if (sf = 'chart') and (sn = AStyleName) then
exit;
end;
Result := Result.NextSibling;
end;
Result := nil;
end;
procedure TsSpreadOpenDocChartReader.ReadChartProps(AChartNode, AStyleNode: TDOMNode;
AChart: TsChart);
var
@ -455,6 +477,70 @@ begin
ReadChartBackgroundStyle(styleNode, AChart);
end;
procedure TsSpreadOpenDocChartReader.ReadChartPlotAreaProps(ANode, AStyleNode: TDOMNode;
AChart: TsChart);
begin
end;
procedure TsSpreadOpenDocChartReader.ReadChartLegendProps(ANode, AStyleNode: TDOMNode;
AChart: TsChart);
var
styleName: String;
styleNode: TDOMNode;
s: String;
lp: TsChartLegendPosition;
value: Double;
rel: Boolean;
begin
styleName := GetAttrValue(ANode, 'chart:style-name');
styleNode := FindStyleNode(AStyleNode, styleName);
ReadChartLegendStyle(styleNode, AChart);
s := GetAttrValue(ANode, 'chart:legend-position');
if s <> '' then
for lp in TsChartLegendPosition do
if s = LEGEND_POSITION[lp] then
begin
AChart.Legend.Position := lp;
break;
end;
s := GetAttrValue(ANode, 'svg:x');
if (s <> '') and EvalLengthStr(s, value, rel) then
if not rel then
AChart.Legend.PosX := value;
s := GetAttrValue(ANode, 'svg:y');
if (s <> '') and EvalLengthStr(s, value, rel) then
if not rel then
AChart.Legend.PosY := value;
s := GetAttrValue(ANode, 'loext:overlay');
AChart.Legend.CanOverlapPlotArea := (s = 'true');
end;
procedure TsSpreadOpenDocChartReader.ReadChartLegendStyle(AStyleNode: TDOMNode;
AChart: TsChart);
var
nodeName: String;
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, AChart.Legend.Border);
GetChartFillProps(AStyleNode, AChart, AChart.Legend.Background);
end;
'style:text-properties':
TsSpreadOpenDocReader(Reader).ReadFont(AStyleNode, AChart.Legend.Font);
end;
AStyleNode := AStyleNode.NextSibling;
end;
end;
procedure TsSpreadOpenDocChartReader.ReadChartFiles(AStream: TStream;
AFileList: String);
var