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

fpspreadsheet: Support gradients in charts and writing to ods.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9009 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-11-05 00:26:04 +00:00
parent b66f052dc4
commit 077717d3f0
3 changed files with 342 additions and 68 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -24,7 +24,9 @@ var
begin
b := TsWorkbook.Create;
try
// -------------------------------------------------------------------------
// 1st sheet
// -------------------------------------------------------------------------
sheet1 := b.AddWorksheet('test1');
sheet1.WriteText(0, 1, '1+sin(x)');
sheet1.WriteText(0, 2, '1+sin(x/2)');
@ -99,9 +101,9 @@ begin
ch.PlotArea.Background.FgColor := $F0F0F0;
{$ENDIF}
// Background and wall working
ch.Background.Style := fsSolidFill;
ch.Background.Style := cfsSolid;
ch.Border.Style := clsSolid;
ch.PlotArea.Background.Style := fsSolidFill;
ch.PlotArea.Background.Style := cfsSolid;
//ch.RotatedAxes := true;
//ch.StackMode := csmStackedPercentage;
//ch.Interpolation := ciCubicSpline;
@ -154,15 +156,19 @@ begin
ch.Legend.Border.Width := 0.3; // mm
ch.Legend.Border.Color := scGray;
ch.Legend.Background.FgColor := $F0F0F0;
ch.Legend.Background.Style := fsSolidFill;
ch.Legend.Background.Style := cfsSolid;
//ch.Legend.CanOverlapPlotArea := true;
ch.Legend.Position := lpBottom;
// -------------------------------------------------------------------------
// 2nd sheet
// -------------------------------------------------------------------------
sheet2 := b.AddWorksheet('test2');
sheet2.WriteText(0, 0, 'abc');
// -------------------------------------------------------------------------
// 3rd sheet
// -------------------------------------------------------------------------
sheet3 := b.AddWorksheet('test3');
sheet3.WriteText(0, 1, 'cos(x)');
sheet3.WriteText(0, 2, 'sin(x)');
@ -173,7 +179,10 @@ begin
sheet3.WriteNumber(i, 2, sin(i-1), nfFixed, 2);
end;
// Create the chart
ch := b.AddChart(sheet3, 1, 3, 125, 95);
// Add two series
ser := TsLineSeries.Create(ch);
ser.SetTitleAddr(0, 1);
ser.SetLabelRange(1, 0, 7, 0);
@ -182,18 +191,28 @@ begin
ser.SetTitleAddr(0, 2);
ser.SetLabelRange(1, 0, 7, 0);
ser.SetYRange(1, 2, 7, 2);
// Vertical background gradient (angle = 0) from sky-blue to white:
ch.PlotArea.Background.Style := cfsGradient;
ch.PlotArea.Background.Gradient := ch.Gradients.AddLinearGradient('Sky', $F0CAA6, $FFFFFF, 1, 1, 0, 0);
// ch.PlotArea.Background.Gradient := ch.Gradients.AddAxialGradient('Sky', $F0CAA6, $FFFFFF, 1, 1, 0, 0);
// ch.PlotArea.Background.Gradient := ch.Gradients.AddEllipticGradient('Sky', $F0CAA6, $FFFFFF, 1, 1, 0, 0.5, 0.5, 45);
// ch.PlotArea.Background.Gradient := ch.Gradients.AddRadialGradient('Sky', $F0CAA6, $FFFFFF, 1, 1, 0, 0.5, 0.5);
// ch.PlotArea.Background.Gradient := ch.Gradients.AddRectangularGradient('Sky', $F0CAA6, $FFFFFF, 1, 1, 0, 0.5, 0.5, 0);
// ch.PlotArea.Background.Gradient := ch.Gradients.AddSquareGradient('Sky', $F0CAA6, $FFFFFF, 1, 1, 0, 0.5, 0.5, 0);
ch.Border.Style := clsNoLine;
ch.Title.Caption := 'HALLO';
ch.Title.Font.Size := 18;
ch.Title.Font.Style := [fssBold];
ch.Title.Visible := true;
ch.SubTitle.Caption := 'hallo';
ch.Subtitle.Visible := true;
ch.XAxis.MajorGridLines.Style := clsSolid; //NoLine;
ch.XAxis.MinorGridLines.Style := clsNoLine;
ch.YAxis.MajorGridLines.Style := clsNoLine;
ch.YAxis.MinorGridLines.Style := clsNoLine;
ch.YAxis.CaptionRotation := 0;
ch.XAxis.CaptionFont.Size := 18;
ch.YAxis.CaptionFont.Size := 18;
ch.YAxis.CaptionRotation := 90;
ch.XAxis.CaptionFont.Size := 14;
ch.YAxis.CaptionFont.Size := 14;
ch.XAxis.LabelFont.Style := [fssItalic];
ch.YAxis.LabelFont.Style := [fssItalic];
ch.YAxis.MajorTicks := [catInside, catOutside];

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

