From 79adfa0460a9eb9cd1a0c10aaaf670aeaf352c0a Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Fri, 22 Dec 2023 00:39:36 +0000 Subject: [PATCH] fpspreadsheet: Chart link and ods reader support error bars (not complete, yet). git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9099 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../fpspreadsheet/source/common/fpschart.pas | 63 +++++++++----- .../source/common/fpsopendocumentchart.pas | 83 ++++++++++++++++++ .../source/visual/fpspreadsheetchart.pas | 85 ++++++++++++++++++- 3 files changed, 210 insertions(+), 21 deletions(-) diff --git a/components/fpspreadsheet/source/common/fpschart.pas b/components/fpspreadsheet/source/common/fpschart.pas index ea1416a55..fc074be4c 100644 --- a/components/fpspreadsheet/source/common/fpschart.pas +++ b/components/fpspreadsheet/source/common/fpschart.pas @@ -347,26 +347,29 @@ type property Items[AIndex: Integer]: TsChartDataPointStyle read GetItem write SetItem; default; end; - TsChartErrorBarKind = (cebkConstant, cebkPercentage, cebkStdDev, cebkRange); + TsChartErrorBarKind = (cebkConstant, cebkPercentage, cebkRange); TsChartErrorBars = class(TsChartElement) private FKind: TsChartErrorBarKind; FLine: TsChartLine; - FValue: Array[0..1] of Double; // 0 = positive, 1 = negative error bar value FRange: Array[0..1] of TsChartRange; + FValue: Array[0..1] of Double; // 0 = positive, 1 = negative error bar value + FShow: Array[0..1] of Boolean; function GetRange(AIndex: Integer): TsChartRange; + function GetShow(AIndex: Integer): Boolean; function GetValue(AIndex: Integer): Double; procedure InternalSetErrorBarRange(AIndex: Integer; ASheet1: String; ARow1, ACol1: Cardinal; ASheet2: String; ARow2, ACol2: Cardinal); procedure SetLine(AValue: TsChartLine); procedure SetRange(AIndex: Integer; AValue: TsChartRange); + procedure SetShow(AIndex: Integer; AValue: Boolean); procedure SetValue(AIndex: Integer; AValue: Double); public constructor Create(AChart: TsChart); destructor Destroy; override; - procedure CopyFrom(ASource: TsChartElement); + procedure CopyFrom(ASource: TsChartElement); override; procedure SetErrorBarRangePos(ARow1, ACol1, ARow2, ACol2: Cardinal); procedure SetErrorBarRangePos(ASheet1: String; ARow1, ACol1: Cardinal; ASheet2: String; ARow2, ACol2: Cardinal); procedure SetErrorBarRangeNeg(ARow1, ACol1, ARow2, ACol2: Cardinal); @@ -375,6 +378,8 @@ type property Line: TsChartLine read FLine write SetLine; property RangePos: TsChartRange index 0 read GetRange write SetRange; property RangeNeg: TsChartRange index 1 read GetRange write SetRange; + property ShowPos: Boolean index 0 read GetShow write SetShow; + property ShowNeg: Boolean index 1 read GetShow write SetShow; property ValuePos: Double index 0 read GetValue write SetValue; property ValueNeg: Double index 1 read GetValue write SetValue; end; @@ -398,13 +403,14 @@ type FLabelFormat: String; FDataLabels: TsChartDataLabels; FDataPointStyles: TsChartDataPointStyleList; - FErrorBars: TsChartErrorBars; - procedure SetErrorBars(AValue: TsChartErrorBars); + FXErrorBars: TsChartErrorBars; + FYErrorBars: TsChartErrorBars; + procedure SetXErrorBars(AValue: TsChartErrorBars); + procedure SetYErrorBars(AValue: TsChartErrorBars); protected FLine: TsChartLine; FFill: TsChartFill; function GetChartType: TsChartType; virtual; - property ErrorBars: TsChartErrorBars read FErrorBars write SetErrorBars; public constructor Create(AChart: TsChart); virtual; destructor Destroy; override; @@ -445,8 +451,10 @@ type property LineColorRange: TsChartRange read FLineColorRange write FLineColorRange; property TitleAddr: TsChartCellAddr read FTitleAddr write FTitleAddr; // use '\n' for line-break property XAxis: TsChartAxisLink read FXAxis write FXAxis; + property XErrorBars: TsChartErrorBars read FXErrorBars write SetXErrorBars; property XRange: TsChartRange read FXRange write FXRange; property YAxis: TsChartAxisLink read FYAxis write FYAxis; + property YErrorBars: TsChartErrorBars read FYErrorBars write SetYErrorBars; property YRange: TsChartRange read FYRange write FYRange; property Fill: TsChartFill read FFill write FFill; @@ -457,13 +465,11 @@ type TsAreaSeries = class(TsChartSeries) public constructor Create(AChart: TsChart); override; - property ErrorBars; end; TsBarSeries = class(TsChartSeries) public constructor Create(AChart: TsChart); override; - property ErrorBars; end; TsChartSeriesSymbol = ( @@ -496,7 +502,6 @@ type TsLineSeries = class(TsCustomLineSeries) public - property ErrorBars; property Symbol; property SymbolBorder; property SymbolFill; @@ -575,7 +580,6 @@ type TsScatterSeries = class(TsCustomScatterSeries) public - property ErrorBars; property Symbol; property SymbolBorder; property SymbolFill; @@ -1561,6 +1565,8 @@ begin FLine.Color := scBlack; FRange[0] := TsChartRange.Create(AChart); FRange[1] := TsChartRange.Create(AChart); + FShow[0] := true; + FShow[1] := true; end; destructor TsChartErrorBars.Destroy; @@ -1576,12 +1582,14 @@ begin inherited CopyFrom(ASource); if ASource is TsChartErrorBars then begin - FLine.CopyFrom(TsChartErrorBars(ASource).Line); + FKind := TsChartErrorBars(ASource).Kind; FRange[0].CopyFrom(TsChartErrorBars(ASource).RangePos); FRange[1].CopyFrom(TsChartErrorBars(ASource).RangeNeg); + FShow[0] := TsChartErrorBars(ASource).ShowPos; + FShow[1] := TsChartErrorBars(ASource).ShowNeg; FValue[0] := TsChartErrorBars(ASource).ValuePos; FValue[1] := TsChartErrorBars(ASource).ValueNeg; - FKind := TsChartErrorBars(ASource).Kind; + FLine.CopyFrom(TsChartErrorBars(ASource).Line); end; end; @@ -1590,6 +1598,11 @@ begin Result := FRange[AIndex]; end; +function TsChartErrorBars.GetShow(AIndex: Integer): Boolean; +begin + Result := FShow[AIndex]; +end; + function TsChartErrorBars.GetValue(AIndex: Integer): Double; begin result := FValue[AIndex]; @@ -1641,6 +1654,11 @@ begin FRange[AIndex].CopyFrom(AValue); end; +procedure TsChartErrorBars.SetShow(AIndex: Integer; AValue: Boolean); +begin + FShow[AIndex] := AValue; +end; + procedure TsChartErrorBars.SetValue(AIndex: Integer; AValue: Double); begin FValue[AIndex] := AValue; @@ -1690,12 +1708,14 @@ begin FLabelSeparator := ' '; - FErrorBars := TsChartErrorBars.Create(AChart); + FXErrorBars := TsChartErrorBars.Create(AChart); + FYErrorBars := TsChartErrorBars.Create(AChart); end; destructor TsChartSeries.Destroy; begin - FErrorBars.Free; + FYErrorBars.Free; + FXErrorBars.Free; FLabelBackground.Free; FLabelBorder.Free; FLabelFont.Free; @@ -1760,11 +1780,6 @@ begin Result := (FLabelRange.Col1 = FLabelRange.Col2) and (FLabelRange.Row1 <> FLabelRange.Row2); end; -procedure TsChartSeries.SetErrorBars(AValue: TsChartErrorBars); -begin - FErrorBars.CopyFrom(AValue); -end; - procedure TsChartSeries.SetTitleAddr(ARow, ACol: Cardinal); begin SetTitleAddr('', ARow, ACol); @@ -1831,6 +1846,11 @@ begin FLineColorRange.Col2 := ACol2; end; +procedure TsChartSeries.SetXErrorBars(AValue: TsChartErrorBars); +begin + FXErrorBars.CopyFrom(AValue); +end; + procedure TsChartSeries.SetXRange(ARow1, ACol1, ARow2, ACol2: Cardinal); begin SetXRange('', ARow1, ACol1, '', ARow2, ACol2); @@ -1849,6 +1869,11 @@ begin FXRange.Col2 := ACol2; end; +procedure TsChartSeries.SetYErrorBars(AValue: TsChartErrorBars); +begin + FYErrorBars.CopyFrom(AValue); +end; + procedure TsChartSeries.SetYRange(ARow1, ACol1, ARow2, ACol2: Cardinal); begin SetYRange('', ARow1, ACol1, '', ARow2, ACol2); diff --git a/components/fpspreadsheet/source/common/fpsopendocumentchart.pas b/components/fpspreadsheet/source/common/fpsopendocumentchart.pas index 82d79bb16..3e9ddd763 100644 --- a/components/fpspreadsheet/source/common/fpsopendocumentchart.pas +++ b/components/fpspreadsheet/source/common/fpsopendocumentchart.pas @@ -50,6 +50,10 @@ type procedure ReadChartRegressionStyle(AStyleNode: TDOMNode; AChart: TsChart; ASeries: TsChartSeries); procedure ReadChartSeriesDataPointStyle(AStyleNode: TDOMNode; AChart: TsChart; ASeries: TsChartSeries; var AFill: TsChartFill; var ALine: TsChartLine); + procedure ReadChartSeriesErrorBarProps(ANode, AStyleNode: TDOMNode; AChart: TsChart; + ASeries: TsChartSeries); + procedure ReadChartSeriesErrorBarStyle(AStyleNode: TDOMNode; AChart: TsChart; + AErrorBars: TsChartErrorBars); procedure ReadChartSeriesProps(ANode, AStyleNode: TDOMNode; AChart: TsChart); procedure ReadChartSeriesStyle(AStyleNode: TDOMNode; AChart: TsChart; ASeries: TsChartSeries); procedure ReadChartStockSeriesStyle(AStyleNode: TDOMNode; AChart: TsChart; @@ -1305,6 +1309,83 @@ begin end; end; +procedure TsSpreadOpenDocChartReader.ReadChartSeriesErrorBarProps( + ANode, AStyleNode: TDOMNode; AChart: TsChart; ASeries: TsChartSeries); +var + s: String; + styleNode: TDOMNode; + errorBars: TsChartErrorBars; +begin + s := GetAttrValue(ANode, 'chart:dimension'); + case s of + 'x': errorBars := ASeries.XErrorBars; + 'y': errorBars := ASeries.YErrorBars; + else exit; + end; + + s := GetAttrValue(ANode, 'chart:style-name'); + if s <> '' then + begin + styleNode := FindStyleNode(AStyleNode, s); + ReadChartSeriesErrorBarStyle(styleNode, AChart, errorBars); + end; +end; + +procedure TsSpreadOpenDocChartReader.ReadChartSeriesErrorBarStyle( + AStyleNode: TDOMNode; AChart: TsChart; AErrorBars: TsChartErrorBars); +var + nodeName, s: String; + x: Double; +begin + AStyleNode := AStyleNode.FirstChild; + while AStyleNode <> nil do + begin + nodeName := AStyleNode.NodeName; + case nodeName of + 'style:chart-properties': + begin + s := GetAttrValue(AStyleNode, 'chart:error-category'); + case s of + 'constant': AErrorBars.Kind := cebkConstant; + 'cell-range': AErrorBars.Kind := cebkRange; + 'percentage': AErrorBars.Kind := cebkPercentage; + else + exit; + // To do: support the statistical categories 'standard-error', + // 'variance', 'standard-deviation', 'error-margin' + end; + + s := GetAttrValue(AStyleNode, 'chart:error-lower-limit'); + if (s <> '') and TryStrToFloat(s, x, FPointSeparatorSettings) then + AErrorBars.ValueNeg := x; + + s := GetAttrValue(AStyleNode, 'chart:error-upper-limit'); + if (s <> '') and TryStrToFloat(s, x, FPointSeparatorSettings) then + AErrorBars.ValuePos := x; + + s := GetAttrValue(AStyleNode, 'chart:error-lower-indicator'); + AErrorBars.ShowNeg := (s = 'true'); + + s := GetAttrValue(AStyleNode, 'chart:error-upper-indicator'); + AErrorBars.ShowPos := (s = 'true'); + + s := GetAttrValue(AStyleNode, 'chart:error-percentage'); + if (s <> '') and TryStrToFloat(s, x, FPointSeparatorSettings) then + begin + AErrorBars.ValueNeg := x; + AErrorBars.ValuePos := x; + end; + + ReadChartCellRange(AStyleNode, 'chart:error-lower-range', AErrorBars.RangeNeg); + ReadChartCellRange(AStyleNode, 'chart:error-upper-range', AErrorBars.RangePos); + end; + 'style:graphic-properties': + GetChartLineProps(AStyleNode, AChart, AErrorBars.Line); + end; + AStyleNode := AStyleNode.NextSibling; + end; +end; + procedure TsSpreadOpenDocChartReader.ReadChartSeriesProps(ANode, AStyleNode: TDOMNode; AChart: TsChart); var @@ -1414,6 +1495,8 @@ begin fill.Free; // the styles have been copied to the series datapoint list and are not needed any more. line.Free; end; + 'chart:error-indicator': + ReadChartSeriesErrorbarProps(subNode, AStyleNode, AChart, series); end; subnode := subNode.NextSibling; end; diff --git a/components/fpspreadsheet/source/visual/fpspreadsheetchart.pas b/components/fpspreadsheet/source/visual/fpspreadsheetchart.pas index 240cad05e..d6a91e5c5 100644 --- a/components/fpspreadsheet/source/visual/fpspreadsheetchart.pas +++ b/components/fpspreadsheet/source/visual/fpspreadsheetchart.pas @@ -41,7 +41,7 @@ type { TsWorkbookChartSource } - TsXYLRange = (rngX, rngY, rngLabel, rngColor); + TsXYLRange = (rngX, rngY, rngLabel, rngColor, rngXErrors, rngYErrors); TsWorkbookChartSource = class(TCustomChartSource, IsSpreadsheetControl) private @@ -85,6 +85,8 @@ type procedure SetXRange(XIndex: Integer; ARange: TsChartRange); procedure SetYRange(YIndex: Integer; ARange: TsChartRange); procedure SetTitleAddr(Addr: TsChartCellAddr); + procedure SetXErrorBarRange(ARange: TsChartRange); + procedure SetYErrorBarRange(ARange: TsChartRange); procedure UseDataPointColors(ASeries: TsChartSeries); property PointsNumber: Cardinal read FPointsNumber; property Workbook: TsWorkbook read GetWorkbook; @@ -98,9 +100,14 @@ type property CyclicX: Boolean read FCyclicX write FCyclicX default false; property IntegerX: Boolean read FIntegerX write FIntegerX default false; property LabelRange: String index rngLabel read GetRange write SetRange; + property XErrorBarRange: String index rngXErrors read GetRange write SetRange; + property YErrorBarRange: String index rngYErrors read GetRange write SetRange; property XRange: String index rngX read GetRange write SetRange; property YRange: String index rngY read GetRange write SetRange; property Title: String read GetTitle; + + property XErrorBarData; + property YErrorBarData; end; {@@ Link between TAChart and the fpspreadsheet chart class } @@ -148,6 +155,7 @@ type procedure UpdateChartBackground(AWorkbookChart: TsChart); // procedure UpdateBarSeries(AWorkbookChart: TsChart); procedure UpdateChartBrush(AWorkbookChart: TsChart; AWorkbookFill: TsChartFill; ABrush: TBrush); + procedure UpdateChartErrorBars(AWorkbookSeries: TsChartSeries; ASeries: TBasicPointSeries); procedure UpdateChartLegend(AWorkbookLegend: TsChartLegend; ALegend: TChartLegend); procedure UpdateChartPen(AWorkbookChart: TsChart; AWorkbookLine: TsChartLine; APen: TPen); procedure UpdateChartSeriesMarks(AWorkbookSeries: TsChartSeries; AChartSeries: TChartSeries); @@ -177,7 +185,6 @@ type property Chart: TChart read FChart write SetChart; property WorkbookChartIndex: Integer read FWorkbookChartIndex write SetWorkbookChartIndex; property WorkbookSource: TsWorkbookSource read FWorkbookSource write SetWorkbookSource; - end; procedure Convert_sChartLine_to_Pen(AChart: TsChart; ALine: TsChartLine; APen: TPen); @@ -910,11 +917,21 @@ begin FTitleSheetName := Addr.GetSheetName; end; +procedure TsWorkbookChartSource.SetXErrorBarRange(ARange: TsChartRange); +begin + SetRangeFromChart(rngXErrors, 0, ARange); +end; + procedure TsWorkbookChartSource.SetXRange(XIndex: Integer; ARange: TsChartRange); begin SetRangeFromChart(rngX, XIndex, ARange); end; +procedure TsWorkbookChartSource.SetYErrorBarRange(ARange: TsChartRange); +begin + SetRangeFromChart(rngYErrors, 0, ARange); +end; + procedure TsWorkbookChartSource.SetYRange(YIndex: Integer; ARange: TsChartRange); begin SetRangeFromChart(rngY, YIndex, ARange); @@ -1686,6 +1703,7 @@ begin AChartSeries.UseZeroLevel := true; if AChartSeries.Source is TCalculatedChartSource then TCalculatedChartSource(AChartSeries.Source).Percentage := (AWorkbookSeries.Chart.StackMode = csmStackedPercentage); + UpdateChartErrorBars(AWorkbookSeries, AChartSeries); end; procedure TsWorkbookChartLink.UpdateBarSeries(AWorkbookSeries: TsBarSeries; @@ -1697,6 +1715,7 @@ begin AChartSeries.Stacked := AWorkbookSeries.Chart.StackMode <> csmSideBySide; if AChartSeries.Source is TCalculatedChartSource then TCalculatedChartSource(AChartSeries.Source).Percentage := (AWorkbookSeries.Chart.StackMode = csmStackedPercentage); + UpdateChartErrorBars(AWorkbookSeries, AChartSeries); end; procedure TsWorkbookChartlink.UpdateBubbleSeries(AWorkbookSeries: TsBubbleSeries; @@ -1970,6 +1989,63 @@ begin end; end; +type + TErrorbarSeries = class(TBasicPointSeries) + public + property XErrorBars; + property YErrorBars; + end; + +procedure TsWorkbookChartLink.UpdateChartErrorBars(AWorkbookSeries: TsChartSeries; + ASeries: TBasicPointSeries); +const + ERRORBAR_KINDS: array[TsChartErrorBarKind] of TChartErrorBarKind = ( + ebkConst, ebkPercent, ebkChartSource); + + function GetChartSource(ASource: TCustomChartSource): TsWorkbookChartSource; + begin + if ASource is TsWorkbookChartSource then + Result := TsWorkbookChartSource(ASource) + else if (ASource is TCalculatedChartSource) then + Result := GetChartSource(TCalculatedChartSource(ASource).Origin) + else + Result := nil; + end; + +var + series: TErrorBarSeries; + source: TsWorkbookChartSource; +begin + source := GetChartSource(ASeries.Source); + if source = nil then + exit; + + series := TErrorBarSeries(ASeries); + + series.XErrorBars.Visible := AWorkbookSeries.XErrorBars.ShowPos or AWorkbookSeries.XErrorBars.ShowNeg;; + series.YErrorBars.Visible := AWorkbookSeries.YErrorBars.ShowPos or AWorkbookSeries.YErrorBars.ShowNeg;; + + UpdateChartPen(AWorkbookSeries.Chart, AWorkbookSeries.XErrorBars.Line, series.XErrorBars.Pen); + UpdateChartPen(AWorkbookSeries.Chart, AWorkbookSeries.YErrorBars.Line, series.YErrorBars.Pen); + + source.XErrorBarData.Kind := ERRORBAR_KINDS[AWorkbookSeries.XErrorBars.Kind]; + source.YErrorBarData.Kind := ERRORBAR_KINDS[AWorkbookSeries.YErrorBars.Kind]; + + source.XErrorBarData.ValuePlus := AWorkbookSeries.XErrorBars.ValuePos; + source.YErrorBarData.ValuePlus := AWorkbookSeries.YErrorBars.ValuePos; + + source.XErrorBarData.ValueMinus := AWorkbookSeries.XErrorBars.ValueNeg; + source.YErrorBarData.ValueMinus := AWorkbookSeries.YErrorBars.ValueNeg; + + { To do: pass the cell range to the workbookchartsource. There's a problem + with the following code that TAChart assumes the error values to be stored + in additional x and y values of the TChartDataItem... + + if AWorkbookSeries.XErrorBars.Kind = cebkRange then + source.SetXErrorBarRange(AWorkbookSeries.XErrorBars.Range + } +end; + procedure TsWorkbookChartLink.UpdateChartLegend(AWorkbookLegend: TsChartLegend; ALegend: TChartLegend); const @@ -2156,6 +2232,8 @@ begin AChartSeries.Stacked := AWorkbookSeries.Chart.StackMode <> csmSideBySide; if AChartSeries.Source is TCalculatedChartSource then TCalculatedChartSource(AChartSeries.Source).Percentage := (AWorkbookSeries.Chart.StackMode = csmStackedPercentage); + + UpdateChartErrorBars(AWorkbookSeries, AChartSeries); end; procedure TsWorkbookChartLink.UpdatePieSeries(AWorkbookSeries: TsPieSeries; @@ -2262,6 +2340,9 @@ begin ser.Title := ser.Title + LineEnding + s; // ser.Legend.Format := '%0:s' + LineEnding + '%2:s'; end; + + // Error bars + UpdateChartErrorBars(AWorkbookSeries, AChartSeries); end; procedure TsWorkbookChartLink.UpdateStockSeries(AWorkbookSeries: TsStockSeries;