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

fpspreadsheet: More styles (axes, legend)

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8976 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-10-23 22:18:31 +00:00
parent f2323fdf82
commit 3c41492eb0
4 changed files with 267 additions and 92 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
components/fpspreadsheet/examples/other/chart/write_chart_demo.lpr
View File

@ -22,37 +22,32 @@ begin
sh1.WriteNumber(i, 1, sin(i-1));
end;
ch := b.AddChart(sh1, 4, 4, 125, 95);
ch := b.AddChart(sh1, 4, 4, 160, 100);
ser := TsLineSeries.Create(ch);
ser.SetTitleAddr(0, 1);
ser.SetLabelRange(1, 0, 7, 0);
ser.SetYRange(1, 1, 7, 1);
ch.Background.Style := fsSolidFill;
ch.Border.Style := clsSolid;
ch.PlotArea.Background.Style := fsSolidFill;
{$IFDEF DARK_MODE}
ch.Background.FgColor := scBlack;
ch.Background.Style := fsSolidFill;
ch.Border.Color := scWhite;
ch.Border.Style := clsSolid;
ch.PlotArea.Background.Style := fsSolidFill;
ch.PlotArea.Background.FgColor := $1F1F1F;
{$ELSE}
ch.Background.FgColor := scWhite;
ch.Background.Style := fsSolidFill;
ch.Border.Color := scBlack;
ch.Border.Style := clsSolid;
ch.PlotArea.Background.Style := fsSolidFill;
ch.PlotArea.Background.FgColor := $F0F0F0;
{$ENDIF}
ch.XAxis.ShowLabels := true;
ch.XAxis.LabelFont.Size := 8;
ch.XAxis.LabelFont.Color := scRed;
ch.XAxis.LabelFont.Style := [fssStrikeout];
ch.XAxis.AxisLine.Color := scRed;
ch.XAxis.CaptionFont.Color := scRed;
ch.XAxis.CaptionFont.Size := 12;
ch.XAxis.Inverted := true;
ch.YAxis.ShowLabels := true;
ch.YAxis.LabelFont.Size := 8;
@ -72,6 +67,13 @@ begin
ch.YAxis.MajorGridLines.Style := clsSolid;
ch.YAxis.MinorGridLines.Style := clsSolid;
ch.Legend.Font.Size := 20;
ch.Legend.Font.Color := scGreen;
ch.Legend.Border.Width := 3;
ch.Legend.Border.Color := scRed;
ch.Legend.Background.FgColor := scYellow;
ch.Legend.Background.Style := fsSolidFill;
// 2nd sheet
sh2 := b.AddWorksheet('test2');

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

