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

fpspreadsheet: ods reader supports chart title and subtitle.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9018 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-11-08 21:54:29 +00:00
parent f82f76457d
commit 78fe3945ba
4 changed files with 216 additions and 84 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -65,7 +65,8 @@ begin
WriteLn(' Style:', GetEnumName(TypeInfo(TsChartFillStyle), ord(chart.Background.Style)),
' Color:', IntToHex(chart.background.Color, 6),
' Gradient:', chart.Background.Gradient,
' Hatch:', chart.Background.Hatch);
' Hatch:', chart.Background.Hatch,
' Transparency:', chart.Background.Transparency:0:2);
WriteLn;
WriteLn(' CHART LEGEND');
WriteLn(' Position: ', GetEnumName(TypeInfo(TsChartLegendPosition), ord(chart.Legend.Position)),
@ -73,7 +74,8 @@ begin
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);
' Hatch:', chart.Legend.Background.Hatch,
' Transparency:', chart.Legend.Background.Transparency);
WriteLn(' Border: Style:', chart.Legend.Border.Style,
' Width:', chart.Legend.Border.Width:0:0, 'mm',
' Color:', IntToHex(chart.Legend.Border.Color, 6),
@ -81,6 +83,40 @@ begin
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));
WriteLn;
WriteLn(' CHART TITLE');
WriteLn(' Caption: "', StringReplace(chart.Title.Caption, FPS_LINE_ENDING, '\n', [rfReplaceAll]), '"',
' Rotation: ', chart.Title.RotationAngle);
WriteLn(' Background: Style:', GetEnumName(TypeInfo(TsChartFillStyle), ord(chart.Title.Background.Style)),
' Color:', IntToHex(chart.Title.Background.Color, 6),
' Gradient:', chart.Title.Background.Gradient,
' Hatch:', chart.Title.Background.Hatch,
' Transparency:', chart.Title.Background.Transparency);
WriteLn(' Border: Style:', chart.Title.Border.Style,
' Width:', chart.Title.Border.Width:0:0, 'mm',
' Color:', IntToHex(chart.Title.Border.Color, 6),
' Transparency:', chart.Title.Border.Transparency:0:2);
WriteLn(' Font: "', chart.Title.Font.FontName, '" Size:', chart.Title.Font.Size:0:0,
' Style:', SetToString(PTypeInfo(TypeInfo(TsFontStyles)), integer(chart.Title.Font.Style), True),
' Color:', IntToHex(chart.Title.Font.Color, 6));
WriteLn;
WriteLn(' CHART SUBTITLE');
WriteLn(' Caption: "', StringReplace(chart.Subtitle.Caption, FPS_LINE_ENDING, '\n', [rfReplaceAll]), '"',
' Rotation: ', chart.Subtitle.RotationAngle);
WriteLn(' Background: Style:', GetEnumName(TypeInfo(TsChartFillStyle), ord(chart.Subtitle.Background.Style)),
' Color:', IntToHex(chart.Subtitle.Background.Color, 6),
' Gradient:', chart.Subtitle.Background.Gradient,
' Hatch:', chart.Subtitle.Background.Hatch,
' Transparency:', chart.Subtitle.Background.Transparency);
WriteLn(' Border: Style:', chart.Subtitle.Border.Style,
' Width:', chart.Subtitle.Border.Width:0:0, 'mm',
' Color:', IntToHex(chart.Subtitle.Border.Color, 6),
' Transparency:', chart.Subtitle.Border.Transparency:0:2);
WriteLn(' Font: "', chart.Subtitle.Font.FontName, '" Size:', chart.Subtitle.Font.Size:0:0,
' Style:', SetToString(PTypeInfo(TypeInfo(TsFontStyles)), integer(chart.Subtitle.Font.Style), True),
' Color:', IntToHex(chart.Subtitle.Font.Color, 6));
end;
finally

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

@ -171,6 +171,7 @@ type
FRotationAngle: Integer;
FShowCaption: Boolean;
FFont: TsFont;
FPosX, FPosY: Double;
public
constructor Create(AChart: TsChart);
destructor Destroy; override;
@ -178,6 +179,8 @@ type
property Font: TsFont read FFont write FFont;
property ShowCaption: Boolean read FShowCaption write FShowCaption;
property RotationAngle: Integer read FRotationAngle write FRotationAngle;
property PosX: Double read FPosX write FPosX;
property PosY: Double read FPosY write FPosY;
end;
TsChartAxisPosition = (capStart, capEnd, capValue);

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

@ -2670,6 +2670,10 @@ begin
end;
end;
end;
if stylename = '' then
AFontName := UnquoteStr(GetAttrValue(ANode, 'fo:font-family'));
// This case is needed for fonts in charts.
// In all other case, leave the AFontName of the input untouched.
s := GetAttrValue(ANode, 'fo:font-size');

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

