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

fpspreadsheet: Implement writing of wall and floor chart styles.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8973 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-10-23 10:58:15 +00:00
parent ce4e36ca38
commit 240c6065b8
4 changed files with 183 additions and 86 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -34,6 +34,18 @@ begin
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.Title.Caption := 'HALLO';

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

@ -747,11 +747,11 @@ begin
FWidth := 12;
FHeight := 9;
FBackground.Style := fsNoFill;
FBorder.Style := clsNoLine;
// FBackground and FBorder already created by ancestor.
FPlotArea := TsChartFillElement.Create(self);
FFloor := TsChartFillElement.Create(self);
FFloor.Background.Style := fsNoFill;
FTitle := TsChartText.Create(self);
FTitle.Font.Size := 14;

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

@ -8,10 +8,16 @@ uses
Classes, SysUtils, fpsTypes, fpsChart;
type
TsChartStyleType = (cstBackground, cstWall, cstFloor);
TsChartStyle = class
private
FStyleType: TsChartStyleType;
public
constructor Create(AStyleType: TsChartStyleType); virtual;
procedure ApplyToChart(AChart: TsChart); virtual; abstract;
procedure ExtractFromChart(AChart: TsChart); virtual; abstract;
property StyleType: TsChartStyleType read FStyleType;
end;
TsChartBackgroundStyle = class(TsChartStyle)
@ -26,26 +32,66 @@ type
end;
TsChartStyleList = class(TFPList)
protected
public
destructor Destroy; override;
procedure AddChartBackgroundStyle(AChart: TsChart; AStyleType: TsChartStyleType);
procedure Clear;
function FindChartBackgroundStyle(AChart: TsChart): Integer;
function FindChartBackgroundStyle(AChart: TsChart; AStyleType: TsChartStyleType): Integer;
end;
implementation
{ TsChartStyle }
constructor TsChartStyle.Create(AStyleType: TsChartStyleType);
begin
FStyleType := AStyleType;
end;
{ TsChartBackgroundstyle }
procedure TsChartBackgroundStyle.ApplyToChart(AChart: TsChart);
begin
case FStyleType of
cstBackground:
begin
AChart.Background.FromRecord(FBackground);
AChart.Border.FromRecord(FBorder);
end;
cstWall:
begin
AChart.PlotArea.Background.FromRecord(FBackground);
AChart.PlotArea.Border.FromRecord(FBorder);
end;
cstFloor:
begin
AChart.Floor.Background.FromRecord(FBackGround);
AChart.Floor.Border.FromRecord(FBorder);
end;
end;
end;
procedure TsChartBackgroundStyle.ExtractFromChart(AChart: TsChart);
begin
case FStyleType of
cstBackground:
begin
FBackground := AChart.Background.ToRecord;
FBorder := AChart.Border.ToRecord;
end;
cstWall:
begin
FBackground := AChart.PlotArea.Background.ToRecord;
FBorder := AChart.PlotArea.Border.ToRecord;
end;
cstFloor:
begin
FBackground := AChart.Floor.Background.ToRecord;
FBorder := AChart.Floor.Border.ToRecord;
end;
end;
end;
{ TsChartStyleList }
@ -56,6 +102,14 @@ begin
inherited;
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;
AStyleType: TsChartStyleType);
begin
FindChartBackgroundStyle(AChart, AStyleType);
end;
procedure TsChartStyleList.Clear;
var
j: Integer;
@ -67,21 +121,24 @@ end;
{ Searches whether the background style of the specified chart is already in the
list. If not, a new style is created and added.
The type of the requested background must be provided as parameter.
Returns the index of the style. }
function TsChartStyleList.FindChartBackgroundStyle(AChart: TsChart): Integer;
function TsChartStyleList.FindChartBackgroundStyle(AChart: TsChart;
AStyleType: TsChartStyleType): Integer;
var
newStyle, style: TsChartBackgroundStyle;
i: Integer;
begin
Result := -1;
newStyle := TsChartBackgroundStyle.Create;
newStyle := TsChartBackgroundStyle.Create(AStyleType);
newStyle.ExtractFromChart(AChart);
for i := 0 to Count-1 do
begin
if (TsChartStyle(Items[i]) is TsChartBackgroundStyle) then
if (TsChartStyle(Items[i]) is TsChartBackgroundStyle) and
(TsChartStyle(Items[i]).StyleType = AStyleType) then
begin
style := TsChartBackgroundStyle(Items[i]);
if style.FBackground = newStyle.FBackground then
if (style.Background = newStyle.Background) then
begin
Result := i;
break;

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