@ -1,4 +1,4 @@
unit fpschart;
unit fpsChart;
{$mode objfpc}{$H+}
{$modeswitch advancedrecords}
@ -24,6 +24,10 @@ var
clsLongDashDot: Integer = -1;
clsLongDashDotDot: Integer = -1;
const
DEFAULT_CHART_LINEWIDTH = 0.75; // pts
DEFAULT_CHART_FONT = 'Arial';
type
TsChart = class;
@ -160,7 +164,13 @@ type
property ShowLabels: Boolean read FShowLabels write FShowLabels;
end;
TsChartLegend = class(TsChartText)
TsChartLegend = class(TsChartFillElement)
private
FFont: TsFont;
public
constructor Create(AChart: TsChart);
destructor Destroy; override;
property Font: TsFont read FFont write FFont;
end;
TsChartAxisLink = (alPrimary, alSecondary);
@ -329,10 +339,6 @@ type
implementation
const
DEFAULT_LINE_WIDTH = 0.75; // pts
DEFAULT_FONT = 'Arial';
{ TsChartLineStyle }
function TsChartLineStyle.GetID: String;
@ -398,7 +404,7 @@ begin
FBackground.FgColor := scWhite;
FBorder := TsChartLine.Create;
FBorder.Style := clsSolid;
FBorder.Width := PtsToMM(DEFAULT_LINE_WIDTH);
FBorder.Width := PtsToMM(DEFAULT_CHART_LINEWIDTH);
FBorder.Color := scBlack;
end;
@ -417,7 +423,6 @@ begin
inherited Create(AChart);
FShowCaption := true;
FFont := TsFont.Create;
FFont.FontName := DEFAULT_FONT;
FFont.Size := 10;
FFont.Style := [];
FFont.Color := scBlack;
@ -440,13 +445,11 @@ begin
FAutomaticMinorSteps := true;
FCaptionFont := TsFont.Create;
FCaptionFont.FontName := DEFAULT_FONT;
FCaptionFont.Size := 10;
FCaptionFont.Style := [];
FCaptionFont.Color := scBlack;
FLabelFont := TsFont.Create;
FLabelFont.FontName := DEFAULT_FONT;
FLabelFont.Size := 9;
FLabelFont.Style := [];
FLabelFont.Color := scBlack;
@ -460,27 +463,27 @@ begin
FAxisLine := TsChartLine.Create;
FAxisLine.Color := scBlack;
FAxisLine.Style := clsSolid;
FAxisLine.Width := PtsToMM(DEFAULT_LINE_WIDTH);
FAxisLine.Width := PtsToMM(DEFAULT_CHART_LINEWIDTH);
FMajorTickLines := TsChartLine.Create;
FMajorTickLines.Color := scBlack;
FMajorTickLines.Style := clsSolid;
FMajorTickLines.Width := PtsToMM(DEFAULT_LINE_WIDTH);
FMajorTickLines.Width := PtsToMM(DEFAULT_CHART_LINEWIDTH);
FMinorTickLines := TsChartLine.Create;
FMinorTickLines.Color := scBlack;
FMinorTickLines.Style := clsSolid;
FMinorTickLines.Width := PtsToMM(DEFAULT_LINE_WIDTH);
FMinorTickLines.Width := PtsToMM(DEFAULT_CHART_LINEWIDTH);
FMajorGridLines := TsChartLine.Create;
FMajorGridLines.Color := scSilver;
FMajorGridLines.Style := clsSolid;
FMajorGridLines.Width := PtsToMM(DEFAULT_LINE_WIDTH);
FMajorGridLines.Width := PtsToMM(DEFAULT_CHART_LINEWIDTH);
FMinorGridLines := TsChartLine.Create;
FMinorGridLines.Color := scSilver;
FMinorGridLines.Style := clsDot;
FMinorGridLines.Width := PtsToMM(DEFAULT_LINE_WIDTH);
FMinorGridLines.Width := PtsToMM(DEFAULT_CHART_LINEWIDTH);
end;
destructor TsChartAxis.Destroy;
@ -496,6 +499,23 @@ begin
end;
{ TsChartLegend }
constructor TsChartLegend.Create(AChart: TsChart);
begin
inherited Create(AChart);
FFont := TsFont.Create;
FFont.Size := 9;
FVisible := true;
end;
destructor TsChartLegend.Destroy;
begin
FFont.Free;
inherited;
end;
{ TsChartSeries }
constructor TsChartSeries.Create(AChart: TsChart);
@ -619,12 +639,12 @@ begin
FLine := TsChartLine.Create;
FLine.Color := scBlack;
FLine.Style := clsSolid;
FLine.Width := PtsToMM(DEFAULT_LINE_WIDTH);
FLine.Width := PtsToMM(DEFAULT_CHART_LINEWIDTH);
FSymbolBorder := TsChartline.Create;
FSymbolBorder.Color := scBlack;
FSymbolBorder.Style := clsSolid;
FSymbolBorder.Width := PtsToMM(DEFAULT_LINE_WIDTH);
FSymbolBorder.Width := PtsToMM(DEFAULT_CHART_LINEWIDTH);
FSymbolFill := TsChartFill.Create;
FSymbolFill.FgColor := scWhite;

107
components/fpspreadsheet/source/common/fpschartstyles.pas
View File