@ -42,10 +42,57 @@ type
Transparency: Double; // in percent
end;
TsChartGradientStyle = (cgsLinear, cgsAxial, cgsRadial, cgsElliptic, cgsSquare, cgsRectangular);
TsChartGradient = class
Name: String;
Style: TsChartGradientStyle;
StartColor: TsColor;
EndColor: TsColor;
StartIntensity: Double; // 0.0 ... 1.0
EndIntensity: Double; // 0.0 ... 1.0
Border: Double; // 0.0 ... 1.0
CenterX, CenterY: Double; // 0.0 ... 1.0
Angle: Integer; // degrees
constructor Create;
end;
TsChartGradientList = class(TFPObjectList)
private
function GetItem(AIndex: Integer): TsChartGradient;
procedure SetItem(AIndex: Integer; AValue: TsChartGradient);
function AddGradient(AName: String; AStyle: TsChartGradientStyle;
AStartColor, AEndColor: TsColor; AStartIntensity, AEndIntensity: Double;
ABorder, ACenterX, ACenterY: Double; AAngle: Integer): Integer;
public
function AddAxialGradient(AName: String; AStartColor, AEndColor: TsColor;
AStartIntensity, AEndIntensity, ABorder: Double; AAngle: Integer): Integer;
function AddEllipticGradient(AName: String; AStartColor, AEndColor: TsColor;
AStartIntensity, AEndIntensity, ABorder, ACenterX, ACenterY: Double;
AAngle: Integer): Integer;
function AddLinearGradient(AName: String; AStartColor, AEndColor: TsColor;
AStartIntensity, AEndIntensity, ABorder: Double; AAngle: Integer): Integer;
function AddRadialGradient(AName: String;
AStartColor, AEndColor: TsColor; AStartIntensity, AEndIntensity, ABorder: Double;
ACenterX, ACenterY: Double): Integer;
function AddRectangularGradient(AName: String; AStartColor, AEndColor: TsColor;
AStartIntensity, AEndIntensity: Double; ABorder, ACenterX, ACenterY: Double;
AAngle: Integer): Integer;
function AddSquareGradient(AName: String; AStartColor, AEndColor: TsColor;
AStartIntensity, AEndIntensity: Double; ABorder, ACenterX, ACenterY: Double;
AAngle: Integer): Integer;
function IndexOfName(AName: String): Integer;
function FindByName(AName: String): TsChartGradient;
property Items[AIndex: Integer]: TsChartGradient read GetItem write SetItem; default;
end;
TsChartFillStyle = (cfsNoFill, cfsSolid, cfsGradient);
TsChartFill = class
Style: TsFillStyle;
Style: TsChartFillStyle;
FgColor: TsColor;
BgColor: TsColor;
Gradient: Integer;
Transparency: Double; // 0.0 ... 1.0
end;
@ -399,6 +446,7 @@ type
FSeriesList: TsChartSeriesList;
FLineStyles: TsChartLineStyleList;
FGradients: TsChartGradientList;
function GetCategoryLabelRange: TsCellRange;
public
@ -465,6 +513,10 @@ type
{ Attributes of the series }
property Series: TsChartSeriesList read FSeriesList write FSeriesList;
{ Style lists }
property LineStyles: TsChartLineStyleList read FLineStyles;
property Gradients: TsChartGradientList read FGradients;
end;
TsChartList = class(TObjectList)
@ -478,6 +530,123 @@ type
implementation
{ TsChartGradient }
constructor TsChartGradient.Create;
begin
inherited Create;
StartIntensity := 1.0;
EndIntensity := 1.0;
end;
{ TsChartGradientList }
function TsChartGradientList.AddAxialGradient(AName: String;
AStartColor, AEndColor: TsColor; AStartIntensity, AEndIntensity, ABorder: Double;
AAngle: Integer): Integer;
begin
Result := AddGradient(AName, cgsAxial, AStartColor, AEndColor,
AStartIntensity, AEndIntensity, ABorder, 0.0, 0.0, AAngle);
end;
function TsChartGradientList.AddEllipticGradient(AName: String;
AStartColor, AEndColor: TsColor; AStartIntensity, AEndIntensity: Double;
ABorder, ACenterX, ACenterY: Double; AAngle: Integer): Integer;
begin
Result := AddGradient(AName, cgsElliptic, AStartColor, AEndColor,
AStartIntensity, AEndIntensity, ABorder, ACenterX, ACenterY, AAngle);
end;
function TsChartGradientList.AddGradient(AName: String; AStyle: TsChartGradientStyle;
AStartColor, AEndColor: TsColor; AStartIntensity, AEndIntensity: Double;
ABorder, ACenterX, ACenterY: Double; AAngle: Integer): Integer;
var
item: TsChartGradient;
begin
if AName = '' then
AName := 'G' + IntToStr(Count+1);
Result := IndexOfName(AName);
if Result = -1 then
begin
item := TsChartGradient.Create;
Result := inherited Add(item);
end else
item := Items[Result];
item.Name := AName;
item.Style := AStyle;
item.StartColor := AStartColor;
item.EndColor := AEndColor;
item.StartIntensity := AStartIntensity;
item.EndIntensity := AEndIntensity;
item.Border := ABorder;
item.Angle := AAngle;
item.CenterX := ACenterX;
item.CenterY := ACenterY;
end;
function TsChartGradientList.AddLinearGradient(AName: String;
AStartColor, AEndColor: TsColor; AStartIntensity, AEndIntensity, ABorder: Double;
AAngle: Integer): Integer;
begin
Result := AddGradient(AName, cgsLinear, AStartColor, AEndColor,
AStartIntensity, AEndIntensity, ABorder, 0.0, 0.0, AAngle);
end;
function TsChartGradientList.AddRadialGradient(AName: String;
AStartColor, AEndColor: TsColor; AStartIntensity, AEndIntensity, ABorder: Double;
ACenterX, ACenterY: Double): Integer;
begin
Result := AddGradient(AName, cgsRadial, AStartColor, AEndColor,
AStartIntensity, AEndIntensity, ABorder, ACenterX, ACenterY, 0);
end;
function TsChartGradientList.AddRectangularGradient(AName: String;
AStartColor, AEndColor: TsColor; AStartIntensity, AEndIntensity: Double;
ABorder, ACenterX, ACenterY: Double; AAngle: Integer): Integer;
begin
Result := AddGradient(AName, cgsRectangular, AStartColor, AEndColor,
AStartIntensity, AEndIntensity, ABorder, ACenterX, ACenterY, AAngle);
end;
function TsChartGradientList.AddSquareGradient(AName: String;
AStartColor, AEndColor: TsColor; AStartIntensity, AEndIntensity: Double;
ABorder, ACenterX, ACenterY: Double; AAngle: Integer): Integer;
begin
Result := AddGradient(AName, cgsSquare, AStartColor, AEndColor,
AStartIntensity, AEndIntensity, ABorder, ACenterX, ACenterY, AAngle);
end;
function TsChartGradientList.FindByName(AName: String): TsChartGradient;
var
idx: Integer;
begin
idx := IndexOfName(AName);
if idx > -1 then
Result := Items[idx]
else
Result := nil;
end;
function TsChartGradientList.GetItem(AIndex: Integer): TsChartGradient;
begin
Result := TsChartGradient(inherited Items[AIndex]);
end;
function TsChartGradientList.IndexOfName(AName: String): Integer;
begin
for Result := 0 to Count-1 do
if SameText(Items[Result].Name, AName) then
exit;
Result := -1;
end;
procedure TsChartGradientList.SetItem(AIndex: Integer; AValue: TsChartGradient);
begin
inherited Items[AIndex] := AValue;
end;
{ TsChartLineStyle }
function TsChartLineStyle.GetID: String;
@ -538,9 +707,10 @@ constructor TsChartFillElement.Create(AChart: TsChart);
begin
inherited Create(AChart);
FBackground := TsChartFill.Create;
FBackground.Style := fsSolidFill;
FBackground.Style := cfsSolid;
FBackground.BgColor := scWhite;
FBackground.FgColor := scWhite;
FBackground.Gradient := -1;
FBorder := TsChartLine.Create;
FBorder.Style := clsSolid;
FBorder.Width := PtsToMM(DEFAULT_CHART_LINEWIDTH);
@ -661,9 +831,10 @@ begin
idx := AChart.AddSeries(self);
FFill := TsChartFill.Create;
FFill.Style := fsSolidFill;
FFill.Style := cfsSolid;
FFill.FgColor := DEFAULT_SERIES_COLORS[idx mod Length(DEFAULT_SERIES_COLORS)];
FFill.BgColor := DEFAULT_SERIES_COLORS[idx mod Length(DEFAULT_SERIES_COLORS)];
FFill.Gradient := -1;
FLine := TsChartLine.Create;
FLine.Style := clsSolid;
@ -885,7 +1056,7 @@ end;
{ TsRadarSeries }
function TsRadarSeries.GetChartType: TsChartType;
begin
if Fill.Style <> fsNoFill then
if Fill.Style <> cfsNoFill then
Result := ctFilledRadar
else
Result := ctRadar;
@ -932,7 +1103,7 @@ end;
function TsRegressionEquation.DefaultFill: Boolean;
begin
Result := Fill.Style = fsNoFill;
Result := Fill.Style = cfsNoFill;
end;
function TsRegressionEquation.DefaultFont: Boolean;
@ -1012,6 +1183,8 @@ begin
clsLongDashDot := FLineStyles.Add('long dash-dot', 500, 1, 100, 1, 200, true);
clsLongDashDotDot := FLineStyles.Add('long dash-dot-dot', 500, 1, 100, 2, 200, true);
FGradients := TsChartGradientList.Create;
FSheetIndex := 0;
FRow := 0;
FCol := 0;
@ -1024,7 +1197,7 @@ begin
FPlotArea := TsChartFillElement.Create(self);
FFloor := TsChartFillElement.Create(self);
FFloor.Background.Style := fsNoFill;
FFloor.Background.Style := cfsNoFill;
FTitle := TsChartText.Create(self);
FTitle.Font.Size := 14;
@ -1074,9 +1247,10 @@ begin
FLegend.Free;
FTitle.Free;
FSubtitle.Free;
FLineStyles.Free;
FFloor.Free;
FPlotArea.Free;
FGradients.Free;
FLineStyles.Free;
inherited;
end;

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

