diff --git a/components/fpspreadsheet/examples/other/chart/read_chart_demo.lpr b/components/fpspreadsheet/examples/other/chart/read_chart_demo.lpr index a9f1b34d7..07e621416 100644 --- a/components/fpspreadsheet/examples/other/chart/read_chart_demo.lpr +++ b/components/fpspreadsheet/examples/other/chart/read_chart_demo.lpr @@ -7,13 +7,16 @@ uses const // FILE_NAME = 'test.ods'; // FILE_NAME = 'area.ods'; - FILE_NAME = 'bars.ods'; +// FILE_NAME = 'bars.ods'; + FILE_NAME = 'regression.ods'; +// FILE_NAME = 'pie.ods'; +// FILE_NAME = 'radar.ods'; var book: TsWorkbook; sheet: TsWorksheet; chart: TsChart; + series: TsChartSeries; i, j: Integer; - s: String; isODS: Boolean; begin isODS := ExtractFileExt(FILE_NAME) = '.ods'; @@ -194,6 +197,47 @@ begin ' Width:', chart.YAxis.MinorGridLines.Width:0:0, 'mm', ' Color:', IntToHex(chart.YAxis.MinorGridLines.Color, 6), ' Transparency:', chart.YAxis.MinorGridLines.Transparency:0:2); + + for j := 0 to chart.Series.Count-1 do + begin + series := chart.Series[j]; + WriteLn; + WriteLn(' SERIES #', j, ': ', series.ClassName); + with series.TitleAddr do + WriteLn(' TITLE: ', GetCellRangeString(Sheet, Sheet, Row, Col, Row, Col, rfAllRel, false)); + with series.LabelRange do + WriteLn(' LABEL RANGE: ', GetCellRangeString(Sheet1, Sheet2, Row1, Col1, Row2, Col2, rfAllRel, false)); + if (series is TsScatterSeries) or (series is TsBubbleSeries) then with series.XRange do + WriteLn(' X RANGE: ', GetCellRangeString(Sheet1, Sheet2, Row1, Col1, Row2, Col2, rfAllRel, false)); + with series.YRange do + WriteLn(' Y RANGE: ', GetCellRangeString(Sheet1, Sheet2, Row1, Col1, Row2, Col2, rfAllRel, false)); + with series.FillColorRange do + WriteLn(' FILL COLOR RANGE: ', GetCellRangeString(Sheet1, Sheet2, Row1, Col1, Row2, Col2, rfAllRel, false)); + with series.LineColorRange do + WriteLn(' LINE COLOR RANGE: ', GetCellRangeString(Sheet1, Sheet2, Row1, Col1, Row2, Col2, rfAllRel, false)); + if series is TsBubbleSeries then with TsBubbleSeries(series).BubbleRange do + WriteLn(' BUBBLE RANGE: ', GetCellRangeString(Sheet1, Sheet2, Row1, Col1, Row2, Col2, rfAllRel, false)); + if series is TsLineSeries then with TsLineSeries(series) do + begin + Write(' SYMBOLS: '); + if ShowSymbols then + WriteLn('Symbol:', GetEnumName(TypeInfo(TsChartSeriesSymbol), ord(Symbol)), + ' Width:', SymbolWidth:0:1, 'mm', + ' Height:', SymbolHeight:0:1, 'mm') + else + WriteLn('none'); + end; + + WriteLn(' FILL: Style:', GetEnumName(TypeInfo(TsChartFillStyle), ord(series.Fill.Style)), + ' Color:', IntToHex(series.Fill.Color, 6), + ' Gradient:', series.Fill.Gradient, + ' Hatch:', series.Fill.Hatch, + ' Transparency:', series.Fill.Transparency:0:2); + WriteLn(' LINES: Style:', series.Line.Style, + ' Width:', series.Line.Width:0:0, 'mm', + ' Color:', IntToHex(series.Line.Color, 6), + ' Transparency:', series.Line.Transparency:0:2); + end; end; finally diff --git a/components/fpspreadsheet/source/common/fpschart.pas b/components/fpspreadsheet/source/common/fpschart.pas index 1e8b7f11e..7ba7c16ac 100644 --- a/components/fpspreadsheet/source/common/fpschart.pas +++ b/components/fpspreadsheet/source/common/fpschart.pas @@ -165,7 +165,7 @@ type procedure Assign(ASource: TsChartRange); function GetSheet1Name: String; function GetSheet2Name: String; - function IsUsed: Boolean; + function IsEmpty: Boolean; end; TsChartElement = class @@ -298,6 +298,7 @@ type FXRange: TsChartRange; // cell range containing the x data FYRange: TsChartRange; FFillColorRange: TsChartRange; + FLineColorRange: TsChartRange; FLabelRange: TsChartRange; FLabelFont: TsFont; FLabelPosition: TsChartLabelPosition; @@ -329,6 +330,8 @@ type procedure SetYRange(ASheet1: String; ARow1, ACol1: Cardinal; ASheet2: String; ARow2, ACol2: Cardinal); procedure SetFillColorRange(ARow1, ACol1, ARow2, ACol2: Cardinal); procedure SetFillColorRange(ASheet1: String; ARow1, ACol1: Cardinal; ASheet2: String; ARow2, ACol2: Cardinal); + procedure SetLineColorRange(ARow1, ACol1, ARow2, ACol2: Cardinal); + procedure SetLineColorRange(ASheet1: String; ARow1, ACol1: Cardinal; ASheet2: String; ARow2, ACol2: Cardinal); function LabelsInCol: Boolean; function XValuesInCol: Boolean; function YValuesInCol: Boolean; @@ -336,15 +339,16 @@ type property ChartType: TsChartType read GetChartType; property Count: Integer read GetCount; property DataLabels: TsChartDataLabels read FDataLabels write FDataLabels; - property FillColorRange: TsChartRange read FFillColorRange; + property FillColorRange: TsChartRange read FFillColorRange write FFillColorRange; property LabelFont: TsFont read FLabelFont write FLabelFont; property LabelFormat: String read FLabelFormat write FLabelFormat; // Number format in Excel notation, e.g. '0.00' property LabelPosition: TsChartLabelPosition read FLabelPosition write FLabelPosition; - property LabelRange: TsChartRange read FLabelRange; + property LabelRange: TsChartRange read FLabelRange write FLabelRange; property LabelSeparator: string read FLabelSeparator write FLabelSeparator; + property LineColorRange: TsChartRange read FLineColorRange write FLineColorRange; property TitleAddr: TsChartCellAddr read FTitleAddr write FTitleAddr; // use '\n' for line-break - property XRange: TsChartRange read FXRange; - property YRange: TsChartRange read FYRange; + property XRange: TsChartRange read FXRange write FXRange; + property YRange: TsChartRange read FYRange write FYRange; property YAxis: TsChartAxisLink read FYAxis write FYAxis; property Fill: TsChartFill read FFill write FFill; @@ -898,11 +902,11 @@ begin Result := FChart.GetWorksheet.Name; end; -function TsChartRange.IsUsed: Boolean; +function TsChartRange.IsEmpty: Boolean; begin Result := - (Row1 <> UNASSIGNED_ROW_COL_INDEX) and (Col1 <> UNASSIGNED_ROW_COL_INDEX) and - (Row2 <> UNASSIGNED_ROW_COL_INDEX) and (Col2 <> UNASSIGNED_ROW_COL_INDEX); + (Row1 = UNASSIGNED_ROW_COL_INDEX) and (Col1 = UNASSIGNED_ROW_COL_INDEX) and + (Row2 = UNASSIGNED_ROW_COL_INDEX) and (Col2 = UNASSIGNED_ROW_COL_INDEX); end; @@ -1044,6 +1048,7 @@ begin FXRange := TsChartRange.Create(AChart); FYRange := TsChartRange.Create(AChart); FFillColorRange := TsChartRange.Create(AChart); + FLineColorRange := TsChartRange.Create(AChart); FLabelRange := TsChartRange.Create(AChart); FTitleAddr := TsChartCellAddr.Create(AChart); @@ -1070,6 +1075,7 @@ begin FFill.Free; FTitleAddr.Free; FLabelRange.Free; + FLineColorRange.Free; FFillColorRange.Free; FYRange.Free; FXRange.Free; @@ -1173,6 +1179,24 @@ begin FLabelRange.Col2 := ACol2; end; +procedure TsChartSeries.SetLineColorRange(ARow1, ACol1, ARow2, ACol2: Cardinal); +begin + SetLineColorRange('', ARow1, ACol1, '', ARow2, ACol2); +end; + +procedure TsChartSeries.SetLineColorRange(ASheet1: String; ARow1, ACol1: Cardinal; + ASheet2: String; ARow2, ACol2: Cardinal); +begin + if (ARow1 <> ARow2) and (ACol1 <> ACol2) then + raise Exception.Create('Series line color values can only be located in a single column or row.'); + FLineColorRange.Sheet1 := ASHeet1; + FLineColorRange.Row1 := ARow1; + FLineColorRange.Col1 := ACol1; + FLineColorRange.Sheet2 := ASheet2; + FLineColorRange.Row2 := ARow2; + FLineColorRange.Col2 := ACol2; +end; + procedure TsChartSeries.SetXRange(ARow1, ACol1, ARow2, ACol2: Cardinal); begin SetXRange('', ARow1, ACol1, '', ARow2, ACol2); diff --git a/components/fpspreadsheet/source/common/fpsopendocumentchart.pas b/components/fpspreadsheet/source/common/fpsopendocumentchart.pas index c95eab6de..d9f274641 100644 --- a/components/fpspreadsheet/source/common/fpsopendocumentchart.pas +++ b/components/fpspreadsheet/source/common/fpsopendocumentchart.pas @@ -15,6 +15,9 @@ uses fpsTypes, fpSpreadsheet, fpsChart, fpsUtils, fpsReaderWriter, fpsXMLCommon; type + + { TsSpreadOpenDocChartReader } + TsSpreadOpenDocChartReader = class(TsBasicSpreadChartReader) private FChartFiles: TStrings; @@ -27,12 +30,15 @@ type procedure ReadChartAxisProps(ANode, AStyleNode: TDOMNode; AChart: TsChart); procedure ReadChartAxisStyle(AStyleNode: TDOMNode; AChart: TsChart; Axis: TsChartAxis); procedure ReadChartBackgroundStyle(AStyleNode: TDOMNode; AChart: TsChart); + procedure ReadChartCellAddr(ANode: TDOMNode; ANodeName: String; ACellAddr: TsChartCellAddr); procedure ReadChartCellRange(ANode: TDOMNode; ANodeName: String; ARange: TsChartRange); procedure ReadChartProps(AChartNode, AStyleNode: TDOMNode; AChart: TsChart); procedure ReadChartPlotAreaProps(ANode, AStyleNode: TDOMNode; AChart: TsChart); procedure ReadChartPlotAreaStyle(AStyleNode: TDOMNode; AChart: TsChart); procedure ReadChartLegendProps(ANode, AStyleNode: TDOMNode; AChart: TsChart); procedure ReadChartLegendStyle(AStyleNode: TDOMNode; AChart: TsChart); + procedure ReadChartSeriesProps(ANode, AStyleNode: TDOMNode; AChart: TsChart); + procedure ReadChartSeriesStyle(AStyleNode: TDOMNode; AChart: TsChart; ASeries: TsChartSeries); procedure ReadChartTitleProps(ANode, AStyleNode: TDOMNode; AChart: TsChart; ATitle: TsChartText); procedure ReadChartTitleStyle(AStyleNode: TDOMNode; AChart: TsChart; ATitle: TsChartText); @@ -78,7 +84,7 @@ type function GetNumberFormatID(ANumFormat: String): String; procedure ListAllNumberFormats(AChart: TsChart); - procedure PrepareChartTable(AChart: TsChart; AWorksheet: TsBasicWorksheet); +// procedure PrepareChartTable(AChart: TsChart; AWorksheet: TsBasicWorksheet); protected // Object X/styles.xml @@ -633,6 +639,23 @@ begin end; end; +procedure TsSpreadOpenDocChartReader.ReadChartCellAddr(ANode: TDOMNode; + ANodeName: String; ACellAddr: TsChartCellAddr); +var + s: String; + sh1, sh2: String; + r1, c1, r2, c2: Cardinal; + relFlags: TsRelFlags; +begin + s := GetAttrValue(ANode, ANodeName); + if (s <> '') and TryStrToCellRange_ODS(s, sh1, sh2, r1, c1, r2, c2, relFlags) then + begin + ACellAddr.Sheet := sh1; + ACellAddr.Row := r1; + ACellAddr.Col := c1; + end; +end; + procedure TsSpreadOpenDocChartReader.ReadChartCellRange(ANode: TDOMNode; ANodeName: String; ARange: TsChartRange); var @@ -768,6 +791,8 @@ begin case nodeName of 'chart:axis': ReadChartAxisProps(ANode, AStyleNode, AChart); + 'chart:series': + ReadChartSeriesProps(ANode, AStyleNode, AChart); end; ANode := ANode.NextSibling; end; @@ -855,6 +880,127 @@ begin end; end; +procedure TsSpreadOpenDocChartReader.ReadChartSeriesProps(ANode, AStyleNode: TDOMNode; + AChart: TsChart); +var + s, nodeName: String; + series: TsChartSeries; + subNode: TDOMNode; + styleNode: TDOMNode; + xyCounter: Integer; +begin + s := GetAttrValue(ANode, 'chart:class'); + case s of + 'chart:area': series := TsAreaSeries.Create(AChart); + 'chart:bar': series := TsBarSeries.Create(AChart); + 'chart:bubble': series := TsBubbleSeries.Create(AChart); + 'chart:circle': series := TsPieSeries.Create(AChart); + 'chart:filled-radar': series := TsRadarSeries.Create(AChart); + 'chart:line': series := TsLineSeries.Create(AChart); + 'chart:radar': series := TsRadarSeries.Create(AChart); + 'chart:ring': series := TsRingSeries.Create(AChart); + 'chart:scatter': series := TsScatterSeries.Create(AChart); + else raise Exception.Create('Unknown/unsupported series type.'); + end; + AChart.AddSeries(series); + + ReadChartCellAddr(ANode, 'chart:label-cell-address', series.TitleAddr); + if (series is TsBubbleSeries) then + ReadChartCellRange(ANode, 'chart:values-cell-range-address', TsBubbleSeries(series).BubbleRange) + else + ReadChartCellRange(ANode, 'chart:values-cell-range-address', series.YRange); + + xyCounter := 0; + subnode := ANode.FirstChild; + while subnode <> nil do + begin + nodeName := subNode.NodeName; + case nodeName of + 'chart:domain': + begin + if xyCounter = 0 then + begin + ReadChartCellRange(subnode, 'table:cell-range-address', series.XRange); + inc(xyCounter); + end else + if xyCounter = 1 then + begin + series.YRange.Assign(series.XRange); + ReadChartCellRange(subnode, 'table:cell-range-address', series.XRange) + end; + end; + 'loext:property-mapping': + begin + s := GetAttrValue(subnode, 'loext:property'); + case s of + 'FillColor': + ReadChartCellRange(subNode, 'loext:cell-range-address', series.FillColorRange); + 'BorderColor': + ReadChartCellRange(subNode, 'loext:cell-range-address', series.LineColorRange); + end; + end; + end; + subnode := subNode.NextSibling; + end; + + if series.LabelRange.IsEmpty then series.LabelRange.Assign(AChart.XAxis.CategoryRange); + + s := GetAttrValue(ANode, 'chart:style-name'); + styleNode := FindStyleNode(AStyleNode, s); + ReadChartSeriesStyle(styleNode, AChart, series); +end; + +procedure TsSpreadOpenDocChartReader.ReadChartSeriesStyle(AStyleNode: TDOMNode; + AChart: TsChart; ASeries: TsChartSeries); +var + nodeName: String; + s: String; + css: TsChartSeriesSymbol; + value: Double; + rel: Boolean; +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, ASeries.Line); + GetChartFillProps(AStyleNode, AChart, ASeries.Fill); + end; + 'style:text-properties': + TsSpreadOpenDocReader(Reader).ReadFont(AStyleNode, ASeries.LabelFont); + 'style:chart-properties': + begin + if (ASeries is TsLineSeries) then + begin + s := GetAttrValue(AStyleNode, 'chart:symbol-name'); + if s <> '' then + begin + TsLineSeries(ASeries).ShowSymbols := true; + for css in TsChartSeriesSymbol do + if SYMBOL_NAMES[css] = s then + begin + TsLineSeries(ASeries).Symbol := css; + break; + end; + s := GetAttrValue(AStyleNode, 'symbol-width'); + if (s <> '') and EvalLengthStr(s, value, rel) then + TsLineSeries(ASeries).SymbolWidth := value; + s := GetAttrValue(AStyleNode, 'symbol-height'); + if (s <> '') and EvalLengthStr(s, value, rel) then + TsLineSeries(ASeries).SymbolHeight := value; + end else + TsLineSeries(ASeries).ShowSymbols := false; + end; + end; + + end; + AStyleNode := AStyleNode.NextSibling; + end; +end; + procedure TsSpreadOpenDocChartReader.ReadChartTitleProps(ANode, AStyleNode: TDOMNode; AChart: TsChart; ATitle: TsChartText); var @@ -1823,6 +1969,7 @@ begin end; end; +(* DO NOT DELETE THIS! MAYBE NEEDED LATER... { Extracts the cells needed by the given chart from the chart's worksheet and copies their values into a temporary worksheet, AWorksheet, so that these @@ -1998,6 +2145,7 @@ begin auxSheet.WriteComment(1, destCol, refStr); // Store y range reference as comment for svg node end; end; +*) procedure TsSpreadOpenDocChartWriter.ResetStreams; var @@ -2594,6 +2742,7 @@ var domainRangeX: String = ''; domainRangeY: String = ''; fillColorRange: String = ''; + lineColorRange: String = ''; chartClass: String = ''; regressionEquation: String = ''; needRegressionStyle: Boolean = false; @@ -2656,6 +2805,15 @@ begin rfAllRel, false ); + // Line colors for bars, line series symbols, bubbles etc. + if not series.LineColorRange.IsEmpty then + lineColorRange := GetSheetCellRangeString_ODS( + series.LineColorRange.GetSheet1Name, series.LineColorRange.GetSheet2Name, + series.LineColorRange.Row1, series.LineColorRange.Col1, + series.LineColorRange.Row2, series.LineColorRange.Col2, + rfAllRel, false + ); + // And this is the title of the series for the legend titleAddr := GetSheetCellRangeString_ODS( series.TitleAddr.GetSheetName, series.TitleAddr.GetSheetName, @@ -2675,7 +2833,6 @@ begin else chartClass := CHART_TYPE_NAMES[series.ChartType]; - // Store the series properties AppendToStream(AChartStream, Format( indent + ' '' then AppendToStream(AChartStream, Format( - indent + '' + LE, + indent + '' + LE, [ fillColorRange ] )); - - { --- not working... - if borderColorRange <> '' then + if lineColorRange <> '' then AppendToStream(AChartStream, Format( indent + '' + LE, - [ borderColorRange ] + [ lineColorRange ] )); - } // Regression if (series is TsScatterSeries) then diff --git a/components/fpspreadsheet/source/common/fpsutils.pas b/components/fpspreadsheet/source/common/fpsutils.pas index f7469f020..0fce6f1f5 100644 --- a/components/fpspreadsheet/source/common/fpsutils.pas +++ b/components/fpspreadsheet/source/common/fpsutils.pas @@ -1300,6 +1300,14 @@ end; function GetCellRangeString(ASheet1, ASheet2: String; ARow1, ACol1, ARow2, ACol2: Cardinal; AFlags: TsRelFlags = rfAllRel; Compact: Boolean = false): String; begin + if (ASheet1 = '') and (ASheet2 = '') and + (ARow1 = UNASSIGNED_ROW_COL_INDEX) and (ACol1 = UNASSIGNED_ROW_COL_INDEX) and + (ARow2 = UNASSIGNED_ROW_COL_INDEX) and (ACol2 = UNASSIGNED_ROW_COL_INDEX) then + begin + Result := ''; + exit; + end; + Result := GetCellRangeString(ARow1, ACol1, ARow2, ACol2, AFlags, Compact); if (ASheet1 = '') and (ASheet2 = '') then exit;