@ -28,6 +28,8 @@ type
procedure ReadChartPlotAreaProps(ANode, AStyleNode: TDOMNode; AChart: TsChart);
procedure ReadChartLegendProps(ANode, AStyleNode: TDOMNode; AChart: TsChart);
procedure ReadChartLegendStyle(AStyleNode: TDOMNode; AChart: TsChart);
procedure ReadChartTitleProps(ANode, AStyleNode: TDOMNode; AChart: TsChart; ATitle: TsChartText);
procedure ReadChartTitleStyle(AStyleNode: TDOMNode; AChart: TsChart; ATitle: TsChartText);
procedure ReadObjectGradientStyles(ANode: TDOMNode; AChart: TsChart);
procedure ReadObjectHatchStyles(ANode: TDOMNode; AChart: TsChart);
@ -436,11 +438,12 @@ begin
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);
case nodeName of
'chart:plot-area': ReadChartPlotAreaProps(node, AStyleNode, AChart);
'chart:legend': ReadChartLegendProps(node, AStyleNode, AChart);
'chart:title': ReadChartTitleProps(node, AStyleNode, AChart, AChart.Title);
'chart:subtitle': ReadChartTitleProps(node, AStyleNode, AChart, AChart.Subtitle);
end;
node := node.NextSibling;
end;
end;
@ -466,81 +469,6 @@ begin
end;
end;
procedure TsSpreadOpenDocChartReader.ReadChartProps(AChartNode, AStyleNode: TDOMNode;
AChart: TsChart);
var
styleName: String;
styleNode: TDOMNode;
begin
styleName := GetAttrValue(AChartNode, 'chart:style-name');
styleNode := FindStyleNode(AStyleNode, styleName);
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
@ -625,6 +553,167 @@ begin
FreeAndNil(doc);
end;
procedure TsSpreadOpenDocChartReader.ReadChartProps(AChartNode, AStyleNode: TDOMNode;
AChart: TsChart);
var
styleName: String;
styleNode: TDOMNode;
begin
styleName := GetAttrValue(AChartNode, 'chart:style-name');
styleNode := FindStyleNode(AStyleNode, styleName);
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.ReadChartTitleProps(ANode, AStyleNode: TDOMNode;
AChart: TsChart; ATitle: TsChartText);
var
textNode, childNode: TDOMNode;
styleNode: TDOMNode;
nodeName: String;
s: String;
lp: TsChartLegendPosition;
value: Double;
rel: Boolean;
begin
s := '';
textNode := ANode.FirstChild;
while textNode <> nil do
begin
nodeName := textNode.NodeName;
if nodeName = 'text:p' then
begin
// Each 'text:p' node is a paragraph --> we insert a line break except for the first paragraph
if s <> '' then
s := s + LineEnding;
childNode := textNode.FirstChild;
while childNode <> nil do
begin
nodeName := childNode.NodeName;
case nodeName of
'#text':
s := s + childNode.TextContent;
'text:s':
s := s + ' ';
'text:line-break':
s := s + LineEnding;
// to do: Is rtf formatting supported here? (text:span)
end;
childNode := childNode.NextSibling;
end;
end;
textNode := textNode.NextSibling;
end;
ATitle.Caption := s;
s := GetAttrValue(ANode, 'svg:x');
if (s <> '') and EvalLengthStr(s, value, rel) then
if not rel then
ATitle.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, 'chart:style-name');
styleNode := FindStyleNode(AStyleNode, s);
ReadChartTitleStyle(styleNode, AChart, ATitle);
end;
procedure TsSpreadOpenDocChartReader.ReadChartTitleStyle(AStyleNode: TDOMNode;
AChart: TsChart; ATitle: TsChartText);
var
nodeName: String;
s: String;
value: Double;
begin
nodeName := AStyleNode.NodeName;
AStyleNode := AStyleNode.FirstChild;
while AStyleNode <> nil do begin
nodeName := AStyleNode.NodeName;
case nodeName of
'style:chart-properties':
begin
s := GetAttrValue(AStyleNode, 'style:rotation-angle');
if (s <> '') and TryStrToFloat(s, value, FPointSeparatorSettings) then
ATitle.RotationAngle := round(value);
end;
'style:graphic-properties':
begin
GetChartLineProps(AStyleNode, AChart, ATitle.Border);
GetChartFillProps(AStyleNode, AChart, ATitle.Background);
end;
'style:text-properties':
TsSpreadOpenDocReader(Reader).ReadFont(AStyleNode, ATitle.Font);
end;
AStyleNode := AStyleNode.NextSibling;
end;
end;
procedure TsSpreadOpenDocChartReader.ReadCharts(AStream: TStream);
var
i: Integer;
@ -2480,10 +2569,10 @@ begin
end;
(* wp:
DO NOT DELETE THIS - IT WAS A PAINT TO GET THIS, AND MAYBE IT WILL BE NEEDED
DO NOT DELETE THIS - IT WAS A PAIN TO GET THIS, AND MAYBE IT WILL BE NEEDED
LATER.
AT THE MOMENT THIS IS NOT NEEDED, IN FACT, IT IS EVEN DETRIMENTAL:
WITH THIS CODE INCLUDED, SERIES FILL ARE IGNORED AND TITLES ARE NOT CORRECT.
WITH THIS CODE INCLUDED, SERIES FILLS ARE IGNORED AND TITLES ARE NOT CORRECT.
{ Writes the chart's data table. NOTE: The chart gets its data from this table
rather than from the worksheet! }