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

fpspreadsheet: ods chart reader supports gradient styles.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9014 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-11-07 19:17:23 +00:00
parent 818083dd9f
commit b28852a155
4 changed files with 108 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -33,12 +33,25 @@ begin
WriteLn (' Hatch styles: ');
for j := 0 to chart.Hatches.Count-1 do
WriteLn(' "', chart.Hatches[j].Name, '" ',
WriteLn(' "', chart.Hatches[j].Name, '" ',
GetEnumName(TypeInfo(TsChartHatchStyle), ord(chart.Hatches[j].Style)), ' ',
'Line color: ', 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);
'Line color:', 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: ');
for j := 0 to chart.Gradients.Count-1 do
WriteLn(' "', 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), ' ',
// 'StartIntensity:', chart.Gradients[j].StartIntensity*100:0:0, '% ',
// 'EndIntensity:', chart.Gradients[j].EndIntensity*100:0:0, '% ',
'Border:', chart.Gradients[j].Border*100:0:0, '% ',
'Angle:', chart.Gradients[j].Angle:0:0, 'deg ',
'CenterX:', chart.Gradients[j].CenterX*100:0:0, '% ',
'CenterY:', chart.Gradients[j].CenterY*100:0:0, '% ');
end;
finally

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

@ -61,10 +61,11 @@ type
private
function GetItem(AIndex: Integer): TsChartGradient;
procedure SetItem(AIndex: Integer; AValue: TsChartGradient);
public
function AddGradient(AName: String; AStyle: TsChartGradientStyle;
AStartColor, AEndColor: TsColor; AStartIntensity, AEndIntensity: Double;
ABorder, ACenterX, ACenterY, AAngle: Double): Integer;
public
function AddAxialGradient(AName: String; AStartColor, AEndColor: TsColor;
AStartIntensity, AEndIntensity, ABorder, AAngle: Double): Integer;
function AddEllipticGradient(AName: String; AStartColor, AEndColor: TsColor;

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

@ -20,6 +20,7 @@ type
FChartFiles: TStrings;
FPointSeparatorSettings: TFormatSettings;
procedure ReadChartFiles(AStream: TStream; AFileList: String);
procedure ReadObjectGradientStyles(ANode: TDOMNode; AChart: TsChart);
procedure ReadObjectHatchStyles(ANode: TDOMNode; AChart: TsChart);
procedure ReadObjectLineStyles(ANode: TDOMNode; AChart: TsChart);
procedure ReadObjectStyles(ANode: TDOMNode; AChart: TsChart);
@ -355,12 +356,78 @@ begin
'draw:hatch': // read hatch pattern
ReadObjectHatchStyles(ANode, AChart);
'draw:gradient': // gradient definition
;
ReadObjectGradientStyles(ANode, AChart);
end;
ANode := ANode.NextSibling;
end;
end;
procedure TsSpreadOpenDocChartReader.ReadObjectGradientStyles(ANode: TDOMNode;
AChart: TsChart);
var
i: Integer;
s: String;
styleName: String;
gs: TsChartGradientStyle;
gradientStyle: TsChartGradientStyle = cgsLinear;
startColor: TsColor = scSilver;
endColor: TsColor = scWhite;
startIntensity, endIntensity: Double;
border, centerX, centerY: Double;
angle: Double = 0.0;
begin
styleName := GetAttrValue(ANode, 'draw:display-name');
if styleName ='' then
styleName := GetAttrValue(ANode, 'draw:name');
s := GetAttrValue(ANode, 'draw:style');
if s <> '' then
for gs in TsChartGradientStyle do
if GRADIENT_STYLES[gs] = s then
begin
gradientStyle := gs;
break;
end;
s := GetAttrValue(ANode, 'draw:start-color');
if s <> '' then
startColor := HTMLColorStrToColor(s);
s := GetAttrValue(ANode, 'draw:end-color');
if s <> '' then
endColor := HTMLColorStrToColor(s);
s := GetAttrValue(ANode, 'draw:start-intensity');
if not TryPercentStrToFloat(s, startIntensity) then
startIntensity := 1.0;
s := GetAttrValue(ANode, 'draw:end-intensity');
if not TryPercentStrToFloat(s, endIntensity) then
endIntensity := 1.0;
s := GetAttrValue(ANode, 'draw:border');
if not TryPercentStrToFloat(s, border) then
border := 0.0;
s := GetAttrValue(ANode, 'draw:angle');
if s <> '' then begin
for i := Length(s) downto 1 do
if not (s[i] in ['0'..'9', '.', '+', '-']) then Delete(s, i, 1);
angle := StrToFloatDef(s, 0.0, FPointSeparatorSettings);
end;
s := GetAttrValue(ANode, 'draw:cx');
if not TryPercentStrToFloat(s, centerX) then
centerX := 0.0;
s := GetAttrValue(ANode, 'draw:cy');
if not TryPercentStrToFloat(s, centerY) then
centerY := 0.0;
AChart.Gradients.AddGradient(styleName, gradientStyle, startColor, endColor,
startIntensity, endIntensity, border, centerX, centerY, angle);
end;
{ Read the hatch pattern stored in the "draw:hatch" nodes of the chart's
Object styles.xml file. }
procedure TsSpreadOpenDocChartReader.ReadObjectHatchStyles(ANode: TDOMNode; AChart: TsChart);

20
components/fpspreadsheet/source/common/fpsutils.pas
View File

@ -165,6 +165,8 @@ function TryStrToFloatAuto(AText: String; out ANumber: Double;
function TryFractionStrToFloat(AText: String; out ANumber: Double;
out AIsMixed: Boolean; out AMaxDigits: Integer): Boolean;
function TryPercentStrToFloat(AText: String; out ANumber: Double): Boolean;
function Round(AValue: Double): Int64;
function cmToPts(AValue: Double): Double; inline;
@ -1976,6 +1978,24 @@ begin
Result := true;
end;
{@@ ----------------------------------------------------------------------------
Converts a percent-formatted string to a decimal number.
Example: '150%' --> 1.5
-------------------------------------------------------------------------------}
function TryPercentStrToFloat(AText: String; out ANumber: Double): boolean;
var
res: Integer;
begin
Result := false;
if AText = '' then
exit;
if AText[Length(AText)] = '%' then Delete(AText, Length(AText), 1);
val(AText, ANumber, res);
Result := (res = 0);
if Result then
ANumber := ANumber * 0.01;
end;
{@@ ----------------------------------------------------------------------------
Special rounding function which avoids banker's rounding
-------------------------------------------------------------------------------}