diff --git a/components/fpspreadsheet/examples/other/chart/read_chart_demo.lpr b/components/fpspreadsheet/examples/other/chart/read_chart_demo.lpr index 99bf9c4cd..c6ea125d0 100644 --- a/components/fpspreadsheet/examples/other/chart/read_chart_demo.lpr +++ b/components/fpspreadsheet/examples/other/chart/read_chart_demo.lpr @@ -26,23 +26,23 @@ begin 'col:', chart.Col, ' (+',chart.OffsetX:0:0, 'mm) ', 'width:', chart.Width:0:0, 'mm height:', chart.Height:0:0, 'mm'); - Write(' Line styles: '); + Write(' LINE STYLES: '); for j := 0 to chart.LineStyles.Count-1 do Write('"', chart.GetLineStyle(j).Name, '" '); WriteLn; - WriteLn (' Hatch styles: '); + WriteLn (' HATCH STYLES: '); for j := 0 to chart.Hatches.Count-1 do - WriteLn(' "', chart.Hatches[j].Name, '" ', + WriteLn(' ', j, ': "', chart.Hatches[j].Name, '" ', GetEnumName(TypeInfo(TsChartHatchStyle), ord(chart.Hatches[j].Style)), ' ', '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); - WriteLn (' Gradient styles: '); + WriteLn (' GRADIENT STYLES: '); for j := 0 to chart.Gradients.Count-1 do - WriteLn(' "', chart.Gradients[j].Name, '" ', + WriteLn(' ', j, ': "', 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), ' ', @@ -52,19 +52,35 @@ 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; + 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; + 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); + WriteLn; + WriteLn(' CHART LEGEND'); + WriteLn(' Position: ', GetEnumName(TypeInfo(TsChartLegendPosition), ord(chart.Legend.Position)), + ' CanOverlapPlotArea:', chart.Legend.CanOverlapPlotArea); + WriteLn(' Background: Style:', GetEnumName(TypeInfo(TsChartFillStyle), ord(chart.Legend.Background.Style)), + ' Color:', IntToHex(chart.Legend.Background.Color, 6), + ' Gradient:', chart.Legend.Background.Gradient, + ' Hatch:', chart.Legend.Background.Hatch); + WriteLn(' Border: Style:', chart.Legend.Border.Style, + ' Width:', chart.Legend.Border.Width:0:0, 'mm', + ' Color:', IntToHex(chart.Legend.Border.Color, 6), + ' Transparency:', chart.Legend.Border.Transparency:0:2); + WriteLn(' Font: "', chart.Legend.Font.FontName, '" Size:', chart.Legend.Font.Size:0:0, + ' Style:', SetToString(PTypeInfo(TypeInfo(TsFontStyles)), integer(chart.Legend.Font.Style), True), + ' Color:', IntToHex(chart.Legend.Font.Color, 6)); end; finally diff --git a/components/fpspreadsheet/source/common/fpschart.pas b/components/fpspreadsheet/source/common/fpschart.pas index c65d1217c..e9bc345e5 100644 --- a/components/fpspreadsheet/source/common/fpschart.pas +++ b/components/fpspreadsheet/source/common/fpschart.pas @@ -252,12 +252,15 @@ type FFont: TsFont; FCanOverlapPlotArea: Boolean; FPosition: TsChartLegendPosition; + FPosX, FPosY: Double; public constructor Create(AChart: TsChart); destructor Destroy; override; property CanOverlapPlotArea: Boolean read FCanOverlapPlotArea write FCanOverlapPlotArea; property Font: TsFont read FFont write FFont; property Position: TsChartLegendPosition read FPosition write FPosition; + property PosX: Double read FPosX write FPosX; + property PosY: Double read FPosY write FPosY; // There is also a "legend-expansion" but this does not seem to have a visual effect in Calc. end; diff --git a/components/fpspreadsheet/source/common/fpsopendocument.pas b/components/fpspreadsheet/source/common/fpsopendocument.pas index cf08e1808..4023446c3 100644 --- a/components/fpspreadsheet/source/common/fpsopendocument.pas +++ b/components/fpspreadsheet/source/common/fpsopendocument.pas @@ -231,6 +231,7 @@ type { Helper methods, public because needed by the chart reader } function CreateXMLStream: TStream; + procedure ReadFont(ANode: TDOMNode; AFont: TsFont); end; { TsSpreadOpenDocWriter } @@ -2632,6 +2633,13 @@ begin (Workbook as TsWorkbook).CryptoInfo := cinfo; end; +{ Reads font data from an xml node and passes the read properties to the + provided font. } +procedure TsSpreadOpenDocReader.ReadFont(ANode: TDOMNode; AFont: TsFont); +begin + ReadFont(ANode, AFont.FontName, AFont.Size, AFont.Style, AFont.Color, AFont.Position); +end; + { Reads font data from an xml node and returns the font elements. } procedure TsSpreadOpenDocReader.ReadFont(ANode: TDOMNode; var AFontName: String; var AFontSize: Single; var AFontStyle: TsFontStyles; var AFontColor: TsColor; diff --git a/components/fpspreadsheet/source/common/fpsopendocumentchart.pas b/components/fpspreadsheet/source/common/fpsopendocumentchart.pas index 500de7c0c..00621e772 100644 --- a/components/fpspreadsheet/source/common/fpsopendocumentchart.pas +++ b/components/fpspreadsheet/source/common/fpsopendocumentchart.pas @@ -23,14 +23,15 @@ type procedure GetChartFillProps(ANode: TDOMNode; AChart: TsChart; AFill: TsChartFill); procedure GetChartLineProps(ANode: TDOMNode; AChart: TsChart; ALine: TsChartLine); - procedure ReadChartBackgroundStyle(AStyleNode: TDOMNode; AChart: TsChart); + procedure ReadChartProps(AChartNode, AStyleNode: TDOMNode; AChart: TsChart); + procedure ReadChartPlotAreaProps(ANode, AStyleNode: TDOMNode; AChart: TsChart); + procedure ReadChartLegendProps(ANode, AStyleNode: TDOMNode; AChart: TsChart); + procedure ReadChartLegendStyle(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); @@ -155,6 +156,7 @@ const LE = LineEnding; +// Replaces all non-letters/numbers by their hex ASCII value surrounded by '_' function ASCIIName(AName: String): String; var i: Integer; @@ -167,6 +169,7 @@ begin Result := Result + Format('_%.2x_', [ord(AName[i])]); end; +// Reverts the replacement done by ASCIIName. function UnASCIIName(AName: String): String; var i: Integer; @@ -281,6 +284,30 @@ begin inherited; end; +{ Searches in the child nodes of AStyleNode for the style:style node with + the attributes style:family = chart and style:name = AStyleName. } +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; + { AFiles contains a sorted, comma-separated list of all files belonging to each chart. } procedure TsSpreadOpenDocChartReader.AddChartFiles(AFileList: String); @@ -339,6 +366,7 @@ var sn: String; sc: String; sw: String; + so: String; value: Double; rel: Boolean; begin @@ -354,16 +382,20 @@ begin begin sn := GetAttrValue(ANode, 'draw:stroke-dash'); if sn <> '' then - ALine.Style := AChart.LineStyles.IndexOfName(UnAsciiName(sn)); + ALine.Style := AChart.LineStyles.IndexOfName(UnASCIIName(sn)); end; sc := 'draw:stroke-color'; if sc <> '' then ALine.Color := HTMLColorStrToColor(sc); - sw := 'draw:strike-width'; + sw := 'draw:stroke-width'; if (sw <> '') and EvalLengthStr(sw, value, rel) then ALine.Width := value; + + so := 'draw:stroke-opacity'; + if (so <> '') and TryPercentStrToFloat(so, value) then + ALine.Transparency := 1.0 - value*0.01; end; end; @@ -391,6 +423,7 @@ procedure TsSpreadOpenDocChartReader.ReadChart(AChartNode, AStyleNode: TDOMNode; AChart: TsChart); var nodeName: String; + node: TDOMNode; begin AChartNode := AChartNode.FirstChild.FirstChild; // --> chart:chart while (AChartNode <> nil) do @@ -399,6 +432,17 @@ begin if nodeName = 'chart:chart' then begin ReadChartProps(AChartNode, AStyleNode, AChart); + node := AChartNode.FirstChild; + while (node <> nil) do + begin + nodeName := node.NodeName; + if nodeName = 'chart:plot-area' then + ReadChartPlotAreaProps(node, AStyleNode, AChart) + else + if nodeName = 'chart:legend' then + ReadChartLegendProps(node, AStyleNode, AChart); + node := node.NextSibling; + end; end; AChartNode := AChartNode.NextSibling; end; @@ -422,28 +466,6 @@ begin 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 @@ -455,6 +477,70 @@ begin ReadChartBackgroundStyle(styleNode, AChart); end; +procedure TsSpreadOpenDocChartReader.ReadChartPlotAreaProps(ANode, AStyleNode: TDOMNode; + AChart: TsChart); +begin +end; + +procedure TsSpreadOpenDocChartReader.ReadChartLegendProps(ANode, AStyleNode: TDOMNode; + AChart: TsChart); +var + styleName: String; + styleNode: TDOMNode; + s: String; + lp: TsChartLegendPosition; + value: Double; + rel: Boolean; +begin + styleName := GetAttrValue(ANode, 'chart:style-name'); + styleNode := FindStyleNode(AStyleNode, styleName); + ReadChartLegendStyle(styleNode, AChart); + + s := GetAttrValue(ANode, 'chart:legend-position'); + if s <> '' then + for lp in TsChartLegendPosition do + if s = LEGEND_POSITION[lp] then + begin + AChart.Legend.Position := lp; + break; + end; + + s := GetAttrValue(ANode, 'svg:x'); + if (s <> '') and EvalLengthStr(s, value, rel) then + if not rel then + AChart.Legend.PosX := value; + + s := GetAttrValue(ANode, 'svg:y'); + if (s <> '') and EvalLengthStr(s, value, rel) then + if not rel then + AChart.Legend.PosY := value; + + s := GetAttrValue(ANode, 'loext:overlay'); + AChart.Legend.CanOverlapPlotArea := (s = 'true'); +end; + +procedure TsSpreadOpenDocChartReader.ReadChartLegendStyle(AStyleNode: TDOMNode; + AChart: TsChart); +var + nodeName: String; +begin + nodeName := AStyleNode.NodeName; + AStyleNode := AStyleNode.FirstChild; + while AStyleNode <> nil do begin + nodeName := AStyleNode.NodeName; + case nodeName of + 'style:graphic-properties': + begin + GetChartLineProps(AStyleNode, AChart, AChart.Legend.Border); + GetChartFillProps(AStyleNode, AChart, AChart.Legend.Background); + end; + 'style:text-properties': + TsSpreadOpenDocReader(Reader).ReadFont(AStyleNode, AChart.Legend.Font); + end; + AStyleNode := AStyleNode.NextSibling; + end; +end; + procedure TsSpreadOpenDocChartReader.ReadChartFiles(AStream: TStream; AFileList: String); var