From 97d23a09e01127ee25b694367a332f89759318b8 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Tue, 7 Nov 2023 22:37:30 +0000 Subject: [PATCH] fpspreadsheet: ods reader supports chart background and border git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9015 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/other/chart/read_chart_demo.lpr | 17 +- .../fpspreadsheet/source/common/fpschart.pas | 9 + .../source/common/fpsopendocumentchart.pas | 216 +++++++++++++++++- 3 files changed, 236 insertions(+), 6 deletions(-) diff --git a/components/fpspreadsheet/examples/other/chart/read_chart_demo.lpr b/components/fpspreadsheet/examples/other/chart/read_chart_demo.lpr index d3c449321..99bf9c4cd 100644 --- a/components/fpspreadsheet/examples/other/chart/read_chart_demo.lpr +++ b/components/fpspreadsheet/examples/other/chart/read_chart_demo.lpr @@ -21,7 +21,7 @@ begin chart := b.GetChartByIndex(i); sheet := b.GetWorksheetByIndex(chart.SheetIndex); WriteLn('Chart "', chart.Name, '":'); - WriteLn(' in worksheet "', sheet.Name, '", ', + WriteLn(' Worksheet "', sheet.Name, '", ', 'row:', chart.Row, ' (+',chart.OffsetY:0:0, 'mm) ', 'col:', chart.Col, ' (+',chart.OffsetX:0:0, 'mm) ', 'width:', chart.Width:0:0, 'mm height:', chart.Height:0:0, 'mm'); @@ -35,7 +35,7 @@ begin for j := 0 to chart.Hatches.Count-1 do WriteLn(' "', chart.Hatches[j].Name, '" ', GetEnumName(TypeInfo(TsChartHatchStyle), ord(chart.Hatches[j].Style)), ' ', - 'Line color:', IntToHex(chart.Hatches[j].LineColor, 6), ' ', + 'LineColor:', 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); @@ -52,6 +52,19 @@ begin 'Angle:', chart.Gradients[j].Angle:0:0, 'deg ', 'CenterX:', chart.Gradients[j].CenterX*100:0:0, '% ', 'CenterY:', chart.Gradients[j].CenterY*100:0:0, '% '); + WriteLn; + + WriteLn(' Chart border:'); + WriteLn(' Style:', chart.Border.Style, + ' Width:', chart.Border.Width:0:0, 'mm', + ' Color:', IntToHex(chart.Border.Color, 6), + ' Transparency:', chart.Border.Transparency:0:2); + + WriteLn(' Chart background:'); + WriteLn(' Style:', GetEnumName(TypeInfo(TsChartFillStyle), ord(chart.Background.Style)), + ' Color:', IntToHex(chart.background.Color, 6), + ' Gradient:', chart.Background.Gradient, + ' Hatch:', chart.Background.Hatch); end; finally diff --git a/components/fpspreadsheet/source/common/fpschart.pas b/components/fpspreadsheet/source/common/fpschart.pas index 8d57d91e7..c65d1217c 100644 --- a/components/fpspreadsheet/source/common/fpschart.pas +++ b/components/fpspreadsheet/source/common/fpschart.pas @@ -140,6 +140,7 @@ type ASeg1Length: Double; ASeg1Count: Integer; ASeg2Length: Double; ASeg2Count: Integer; ADistance: Double; ARelativeToLineWidth: Boolean): Integer; + function IndexOfName(AName: String): Integer; property Items[AIndex: Integer]: TsChartLineStyle read GetItem write SetItem; default; end; @@ -779,6 +780,14 @@ begin Result := TsChartLineStyle(inherited); end; +function TsChartLineStyleList.IndexOfName(AName: String): Integer; +begin + for Result := 0 to Count-1 do + if Items[Result].Name = AName then + exit; + Result := -1; +end; + procedure TsChartLineStyleList.SetItem(AIndex: Integer; AValue: TsChartLineStyle); begin inherited Items[AIndex] := AValue; diff --git a/components/fpspreadsheet/source/common/fpsopendocumentchart.pas b/components/fpspreadsheet/source/common/fpsopendocumentchart.pas index 0f406b1dd..500de7c0c 100644 --- a/components/fpspreadsheet/source/common/fpsopendocumentchart.pas +++ b/components/fpspreadsheet/source/common/fpsopendocumentchart.pas @@ -19,10 +19,21 @@ type private FChartFiles: TStrings; FPointSeparatorSettings: TFormatSettings; - procedure ReadChartFiles(AStream: TStream; AFileList: String); + function FindStyleNode(AStyleNodes: TDOMNode; AStyleName: String): TDOMNode; + procedure GetChartFillProps(ANode: TDOMNode; AChart: TsChart; AFill: TsChartFill); + procedure GetChartLineProps(ANode: TDOMNode; AChart: TsChart; ALine: TsChartLine); + + + procedure ReadChartBackgroundStyle(AStyleNode: TDOMNode; AChart: TsChart); + procedure ReadObjectGradientStyles(ANode: TDOMNode; AChart: TsChart); procedure ReadObjectHatchStyles(ANode: TDOMNode; AChart: TsChart); procedure ReadObjectLineStyles(ANode: TDOMNode; AChart: TsChart); + + procedure ReadChartProps(AChartNode, AStyleNode: TDOMNode; AChart: TsChart); + protected + procedure ReadChartFiles(AStream: TStream; AFileList: String); + procedure ReadChart(AChartNode, AStyleNode: TDOMNode; AChart: TsChart); procedure ReadObjectStyles(ANode: TDOMNode; AChart: TsChart); public constructor Create(AReader: TsBasicSpreadReader); override; @@ -37,7 +48,6 @@ type FSObjectStyles: array of TStream; FNumberFormatList: TStrings; FPointSeparatorSettings: TFormatSettings; - function GetChartAxisStyleAsXML(Axis: TsChartAxis; AIndent, AStyleID: Integer): String; function GetChartBackgroundStyleAsXML(AChart: TsChart; AFill: TsChartFill; ABorder: TsChartLine; AIndent: Integer; AStyleID: Integer): String; @@ -157,6 +167,31 @@ begin Result := Result + Format('_%.2x_', [ord(AName[i])]); end; +function UnASCIIName(AName: String): String; +var + i: Integer; + s: String; + decoding: Boolean; +begin + Result := ''; + decoding := false; + for i := 1 to Length(AName) do + begin + if AName[i] = '_' then + begin + if decoding then + Result := Result + char(StrToInt('$'+s)) + else + s := ''; + decoding := not decoding; + end else + if decoding then + s := s + AName[i] + else + Result := Result + AName[i]; + end; +end; + { Extracts the length from an ods length string, e.g. "3.5cm" or "300%". In the former case AValue become 35 (in millimeters), in the latter case AValue is 300 and Relative becomes true } @@ -253,6 +288,173 @@ begin FChartFiles.Add(AFileList); end; +procedure TsSpreadOpenDocChartReader.GetChartFillProps(ANode: TDOMNode; + AChart: TsChart; AFill: TsChartFill); +var + s: String; + sc: String; + sn: String; + opacity: Double; +begin + s := GetAttrValue(ANode, 'draw:fill'); + case s of + 'none': + AFill.Style := cfsNoFill; + 'solid': + begin + AFill.Style := cfsSolid; + sc := GetAttrValue(ANode, 'draw:fill-color'); + if sc <> '' then + AFill.Color := HTMLColorStrToColor(sc); + end; + 'gradient': + begin + AFill.Style := cfsGradient; + sn := GetAttrValue(ANode, 'draw:fill-gradient-name'); + if sn <> '' then + AFill.Gradient := AChart.Gradients.IndexOfName(UnASCIIName(sn)); + end; + 'hatch': + begin + AFill.Style := cfsHatched; + sn := GetAttrValue(ANode, 'draw:fill-hatch-name'); + if sn <> '' then + AFill.Hatch := AChart.Hatches.IndexOfName(UnASCIIName(sn)); + sc := GetAttrValue(ANode, 'draw:fill-color'); + if sc <> '' then + AFill.Color := HTMLColorStrToColor(sc); + sc := GetAttrValue(ANode, 'draw:fill-hatch-solid'); + // AFill.Hatch.Filled := (sc = 'true'); // !!!! FIX ME: Filled should not be part of the style + end; + end; + s := GetAttrValue(ANode, 'draw:opacity'); + if (s <> '') and TryPercentStrToFloat(s, opacity) then + AFill.Transparency := 1.0 - opacity; +end; + +procedure TsSpreadOpenDocChartReader.GetChartLineProps(ANode: TDOMNode; + AChart: TsChart; ALine: TsChartLine); +var + s: String; + sn: String; + sc: String; + sw: String; + value: Double; + rel: Boolean; +begin + s := GetAttrValue(ANode, 'draw:stroke'); + if s = 'none' then + ALine.Style := clsNoLine + else + begin + if s = 'solid' then + ALine.Style := clsSolid + else + if s = 'dash' then + begin + sn := GetAttrValue(ANode, 'draw:stroke-dash'); + if sn <> '' then + ALine.Style := AChart.LineStyles.IndexOfName(UnAsciiName(sn)); + end; + + sc := 'draw:stroke-color'; + if sc <> '' then + ALine.Color := HTMLColorStrToColor(sc); + + sw := 'draw:strike-width'; + if (sw <> '') and EvalLengthStr(sw, value, rel) then + ALine.Width := value; + end; +end; + + (* +function TsSpreadOpenDocChartWriter.GetChartBackgroundStyleAsXML( + AChart: TsChart; AFill: TsChartFill; ABorder: TsChartLine; + AIndent, AStyleID: Integer): String; +var + indent: String; + fillStr: String = ''; + borderStr: String = ''; +begin + fillStr := GetChartFillStyleGraphicPropsAsXML(AChart, AFill); + borderStr := GetChartLineStyleGraphicPropsAsXML(AChart, ABorder); + indent := DupeString(' ', AIndent); + Result := Format( + indent + '' + LE + + indent + ' ' + LE + + indent + '' + LE, + [ AStyleID, fillStr, borderStr ] + ); +end; *) + +procedure TsSpreadOpenDocChartReader.ReadChart(AChartNode, AStyleNode: TDOMNode; + AChart: TsChart); +var + nodeName: String; +begin + AChartNode := AChartNode.FirstChild.FirstChild; // --> chart:chart + while (AChartNode <> nil) do + begin + nodeName := AChartNode.NodeName; + if nodeName = 'chart:chart' then + begin + ReadChartProps(AChartNode, AStyleNode, AChart); + end; + AChartNode := AChartNode.NextSibling; + end; +end; + +procedure TsSpreadOpenDocChartReader.ReadChartBackgroundStyle(AStyleNode: TDOMNode; + AChart: TsChart); +var + nodeName: String; +begin + nodeName := AStyleNode.NodeName; + AStyleNode := AStyleNode.FirstChild; + while AStyleNode <> nil do begin + nodeName := AStyleNode.NodeName; + if nodeName = 'style:graphic-properties' then + begin + GetChartLineProps(AStyleNode, AChart, AChart.Border); + GetChartFillProps(AStyleNode, AChart, AChart.Background); + end; + AStyleNode := AStyleNode.NextSibling; + end; +end; + +function TsSpreadOpenDocChartReader.FindStyleNode(AStyleNodes: TDOMNode; + AStyleName: String): TDOMNode; +var + nodeName: String; + sn, sf: String; +begin + Result := AStyleNodes.FirstChild; + while (Result <> nil) do + begin + nodeName := Result.NodeName; + if nodeName = 'style:style' then + begin + sn := GetAttrValue(Result, 'style:name'); + sf := GetAttrValue(Result, 'style:family'); + if (sf = 'chart') and (sn = AStyleName) then + exit; + end; + Result := Result.NextSibling; + end; + Result := nil; +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.ReadChartFiles(AStream: TStream; AFileList: String); var @@ -326,9 +528,15 @@ begin end; if not ok then - raise Exception.Create('ODS chart reader: error reading file ' + contentFile); + raise Exception.Create('ODS chart reader: error reading content file ' + contentFile); - // ReadChart(contentDoc.DocumentElement.FindNode('office:body', chart); + ReadChart( + doc.DocumentElement.FindNode('office:body'), + doc.DocumentElement.FindNode('office:automatic-styles'), + chart + ); + + FreeAndNil(doc); end; procedure TsSpreadOpenDocChartReader.ReadCharts(AStream: TStream);