@ -82,6 +82,16 @@ type
class operator = (A, B: TsChartCaptionRec): Boolean;
end;
TsChartLegendRec = record
Font: TsChartFontRec;
Border: TsChartLineRec;
Fill: TsChartFillRec;
Visible: Boolean;
procedure FromChart(AChart: TsChart);
procedure ToChart(AChart: TsChart);
class operator = (A, B: TsChartLegendRec): Boolean;
end;
{----------------------------------------------------------------------------}
TsChartStyle = class
@ -131,6 +141,15 @@ type
property CaptionType: TsChartCaptionType read FCaptionType write FCaptionType;
end;
TsChartLegendStyle = class(TsChartStyle)
private
FLegend: TsChartLegendRec;
public
procedure ApplyToChart(AChart: TsChart);
procedure ExtractFromChart(AChart: TsChart);
property Legend: TsChartLegendRec read FLegend write FLegend;
end;
{ ---------------------------------------------------------------------------}
TsChartStyleList = class(TFPList)
@ -141,10 +160,12 @@ type
procedure AddChartAxisStyle(AChart: TsChart; AType: TsChartAxisType);
procedure AddChartBackgroundStyle(AChart: TsChart; AType: TsChartBackgroundType);
procedure AddChartCaptionStyle(AChart: TsChart; AType: TsChartCaptionType);
procedure AddChartLegendStyle(AChart: TsChart);
procedure Clear;
function FindChartAxisStyle(AChart: TsChart; AType: TsChartAxisType): Integer;
function FindChartBackgroundStyle(AChart: TsChart; AType: TsChartBackgroundType): Integer;
function FindChartCaptionStyle(AChart: TsChart; AType: TsChartCaptionType): Integer;
function FindChartLegendStyle(AChart: TsChart): Integer;
end;
implementation
@ -376,6 +397,33 @@ begin
Result := (A.Font = B.Font) and (A.Visible = B.Visible);
end;
{ TsChartLegendRec }
procedure TsChartLegendRec.FromChart(AChart: TsChart);
begin
Font.FromFont(AChart.Legend.Font);
Border.FromLine(AChart.Legend.Border);
Fill.FromFill(AChart.Legend.Background);
Visible := AChart.Legend.Visible;
end;
procedure TsChartLegendRec.ToChart(AChart: TsChart);
begin
Font.ToFont(AChart.Legend.Font);
Border.ToLine(AChart.Legend.Border);
Fill.ToFill(AChart.Legend.Background);
AChart.Legend.Visible := Visible;
end;
class operator TsChartLegendRec.= (A, B: TsChartLegendRec): Boolean;
begin
Result := (A.Font = B.Font) and (A.Border = B.Border) and (A.Fill = B.Fill) and
(A.Visible = B.Visible);
end;
{==============================================================================}
{ Style classes to be listed in ChartStyleList }
{==============================================================================}
{ TsChartBackgroundstyle }
@ -477,6 +525,19 @@ begin
end;
{ TsChartLegendStyle }
procedure TsChartLegendStyle.ApplyToChart(AChart: TsChart);
begin
FLegend.ToChart(AChart);
end;
procedure TsChartLegendStyle.ExtractFromChart(AChart: TsChart);
begin
FLegend.FromChart(AChart);
end;
{ TsChartStyleList }
destructor TsChartStyleList.Destroy;
@ -493,6 +554,14 @@ begin
FindChartAxisStyle(AChart, AType);
end;
{ Adds the style of the specified type in the given chart as new style to the
style list. But only if the same style does not yet exist. }
procedure TsChartStyleList.AddChartBackgroundStyle(AChart: TsChart;
AType: TsChartBackgroundType);
begin
FindChartBackgroundStyle(AChart, AType);
end;
{ Adds the style of the specified caption in the given chart as new style to
the style list. But only if the same style does not yet exist. }
procedure TsChartStyleList.AddChartCaptionStyle(AChart: TsChart;
@ -501,12 +570,11 @@ begin
FindChartCaptionStyle(AChart, AType);
end;
{ Adds the style of the specified type in the given chart as new style to the
style list. But only if the same style does not yet exist. }
procedure TsChartStyleList.AddChartBackgroundStyle(AChart: TsChart;
AType: TsChartBackgroundType);
{ Adds the style of the legend of the given chart chart as new style to
the style list. But only if the same style does not yet exist. }
procedure TsChartStyleList.AddChartLegendStyle(AChart: TsChart);
begin
FindChartBackgroundStyle(AChart, AType);
FindChartLegendStyle(AChart);
end;
procedure TsChartStyleList.Clear;
@ -611,6 +679,35 @@ begin
newStyle.Free;
end;
{ Searches whether the legend style of the given chart is already in the
list. If not, a new style is created and added.
The type of the requested axis must be provided as parameter.
Returns the index of the style. }
function TsChartStyleList.FindChartLegendStyle(AChart: TsChart): Integer;
var
newStyle, style: TsChartLegendStyle;
i: Integer;
begin
Result := -1;
newStyle := TsChartLegendStyle.Create;
newStyle.ExtractFromChart(AChart);
for i := 0 to Count-1 do
begin
if (TsChartStyle(Items[i]) is TsChartLegendStyle) then
begin
style := TsChartLegendStyle(Items[i]);
if (style.Legend = newStyle.Legend) then
begin
Result := i;
break;
end;
end;
end;
if Result = -1 then
Result := Add(newStyle)
else
newStyle.Free;
end;
end.

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

@ -289,6 +289,7 @@ type
function GetChartAxisStyleAsXML(AChart: TsChart; AStyleIndex: Integer; AIndent: Integer): String;
function GetChartBackgroundStyleAsXML(AChart: TsChart; AStyleIndex: Integer; AIndent: Integer): String;
function GetChartCaptionStyleAsXML(AChart: TsChart; AStyleIndex: Integer; AIndent: Integer): String;
function GetChartLegendStyleAsXML(AChart: TsChart; AStyleIndex: Integer; AIndent: Integer): String;
procedure PrepareChartTable(AChart: TsChart; AWorksheet: TsBasicWorksheet);
procedure WriteChart(AStream: TStream; AChart: TsChart);
@ -5905,6 +5906,8 @@ begin
styles.AddChartCaptionStyle(chart, cctSecondaryY);
styles.AddChartCaptionStyle(chart, cctTitle);
styles.AddChartCaptionStyle(chart, cctSubTitle);
styles.AddChartLegendStyle(chart);
end;
end;
@ -6913,17 +6916,19 @@ procedure TsSpreadOpenDocWriter.WriteChartLegend(AStream: TStream; AChart: TsCha
AIndent: Integer);
var
ind: String;
legendStyleID: Integer = 400;
legendStyleIdx: Integer = 400;
begin
if (not AChart.Legend.Visible) then
exit;
legendStyleIdx := TsChartStyleList(FChartStyleList).FindChartLegendStyle(AChart);
ind := DupeString(' ', AIndent);
AppendToStream(AStream, Format(
ind + '<chart:legend chart:legend-position="end" ' +
// 'svg:x="14.875cm" svg:y="4.201cm" ' +
'style:legend-expansion="high" chart:style-name="ch%d"/>' + LE,
[ legendStyleID ]
[ legendStyleIdx + 1 ]
));
end;
@ -7011,12 +7016,10 @@ function TsSpreadOpenDocWriter.GetChartAxisStyleAsXML(
var
ind: String;
style: TsChartAxisStyle;
displayLabels: string = '';
logarithmic: String = '';
strokeColor: String = '';
styleRotationAngle: String = '';
fontSize: String = '';
fontColor: String = '';
font: TsFont;
textProps: String = '';
graphProps: String = '';
chartProps: String = '';
begin
if AStyleIndex = -1 then
begin
@ -7030,54 +7033,35 @@ begin
exit;
if style.Axis.ShowLabels then
displayLabels := 'chart:display-label="true" '
else
displayLabels := '';
chartProps := chartProps + 'chart:display-label="true" ';
if style.Axis.Logarithmic then
logarithmic := 'logarithmic="true" '
else
logarithmic := '';
chartProps := chartProps + 'chart:logarithmic="true" ';
if style.Axis.Inverted then
chartProps := chartProps + 'chart:reverse-direction="true" ';
if style.Axis.LabelRotation <> 0 then
styleRotationAngle := 'style:rotation-ange="' + IntToStr(style.Axis.LabelRotation) + '" ';
chartProps := chartProps + Format('style:rotation-angle="%d" ', [style.Axis.LabelRotation]);
strokeColor := 'svg:stroke-color="' + ColorToHTMLColorStr(style.Axis.AxisLine.Color) + '" ';
graphProps := 'svg:stroke-color="' + ColorToHTMLColorStr(style.Axis.AxisLine.Color) + '" ';
fontSize := Format('fo:font-size="%.1fpt" style:font-size-asian="%.1fpt" style:font-size-complex="%.1fpt" ',
[style.Axis.LabelFont.Size, style.Axis.LabelFont.Size, style.Axis.LabelFont.Size],
FPointSeparatorSettings
);
fontColor := 'fo:color="' + ColorToHTMLColorStr(style.Axis.LabelFont.Color) + '" ';
font := TsFont.Create;
try
style.Axis.LabelFont.ToFont(font);
textProps := WriteFontStyleXMLAsString(font);
finally
font.Free;
end;
(*
<style:style style:name="ch10" style:family="chart"
style:data-style-name="N0">
<style:chart-properties chart:display-label="true"
chart:logarithmic="false"
chart:minimum="-2" chart:maximum="2" chart:interval-major="1"
chart:interval-minor-divisor="4" chart:reverse-direction="false"
text:line-break="false" loext:try-staggering-first="false"
chart:link-data-style-to-source="true" chart:axis-position="1"/>
<style:graphic-properties svg:stroke-color="#b3b3b3"/>
<style:text-properties fo:font-size="10pt" style:font-size-asian="10pt"
style:font-size-complex="10pt"/>
*)
ind := DupeString(' ', AIndent);
Result := Format(
ind + '<style:style style:name="ch%d" style:family="chart" style:data-style-name="N0">' + LE +
ind + ' <style:chart-properties %s%s%s/>' + LE +
ind + ' <style:chart-properties %s/>' + LE +
ind + ' <style:graphic-properties %s/>' + LE +
ind + ' <style:text-properties %s%s/>' + LE +
ind + ' <style:text-properties %s/>' + LE +
ind + '</style:style>' + LE,
[ AStyleIndex + 1,
// chart-properties
displayLabels, logarithmic, styleRotationAngle,
// graphic-properties
strokeColor,
// text-properties
fontSize, fontColor
]
[ AStyleIndex + 1, chartProps, graphProps, textProps ]
);
end;
@ -7135,9 +7119,9 @@ function TsSpreadOpenDocWriter.GetChartCaptionStyleAsXML(AChart: TsChart;
var
style: TsChartCaptionStyle;
ind: String;
fontSize: String = '';
fontColor: String = '';
styleRotationAngle: String = '';
font: TsFont;
chartProps: String = '';
textProps: String = '';
begin
Result := '';
@ -7150,28 +7134,94 @@ begin
exit;
if style.Caption.Rotation <> 0 then
styleRotationAngle := Format('style:rotation-angle="%d" ', [style.Caption.Rotation]);
chartProps := chartProps + Format('style:rotation-angle="%d" ', [style.Caption.Rotation]);
fontSize := Format('fo:font-size="%.1fpt" style:font-size-asian="%.1fpt" style:font-size-complex="%.1fpt" ',
[ style.Caption.Font.Size, style.Caption.Font.Size, style.Caption.Font.Size ],
FPointSeparatorSettings
);
fontColor := Format('fo:color="%s" ', [ColorToHTMLColorStr(style.Caption.Font.Color)]);
font := TsFont.Create;
try
style.Caption.Font.ToFont(font);
textProps := WriteFontStyleXMLAsString(font);
finally
font.Free;
end;
ind := DupeString(' ', AIndent);
Result := Format(
ind + '<style:style style:name="ch%d" style:family="chart">' + LE +
ind + ' <style:chart-properties chart:auto-position="true" %s />' + LE +
ind + ' <style:text-properties %s%s/>' + LE +
ind + ' <style:text-properties %s/>' + LE +
ind + '</style:style>' + LE,
[AStyleIndex + 1,
// chart-properties
styleRotationAngle,
// text-properties
fontSize, fontColor ]
[ AStyleIndex + 1, chartProps, textProps ]
);
end;
{
<style:style style:name="ch4" style:family="chart">
<style:chart-properties chart:auto-position="true"/>
<style:graphic-properties svg:stroke-color="#b3b3b3" draw:fill="none"
draw:fill-color="#e6e6e6"/>
<style:text-properties fo:font-family="Consolas"
style:font-style-name="Standard" style:font-family-generic="modern"
style:font-pitch="fixed" fo:font-size="12pt"
style:font-size-asian="10pt" style:font-size-complex="10pt"/>
</style:style>
}
function TsSpreadOpenDocWriter.GetChartLegendStyleAsXML(AChart: TsChart;
AStyleIndex: Integer; AIndent: Integer): String;
var
ind: String;
style: TsChartLegendStyle;
font: TsFont;
textProps: String = '';
graphProps: String = '';
begin
Result := '';
if AStyleIndex = -1 then
exit;
style := TsChartLegendStyle(FChartStyleList[AStyleIndex]);
if not style.Legend.Visible then
exit;
if style.Legend.Border.Style = clsNoLine then
graphProps := 'draw:stroke="none" '
else
graphProps := Format('svg:stroke-color="%s" svg:stroke-width="%.1fmm" ',
[ColorToHTMLColorStr(style.Legend.Border.Color), style.Legend.Border.Width],
FPointSeparatorSettings);
if style.Legend.Fill.Style = fsNoFill then
graphProps := graphProps + 'draw:fill="none" '
else
graphProps := graphProps + Format('draw:fill="solid" draw:fill-color="%s" ',
[ColorToHTMLColorStr(style.Legend.Fill.FgColor)]);;
font := TsFont.Create;
try
style.Legend.Font.ToFont(font);
textProps := WriteFontStyleXMLAsString(font);
finally
font.Free;
end;
ind := DupeString(' ', AIndent);
Result := Format(
ind + '<style:style style:name="ch%d" style:family="chart">' + LE +
ind + ' <style:chart-properties />' + LE +
ind + ' <style:graphic-properties %s/>' + LE +
ind + ' <style:text-properties %s/>' + LE +
ind + '</style:style>' + LE,
[
AStyleIndex + 1,
// chart-properties
//...
// graphic-properties
graphProps,
// text-properties
textProps
]);
end;
{ To do: The list of styles must be updated to the real chart element settings. }
procedure TsSpreadOpenDocWriter.WriteChartStyles(AStream: TStream;
AChart: TsChart; AIndent: Integer);
@ -7190,6 +7240,7 @@ var
y2AxisCaptionStyleIdx: Integer;
titleCaptionStyleIdx: Integer;
subtitleCaptionStyleIdx: Integer;
legendStyleIdx: Integer;
begin
backGrStyleIdx := TsChartStyleList(FChartStyleList).FindChartBackgroundStyle(AChart, cbtBackground);
wallStyleIdx := TsChartStyleList(FChartStyleList).FindChartBackgroundStyle(AChart, cbtWall);
@ -7207,6 +7258,8 @@ begin
titleCaptionStyleIdx := TsChartStyleList(FChartStyleList).FindChartCaptionStyle(AChart, cctTitle);
subtitleCaptionStyleIdx := TsChartStyleList(FChartStyleList).FindChartCaptionStyle(AChart, cctSubtitle);
legendStyleIdx := TsChartStyleList(FChartStyleList).FindChartLegendStyle(AChart);
ind := DupeString(' ', AIndent);
AppendToStream(AStream,
@ -7235,12 +7288,15 @@ begin
ind + ' </style:style>' + LE +
// ch 4: style for <chart:legend> element
GetChartLegendStyleAsXML(AChart, legendStyleIdx, AIndent + 2) +
{
ind + ' <style:style style:name="ch400" style:family="chart">' + LE +
ind + ' <style:chart-properties chart:auto-position="true"/>' + LE +
ind + ' <style:graphic-properties draw:stroke="none" svg:stroke-color="#b3b3b3" ' +
'draw:fill="none" draw:fill-color="#e6e6e6"/>' + LE +
ind + ' <style:text-properties fo:font-size="10pt" style:font-size-asian="10pt" style:font-size-complex="10pt"/>' + LE +
ind + ' </style:style>' + LE +
}
// ch5: style for <chart:plot-area> element
ind + ' <style:style style:name="ch500" style:family="chart">' + LE +