@ -46,6 +46,12 @@ type
procedure PrepareChartTable(AChart: TsChart; AWorksheet: TsBasicWorksheet);
protected
// Object X/styles.xml
procedure WriteObjectStyles(AStream: TStream; AChart: TsChart);
procedure WriteObjectGradientStyles(AStream: TStream; AChart: TsChart; AIndent: Integer);
procedure WriteObjectLineStyles(AStream: TStream; AChart: TsChart; AIndent: Integer);
// Object X/content.xml
procedure WriteChart(AStream: TStream; AChart: TsChart);
procedure WriteChartAxis(AChartStream, AStyleStream: TStream;
AChartIndent, AStyleIndent: Integer; Axis: TsChartAxis; var AStyleID: Integer);
@ -55,7 +61,6 @@ type
AChartIndent, AStyleIndent: Integer; AChart: TsChart; var AStyleID: Integer);
procedure WriteChartNumberStyles(AStream: TStream;
AIndent: Integer; AChart: TsChart);
procedure WriteObjectStyles(AStream: TStream; AChart: TsChart);
procedure WriteChartPlotArea(AChartStream, AStyleStream: TStream;
AChartIndent, AStyleIndent: Integer; AChart: TsChart; var AStyleID: Integer);
procedure WriteChartSeries(AChartStream, AStyleStream: TStream;
@ -99,6 +104,10 @@ const
'arrow-right', 'circle', 'star', 'x', 'plus', 'asterisk'
); // unsupported: bow-tie, hourglass, horizontal-bar, vertical-bar
GRADIENT_STYLES: array[TsChartGradientStyle] of string = (
'linear', 'axial', 'radial', 'ellipsoid', 'square', 'rectangular'
);
LABEL_POSITION: array[TsChartLabelPosition] of string = (
'', 'outside', 'inside', 'center');
@ -426,20 +435,31 @@ var
fillStr: String;
fillColorStr: String;
fillOpacity: String = '';
gradient: TsChartGradient;
gradientStr: String;
begin
if AFill.Style = fsNoFill then
begin
case AFill.Style of
cfsNoFill:
Result := 'draw:fill="none" ';
exit;
end;
// To do: extend with hatched and gradient fills
cfsSolid:
begin
fillStr := 'draw:fill="solid" ';
fillColorStr := 'draw:fill-color="' + ColorToHTMLColorStr(AFill.FgColor) + '" ';
if AFill.Transparency > 0 then
fillOpacity := Format('draw:opacity="%.0f%%" ', [(1.0 - AFill.Transparency)*100], FPointSeparatorSettings);
Result := fillStr + fillColorStr + fillOpacity;
end;
cfsGradient:
begin
gradient := AChart.Gradients[AFill.Gradient];
Result := Format(
'draw:fill="gradient" ' +
'draw:fill-gradient-name="%s" ' +
'draw:gradient-step-count="0" ',
[ ASCIIName(gradient.Name) ]
);
end;
end;
end;
{
@ -1274,6 +1294,101 @@ begin
inc(AStyleID);
end;
{ Writes, for each gradient used by the chart, a node to the Object/styles xml file }
procedure TsSpreadOpenDocChartWriter.WriteObjectGradientStyles(AStream: TStream;
AChart: TsChart; AIndent: Integer);
var
i: Integer;
gradient: TsChartGradient;
style: String;
indent: String;
begin
indent := DupeString(' ', AIndent);
for i := 0 to AChart.Gradients.Count-1 do
begin
gradient := AChart.Gradients[i];
style := indent + Format(
'<draw:gradient draw:name="%s" draw:display-name="%s" ' +
'draw:style="%s" ' +
'draw:start-color="%s" draw:end-color="%s" ' +
'draw:start-intensity="%.0f%%" draw:end-intensity="%.0f%%" ' +
'draw:border="%.0f%%" ',
[ ASCIIName(gradient.Name), gradient.Name,
GRADIENT_STYLES[gradient.Style],
ColorToHTMLColorStr(gradient.StartColor), ColorToHTMLColorStr(gradient.EndColor),
gradient.StartIntensity * 100, gradient.EndIntensity * 100,
gradient.Border * 100
]
);
case gradient.Style of
cgsLinear, cgsAxial:
style := style + Format(
'draw:angle="%ddeg" ',
[ gradient.Angle ]
);
cgsElliptic, cgsSquare, cgsRectangular:
style := style + Format(
'draw:cx="%.0f%%" draw:cy="%.0f%%" draw:angle="%ddeg" ',
[ gradient.CenterX * 100, gradient.CenterY * 100, gradient.Angle ],
FPointSeparatorSettings
);
cgsRadial:
style := style + Format(
'draw:cx="%.0f%%" draw:cy="%.0f%%" ',
[ gradient.CenterX * 100, gradient.CenterY * 100 ],
FPointSeparatorSettings
);
end;
style := style + '/>' + LE;
AppendToStream(AStream, style);
end;
end;
procedure TsSpreadOpenDocChartWriter.WriteObjectLineStyles(AStream: TStream;
AChart: TsChart; AIndent: Integer);
const
LENGTH_UNIT: array[boolean] of string = ('mm', '%'); // relative to line width
DECS: array[boolean] of Integer = (1, 0); // relative to line width
var
i: Integer;
lineStyle: TsChartLineStyle;
seg1, seg2: String;
indent: String;
begin
indent := DupeString(' ', AIndent);
for i := 0 to AChart.NumLineStyles-1 do
begin
lineStyle := AChart.GetLineStyle(i);
if linestyle.Segment1.Count > 0 then
seg1 := Format('draw:dots1="%d" draw:dots1-length="%.*f%s" ', [
lineStyle.Segment1.Count,
DECS[linestyle.RelativeToLineWidth], linestyle.Segment1.Length, LENGTH_UNIT[linestyle.RelativeToLineWidth]
], FPointSeparatorSettings
)
else
seg1 := '';
if linestyle.Segment2.Count > 0 then
seg2 := Format('draw:dots2="%d" draw:dots2-length="%.*f%s" ', [
lineStyle.Segment2.Count,
DECS[linestyle.RelativeToLineWidth], linestyle.Segment2.Length, LENGTH_UNIT[linestyle.RelativeToLineWidth]
], FPointSeparatorSettings
)
else
seg2 := '';
if (seg1 <> '') or (seg2 <> '') then
AppendToStream(AStream, indent + Format(
'<draw:stroke-dash draw:name="%s" draw:display-name="%s" draw:style="round" draw:distance="%.*f%s" %s%s/>' + LE, [
ASCIIName(linestyle.Name), linestyle.Name,
DECS[linestyle.RelativeToLineWidth], linestyle.Distance, LENGTH_UNIT[linestyle.RelativeToLineWidth],
seg1, seg2
], FPointSeparatorSettings
));
end;
end;
{ Writes the chart's legend to the xml stream }
procedure TsSpreadOpenDocChartWriter.WriteChartLegend(AChartStream, AStyleStream: TStream;
AChartIndent, AStyleIndent: Integer; AChart: TsChart; var AStyleID: Integer);
@ -1346,16 +1461,9 @@ begin
end;
{ Writes the file "Object N/styles.xml" (N = 1, 2, ...) which is needed by the
charts since it defines the line dash patterns. }
charts since it defines the line dash patterns, or gradients. }
procedure TsSpreadOpenDocChartWriter.WriteObjectStyles(AStream: TStream;
AChart: TsChart);
const
LENGTH_UNIT: array[boolean] of string = ('mm', '%'); // relative to line width
DECS: array[boolean] of Integer = (1, 0); // relative to line width
var
i: Integer;
linestyle: TsChartLineStyle;
seg1, seg2: String;
begin
AppendToStream(AStream,
XML_HEADER + LE);
@ -1396,35 +1504,8 @@ begin
' <office:styles>' + LE
);
for i := 0 to AChart.NumLineStyles-1 do
begin
lineStyle := AChart.GetLineStyle(i);
if linestyle.Segment1.Count > 0 then
seg1 := Format('draw:dots1="%d" draw:dots1-length="%.*f%s" ', [
lineStyle.Segment1.Count,
DECS[linestyle.RelativeToLineWidth], linestyle.Segment1.Length, LENGTH_UNIT[linestyle.RelativeToLineWidth]
], FPointSeparatorSettings
)
else
seg1 := '';
if linestyle.Segment2.Count > 0 then
seg2 := Format('draw:dots2="%d" draw:dots2-length="%.*f%s" ', [
lineStyle.Segment2.Count,
DECS[linestyle.RelativeToLineWidth], linestyle.Segment2.Length, LENGTH_UNIT[linestyle.RelativeToLineWidth]
], FPointSeparatorSettings
)
else
seg2 := '';
if (seg1 <> '') or (seg2 <> '') then
AppendToStream(AStream, Format(
' <draw:stroke-dash draw:name="%s" draw:display-name="%s" draw:style="round" draw:distance="%.*f%s" %s%s/>' + LE, [
ASCIIName(linestyle.Name), linestyle.Name,
DECS[linestyle.RelativeToLineWidth], linestyle.Distance, LENGTH_UNIT[linestyle.RelativeToLineWidth],
seg1, seg2
]));
end;
WriteObjectLineStyles(AStream, AChart, 4);
WriteObjectGradientStyles(AStream, AChart, 4);
AppendToStream(AStream,
' </office:styles>' + LE +