@ -40,7 +40,7 @@ uses
fpszipper,
{$ENDIF}
fpstypes, fpsReaderWriter, fpsutils, fpsHeaderFooterParser,
fpsNumFormat, fpsxmlcommon, fpsPagelayout, fpsChart;
fpsNumFormat, fpsxmlcommon, fpsPagelayout, fpsChart, fpsChartStyles;
type
TDateModeODS=(
@ -286,9 +286,12 @@ type
function WriteWordwrapStyleXMLAsString(const AFormat: TsCellFormat): String;
{ Chart support }
function GetChartBackgroundStyleAsXML(AChart: TsChart; AStyleIndex: Integer; AIndent: Integer): String;
procedure PrepareChartTable(AChart: TsChart; AWorksheet: TsBasicWorksheet);
procedure WriteChart(AStream: TStream; AChart: TsChart);
procedure WriteChartAxis(AStream: TStream; AChart: TsChart; IsX, IsPrimary: Boolean; AIndent: Integer);
procedure WriteChartBackground(AStream: TStream; AChart: TsChart; AIndent: Integer);
procedure WriteChartLegend(AStream: TStream; AChart: TsChart; AIndent: Integer);
procedure WriteChartPlotArea(AStream: TStream; AChart: TsChart; AIndent: Integer);
procedure WriteChartSeries(AStream: TStream; AChart: TsChart; ASeriesIndex: Integer; AIndent: Integer);
@ -376,7 +379,7 @@ uses
StrUtils, Variants, LazFileUtils, URIParser, LazUTF8,
{%H-}fpsPatches,
fpsStrings, fpsStreams, fpsCrypto, fpsClasses, fpspreadsheet,
fpsExprParser, fpsImages, fpsConditionalFormat, fpsChartStyles;
fpsExprParser, fpsImages, fpsConditionalFormat;
const
LE = LineEnding;
@ -5884,7 +5887,9 @@ begin
for i := 0 to book.GetChartCount-1 do
begin
chart := book.GetChartByIndex(i);
styles.FindChartBackGroundStyle(chart);
styles.AddChartBackGroundStyle(chart, cstBackground);
styles.AddChartBackgroundStyle(chart, cstWall);
styles.AddChartBackgroundStyle(chart, cstFloor);
end;
end;
@ -6699,9 +6704,6 @@ begin
end;
procedure TsSpreadOpenDocWriter.WriteChart(AStream: TStream; AChart: TsChart);
var
chartClass: String;
idx: Integer;
begin
AppendToStream(AStream,
XML_HEADER + LE);
@ -6752,21 +6754,7 @@ begin
' <office:chart>' + LE
);
chartClass := CHART_TYPE_NAMES[AChart.GetChartType];
if chartClass <> '' then
chartClass := ' chart:class="chart:' + chartClass + '"';
idx := TsChartStyleList(FChartStyleList).FindChartBackgroundStyle(AChart);
AppendToStream(AStream, Format(
' <chart:chart svg:width="%.3fmm" svg:height="%.3fmm" xlink:href=".." ' + LE +
' xlink:type="simple"' + chartClass + ' chart:style-name="ch%d"> ' + LE,
[
AChart.Width, // Width, Height are in mm
AChart.Height,
idx + 1
], FPointSeparatorSettings
));
WriteChartBackground(AStream, AChart, 8);
WriteChartTitle(AStream, AChart, false, 8); // Title
WriteChartTitle(AStream, AChart, true, 8); // Subtitle
WriteChartLegend(AStream, AChart, 8);
@ -6869,6 +6857,31 @@ begin
);
end;
{ Writes the chart's background to the xml stream }
procedure TsSpreadOpenDocWriter.WriteChartBackground(AStream: TStream;
AChart: TsChart; AIndent: Integer);
var
ind: String;
idx: Integer;
chartClass: String;
begin
chartClass := CHART_TYPE_NAMES[AChart.GetChartType];
if chartClass <> '' then
chartClass := ' chart:class="chart:' + chartClass + '"';
idx := TsChartStyleList(FChartStyleList).FindChartBackgroundStyle(AChart, cstBackground);
AppendToStream(AStream, Format(
' <chart:chart svg:width="%.3fmm" svg:height="%.3fmm" xlink:href=".." ' + LE +
' xlink:type="simple"' + chartClass + ' chart:style-name="ch%d"> ' + LE,
[
AChart.Width, // Width, Height are in mm
AChart.Height,
idx + 1
], FPointSeparatorSettings
));
end;
{ Writes the chart's legend to the xml stream }
procedure TsSpreadOpenDocWriter.WriteChartLegend(AStream: TStream; AChart: TsChart;
AIndent: Integer);
@ -6894,8 +6907,7 @@ var
ind: String;
i: Integer;
plotAreaStyleID: Integer = 5;
wallStyleID: Integer = 22; // usually second to last of style list
floorstyleID: Integer = 23; // usually last of style list
wallStyleIdx, floorStyleIdx: Integer;
begin
ind := DupeString(' ', AIndent);
AppendToStream(AStream, Format(
@ -6910,11 +6922,14 @@ begin
for i := 0 to AChart.Series.Count-1 do
WriteChartSeries(AStream, AChart, i, AIndent + 2);
wallStyleIdx := TsChartStyleList(FChartStyleList).FindChartBackgroundStyle(AChart, cstWall);
floorStyleIdx := TsChartStyleList(FChartStyleList).FindChartBackgroundStyle(AChart, cstFloor);
AppendToStream(AStream, Format(
ind + ' <chart:wall chart:style-name="ch%d"/>' + LE +
ind + ' <chart:floor chart:style-name="ch%d"/>' + LE +
ind + '</chart:plot-area>' + LE,
[ wallStyleID, floorStyleID ]
[ wallStyleIdx + 1, floorStyleIdx + 1 ]
));
end;
@ -6965,21 +6980,15 @@ begin
);
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);
function GetChartBackgroundStyleXML(AIndent: Integer): String;
var
function TsSpreadOpenDocWriter.GetChartBackgroundStyleAsXML(
AChart: TsChart; AStyleIndex: Integer; AIndent: Integer): String;
var
ind: String;
idx: Integer;
style: TsChartBackgroundStyle;
s, drawStroke, strokeColor, drawFillColor: String;
begin
idx := TsChartStyleList(FChartStyleList).FindChartBackgroundStyle(AChart);
if idx = -1 then
raise Exception.Create('Chart background style not found.');
style := TsChartBackgroundStyle(FChartStyleList[idx]);
s, drawStroke, strokeColor, drawFill, drawFillColor: String;
begin
style := TsChartBackgroundStyle(FChartStyleList[AStyleIndex]);
case style.Border.Style of
clsNoLine: s := 'none';
@ -6994,22 +7003,38 @@ procedure TsSpreadOpenDocWriter.WriteChartStyles(AStream: TStream;
strokeColor := '';
if style.Background.Style = fsSolidFill then
drawFillColor := 'draw:fill-color="' + ColorToHTMLColorStr(style.Background.FGColor) + '" '
else
begin
drawFill := 'draw:fill="solid" ';
drawFillColor := 'draw:fill-color="' + ColorToHTMLColorStr(style.Background.FGColor) + '" ';
end else
begin
drawFill := 'draw:fill="none" ';
drawFillColor := '';
end;
// Other draw:fill options, not supported so far: gradient, hatch, bitmap
ind := DupeString(' ', AIndent);
Result := Format(
ind + '<style:style style:name="ch%d" style:family="chart">' + LE +
ind + ' <style:graphic-properties %s%s%s />' + LE +
ind + ' <style:graphic-properties %s%s%s%s />' + LE +
ind + '</style:style>' + LE,
[ idx+1, drawStroke, strokeColor, drawFillColor ]
[ AStyleIndex+1, drawStroke, strokeColor, drawFill, drawFillColor ]
);
end;
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);
var
ind: String;
backGrStyleIdx: Integer;
wallStyleIdx: Integer;
floorStyleIdx: Integer;
begin
backGrStyleIdx := TsChartStyleList(FChartStyleList).FindChartBackgroundStyle(AChart, cstBackground);
wallStyleIdx := TsChartStyleList(FChartStyleList).FindChartBackgroundStyle(AChart, cstWall);
floorStyleIdx := TsChartStyleList(FChartStyleList).FindChartBackgroundStyle(AChart, cstFloor);
ind := DupeString(' ', AIndent);
AppendToStream(AStream,
@ -7018,21 +7043,21 @@ begin
ind + ' <number:number number:min-integer-digits="1"/>' + LE +
ind + ' </number:number-style>' + LE +
// ch1: style for <chart:chart> element
GetChartBackgroundStyleXML(AIndent + 2) +
// style for <chart:chart> element
GetChartBackgroundStyleAsXML(AChart, backGrStyleIdx, AIndent + 2) +
{
ind + ' <style:style style:name="ch1" style:family="chart">' + LE +
ind + ' <style:graphic-properties draw:stroke="solid"/>' + LE + // '
ind + ' </style:style>' + LE +
}
// ch2: style for <chart:title> element
ind + ' <style:style style:name="ch2" style:family="chart">' + LE +
ind + ' <style:style style:name="ch200" style:family="chart">' + LE +
ind + ' <style:chart-properties chart:auto-position="true" style:rotation-angle="0"/>' + LE +
ind + ' <style:text-properties fo:font-size="13pt" style:font-size-asian="13pt" style:font-size-complex="13pt"/>' + LE +
ind + ' </style:style>' + LE +
// ch3: style for <chart:subtitle element
ind + ' <style:style style:name="ch3" style:family="chart">' + LE +
ind + ' <style:style style:name="ch300" style:family="chart">' + LE +
ind + ' <style:chart-properties chart:auto-position="true" style:rotation-angle="0"/>' + LE +
ind + ' <style:text-properties fo:font-size="11pt" style:font-size-asian="11pt" style:font-size-complex="11pt"/>' + LE +
ind + ' </style:style>' + LE +
@ -7203,6 +7228,9 @@ begin
ind + ' <style:text-properties fo:font-size="10pt" style:font-size-asian="10pt" style:font-size-complex="10pt"/>' + LE +
ind + ' </style:style>' + LE +
GetChartBackgroundStyleAsXML(AChart, wallStyleIdx, AIndent + 2) +
GetChartBackgroundStyleAsXML(AChart, floorStyleIdx, AIndent + 2) +
{
// next to last: style for wall
ind + ' <style:style style:name="ch22" style:family="chart">' + LE +
ind + ' <style:graphic-properties draw:stroke="solid" svg:stroke-color="#b3b3b3" draw:fill="none" draw:fill-color="#e6e6e6"/>' + LE +
@ -7212,7 +7240,7 @@ begin
ind + ' <style:style style:name="ch23" style:family="chart">' + LE +
ind + ' <style:graphic-properties svg:stroke-color="#b3b3b3" draw:fill-color="#cccccc"/>' + LE +
ind + ' </style:style>' + LE +
}
ind + '</office:automatic-styles>' + LE
);
end;
@ -7551,7 +7579,7 @@ begin
end else
begin
elementName := 'title';
titleStyleID := 2;
titleStyleID := 200;
cap := AChart.Title.Caption;
end;
AppendToStream(AStream, Format(