From 71f5985598c18ab9533fa54974ee39d12d086e13 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Wed, 22 Nov 2023 14:23:55 +0000 Subject: [PATCH] fpspreadsheet: Chart link supports bar, line and area series. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9037 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../fpschart/fpschartlink/chart_demo.lpi | 1 + .../source/common/fpsopendocumentchart.pas | 2 + .../source/visual/fpspreadsheetchart.pas | 356 +++++++++++++++--- 3 files changed, 305 insertions(+), 54 deletions(-) diff --git a/components/fpspreadsheet/examples/visual/fpschart/fpschartlink/chart_demo.lpi b/components/fpspreadsheet/examples/visual/fpschart/fpschartlink/chart_demo.lpi index d59e9b4e0..dd2428053 100644 --- a/components/fpspreadsheet/examples/visual/fpschart/fpschartlink/chart_demo.lpi +++ b/components/fpspreadsheet/examples/visual/fpschart/fpschartlink/chart_demo.lpi @@ -47,6 +47,7 @@ + diff --git a/components/fpspreadsheet/source/common/fpsopendocumentchart.pas b/components/fpspreadsheet/source/common/fpsopendocumentchart.pas index 1a31e4843..ded5bbbbb 100644 --- a/components/fpspreadsheet/source/common/fpsopendocumentchart.pas +++ b/components/fpspreadsheet/source/common/fpsopendocumentchart.pas @@ -1208,6 +1208,8 @@ begin case nodeName of 'style:graphic-properties': begin + if ASeries.ChartType in [ctBar] then + ASeries.Line.Style := clsSolid; GetChartLineProps(AStyleNode, AChart, ASeries.Line); GetChartFillProps(AStyleNode, AChart, ASeries.Fill); end; diff --git a/components/fpspreadsheet/source/visual/fpspreadsheetchart.pas b/components/fpspreadsheet/source/visual/fpspreadsheetchart.pas index a11f823f0..8351a11ff 100644 --- a/components/fpspreadsheet/source/visual/fpspreadsheetchart.pas +++ b/components/fpspreadsheet/source/visual/fpspreadsheetchart.pas @@ -19,7 +19,7 @@ interface uses Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, // TChart - TATypes, TATextElements, TACustomSource, + TATypes, TATextElements, TAChartUtils, TACustomSource, TACustomSeries, TASeries, TAChartAxisUtils, TAChartAxis, TALegend, TAGraph, // FPSpreadsheet Visual fpSpreadsheetCtrls, fpSpreadsheetGrid, fpsVisualUtils, @@ -36,21 +36,24 @@ type { TsWorkbookChartSource } - TsXYLRange = (rngX, rngY, rngLabel); + TsXYLRange = (rngX, rngY, rngLabel, rngColor); TsWorkbookChartSource = class(TCustomChartSource, IsSpreadsheetControl) private FWorkbookSource: TsWorkbookSource; -// FWorkbook: TsWorkbook; FWorksheets: array[TsXYLRange] of TsWorksheet; FRangeStr: array[TsXYLRange] of String; FRanges: array[TsXYLRange] of TsCellRangeArray; FPointsNumber: Cardinal; + FTitleCol, FTitleRow: Cardinal; + FTitleSheetName: String; function GetRange(AIndex: TsXYLRange): String; + function GetTitle: String; function GetWorkbook: TsWorkbook; procedure GetXYItem(ARangeIndex:TsXYLRange; APointIndex: Integer; out ANumber: Double; out AText: String); procedure SetRange(AIndex: TsXYLRange; const AValue: String); + procedure SetRangeFromChart(AIndex: TsXYLRange; const ARange: TsChartRange); procedure SetWorkbookSource(AValue: TsWorkbookSource); protected FCurItem: TChartDataItem; @@ -65,6 +68,11 @@ type public destructor Destroy; override; procedure Reset; + procedure SetColorRange(ARange: TsChartRange); + procedure SetLabelRange(ARange: TsChartRange); + procedure SetXRange(ARange: TsChartRange); + procedure SetYRange(ARange: TsChartRange); + procedure SetTitleAddr(Addr: TsChartCellAddr); property PointsNumber: Cardinal read FPointsNumber; property Workbook: TsWorkbook read GetWorkbook; public @@ -73,9 +81,11 @@ type procedure RemoveWorkbookSource; published property WorkbookSource: TsWorkbookSource read FWorkbookSource write SetWorkbookSource; + property ColorRange: String index rngColor read GetRange write SetRange; property LabelRange: String index rngLabel 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; end; {@@ Link between TAChart and the fpspreadsheet chart class } @@ -95,11 +105,14 @@ type protected procedure Notification(AComponent: TComponent; Operation: TOperation); override; + procedure AddSeries(ASeries: TsChartSeries); + procedure FixAreaSeries(AWorkbookChart: TsChart); procedure ClearChart; function GetWorkbookChart: TsChart; - procedure PopulateChart; procedure UpdateChartAxis(AWorkbookAxis: TsChartAxis); + procedure UpdateChartAxisLabels(AWorkbookChart: TsChart); procedure UpdateChartBackground(AWorkbookChart: TsChart); + procedure UpdateBarSeries(AWorkbookChart: TsChart); procedure UpdateChartBrush(AWorkbookFill: TsChartFill; ABrush: TBrush); procedure UpdateChartLegend(AWorkbookLegend: TsChartLegend; ALegend: TChartLegend); procedure UpdateChartPen(AWorkbookLine: TsChartLine; APen: TPen); @@ -109,6 +122,8 @@ type constructor Create(AOwner: TComponent); override; destructor Destroy; override; + procedure UpdateChart; + { Interfacing with WorkbookSource} procedure ListenerNotification(AChangedItems: TsNotificationItems; AData: Pointer = nil); procedure RemoveWorkbookSource; @@ -126,6 +141,11 @@ implementation uses Math; +function mmToPx(mm: Double; ppi: Integer): Integer; +begin + Result := round(mmToIn(mm * ppi)); +end; + {------------------------------------------------------------------------------} { TsWorkbookChartSource } {------------------------------------------------------------------------------} @@ -214,11 +234,23 @@ var dummyString: String; tmpLabel: String; begin - GetXYItem(rngX, AIndex, FCurItem.X, tmpLabel); + if FRanges[rngX] <> nil then + GetXYItem(rngX, AIndex, FCurItem.X, tmpLabel) + else + FCurItem.X := AIndex; + GetXYItem(rngY, AIndex, FCurItem.Y, dummyString); + GetXYItem(rngLabel, AIndex, dummyNumber, FCurItem.Text); if FCurItem.Text = '' then FCurItem.Text := tmpLabel; - FCurItem.Color := clDefault; + + if FRanges[rngColor] <> nil then + begin + GetXYItem(rngColor, AIndex, dummyNumber, dummyString); + FCurItem.Color := round(dummyNumber); + end else + FCurItem.Color := clDefault; + Result := @FCurItem; end; @@ -236,6 +268,18 @@ begin Result := FRangeStr[AIndex]; end; +function TsWorkbookChartSource.GetTitle: String; +var + sheet: TsWorksheet; +begin + Result := ''; + if FWorkbookSource = nil then + exit; + sheet := FWorkbookSource.Workbook.GetWorksheetByName(FTitleSheetName); + if sheet <> nil then + Result := sheet.ReadAsText(FTitleRow, FTitleCol); +end; + {@@ ---------------------------------------------------------------------------- Getter method for the linked workbook -------------------------------------------------------------------------------} @@ -401,6 +445,7 @@ end; -------------------------------------------------------------------------------} procedure TsWorkbookChartSource.Prepare; begin + Prepare(rngColor); Prepare(rngLabel); Prepare(rngX); Prepare(rngY); @@ -410,21 +455,19 @@ end; Parses the range string of the data specified by AIndex and extracts internal information (worksheet used, cell range coordinates) - @param AIndex Identifies whether x or y or label cell ranges are analyzed + @param AIndex Identifies whether x or y or label or color cell ranges are + analyzed -------------------------------------------------------------------------------} procedure TsWorkbookChartSource.Prepare(AIndex: TsXYLRange); -{ -const - XY: array[TsXYRange] of string = ('x', 'y', ''); - } var range: TsCellRange; begin - if (Workbook = nil) or (FRangeStr[AIndex] = '') //or (FWorksheets[AIndex] = nil) - then begin + if (Workbook = nil) or (FRangeStr[AIndex] = '') then + begin FWorksheets[AIndex] := nil; SetLength(FRanges[AIndex], 0); - FPointsNumber := 0; + if AIndex = rngY then + FPointsNumber := 0; Reset; exit; end; @@ -443,13 +486,6 @@ begin if (Workbook.GetWorksheetCount > 0) then begin if FWorksheets[AIndex] = nil then exit; - { - raise Exception.CreateFmt('Worksheet of %s cell range "%s" does not exist.', - [XY[AIndex], FRangeStr[AIndex]]) - else - raise Exception.CreateFmt('No valid %s cell range in "%s".', - [XY[AIndex], FRangeStr[AIndex]]); - } end; end; @@ -472,6 +508,35 @@ begin Notify; end; +procedure TsWorkbookChartSource.SetColorRange(ARange: TsChartRange); +begin + SetRangeFromChart(rngColor, ARange); +end; + +procedure TsWorkbookChartSource.SetLabelRange(ARange: TsChartRange); +begin + SetRangeFromChart(rngLabel, ARange); +end; + +{@@ ---------------------------------------------------------------------------- + Shared method to set the cell ranges for x, y, labels or colors directly from + the chart ranges. +-------------------------------------------------------------------------------} +procedure TsWorkbookChartSource.SetRangeFromChart(AIndex: TsXYLRange; + const ARange: TsChartRange); +begin + if ARange.Sheet1 <> ARange.Sheet2 then + raise Exception.Create('A chart cell range can only be from a single worksheet.'); + SetLength(FRanges[AIndex], 1); + FRanges[AIndex,0].Row1 := ARange.Row1; // FIXME: Assuming here single-block range !!! + FRanges[AIndex,0].Col1 := ARange.Col1; + FRanges[AIndex,0].Row2 := ARange.Row2; + FRanges[AIndex,0].Col2 := ARange.Col2; + FWorksheets[AIndex] := FworkbookSource.Workbook.GetWorksheetByName(ARange.Sheet1); + if AIndex in [rngX, rngY] then + FPointsNumber := Max(CountValues(rngX), CountValues(rngY)); +end; + {@@ ---------------------------------------------------------------------------- Setter method for the cell range used for x or y data (or labels) in the chart If it does not contain the worksheet name the currently active worksheet of @@ -491,6 +556,23 @@ begin Prepare; end; +procedure TsWorkbookChartSource.SetTitleAddr(Addr: TsChartCellAddr); +begin + FTitleRow := Addr.Row; + FTitleCol := Addr.Col; + FTitleSheetName := Addr.GetSheetName; +end; + +procedure TsWorkbookChartSource.SetXRange(ARange: TsChartRange); +begin + SetRangeFromChart(rngX, ARange); +end; + +procedure TsWorkbookChartSource.SetYRange(ARange: TsChartRange); +begin + SetRangeFromChart(rngY, ARange); +end; + {@@ ---------------------------------------------------------------------------- Setter method for the WorkbookSource -------------------------------------------------------------------------------} @@ -538,13 +620,92 @@ begin inherited; end; +procedure TsWorkbookChartLink.AddSeries(ASeries: TsChartSeries); +const + POINTER_STYLES: array[TsChartSeriesSymbol] of TSeriesPointerstyle = ( + psRectangle, + psDiamond, + psTriangle, + psDownTriangle, + psLeftTriangle, + psRightTriangle, + psCircle, + psStar, + psDiagCross, + psCross, + psFullStar + ); +var + src: TsWorkbookChartSource; + ser: TChartSeries; + ppi: Integer; +begin + src := TsWorkbookChartSource.Create(self); + src.WorkbookSource := FWorkbookSource; + if not ASeries.LabelRange.IsEmpty then src.SetLabelRange(ASeries.LabelRange); + if not ASeries.XRange.IsEmpty then src.SetXRange(ASeries.XRange); + if not ASeries.YRange.IsEmpty then src.SetYRange(ASeries.YRange); + if not ASeries.FillColorRange.IsEmpty then src.SetColorRange(ASeries.FillColorRange); + + ppi := GetParentForm(FChart).PixelsPerInch; + case ASeries.ChartType of + ctBar: + begin + ser := TBarSeries.Create(FChart); + UpdateChartBrush(ASeries.Fill, TBarSeries(ser).BarBrush); + UpdateChartPen(ASeries.Line, TBarSeries(ser).BarPen); + end; + ctLine, ctScatter: + begin + ser := TLineSeries.Create(FChart); + UpdateChartPen(ASeries.Line, TLineSeries(ser).LinePen); + TLineSeries(ser).ShowLines := ASeries.Line.Style <> clsNoLine; + TLineSeries(ser).ShowPoints := TsLineSeries(ASeries).ShowSymbols; + if TLineSeries(ser).ShowPoints then + begin + UpdateChartBrush(ASeries.Fill, TLineSeries(ser).Pointer.Brush); + TLineSeries(ser).Pointer.Pen.Color := TLineSeries(ser).LinePen.Color; + TLineSeries(ser).Pointer.Style := POINTER_STYLES[TsLineSeries(ASeries).Symbol]; + TlineSeries(ser).Pointer.HorizSize := mmToPx(TsLineSeries(ASeries).SymbolWidth, ppi); + TlineSeries(ser).Pointer.VertSize := mmToPx(TsLineSeries(ASeries).SymbolHeight, ppi); + end; + end; + ctArea: + begin + ser := TAreaSeries.Create(FChart); + UpdateChartBrush(ASeries.Fill, TAreaSeries(ser).AreaBrush); + UpdateChartPen(ASeries.Line, TAreaSeries(ser).AreaContourPen); + TAreaSeries(ser).AreaLinesPen.Style := psClear; + end; + end; + src.SetTitleAddr(ASeries.TitleAddr); + ser.Source := src; + ser.Title := src.Title; + ser.Transparency := round(ASeries.Fill.Transparency); + FChart.AddSeries(ser); +end; + procedure TsWorkbookChartLink.ClearChart; var i, j: Integer; + ser: TChartSeries; + src: TCustomChartSource; begin if FChart = nil then exit; + // Clear chart sources + for i := 0 to FChart.SeriesCount-1 do + begin + if (FChart.Series[i] is TChartSeries) then + begin + ser := TChartSeries(FChart.Series[i]); + src := ser.Source; + if src is TsWorkbookChartSource then + src.Free; + end; + end; + // Clear the series FChart.ClearSeries; @@ -568,6 +729,29 @@ begin FChart.Foot.Text.Clear; end; +// Fix area series zero level not being clipped at chart's plotrect. +procedure TsWorkbookChartLink.FixAreaSeries(AWorkbookChart: TsChart); +var + i: Integer; + ser: TAreaSeries; + ext: TDoubleRect; +begin + if AWorkbookChart.GetChartType <> ctArea then + exit; + + ext := FChart.LogicalExtent; + for i := 0 to FChart.SeriesCount-1 do + if FChart.Series[i] is TAreaSeries then + begin + ser := TAreaSeries(FChart.Series[i]); + if ser.ZeroLevel < ext.a.y then + ser.ZeroLevel := ext.a.y; + if ser.ZeroLevel > ext.b.y then + ser.ZeroLevel := ext.b.y; + ser.UseZeroLevel := true; + end; +end; + function TsWorkbookChartLink.GetWorkbookChart: TsChart; begin if (FWorkbook <> nil) and (FWorkbookChartIndex > -1) then @@ -600,9 +784,43 @@ begin SetWorkbookSource(nil); end; -procedure TsWorkbookChartLink.PopulateChart; +procedure TsWorkbookChartLink.SetChart(AValue: TChart); +begin + if FChart = AValue then + exit; + FChart := AValue; + UpdateChart; +end; + +procedure TSWorkbookChartLink.SetWorkbookChartIndex(AValue: Integer); +begin + if AValue = FWorkbookChartIndex then + exit; + FWorkbookChartIndex := AValue; + UpdateChart; +end; + +procedure TsWorkbookChartLink.SetWorkbookSource(AValue: TsWorkbookSource); +begin + if AValue = FWorkbookSource then + exit; + if FWorkbookSource <> nil then + FWorkbookSource.RemoveListener(self); + FWorkbookSource := AValue; + if FWorkbookSource <> nil then + begin + FWorkbookSource.AddListener(self); + FWorkbook := FWorkbookSource.Workbook; + end else + FWorkbook := nil; + ListenerNotification([lniWorkbook, lniWorksheet]); + UpdateChart; +end; + +procedure TsWorkbookChartLink.UpdateChart; var ch: TsChart; + i: Integer; begin if (FChart = nil) then exit; @@ -621,39 +839,14 @@ begin UpdateChartAxis(ch.YAxis); UpdateChartAxis(ch.X2Axis); UpdateChartAxis(ch.Y2Axis); -end; -procedure TsWorkbookChartLink.SetChart(AValue: TChart); -begin - if FChart = AValue then - exit; - FChart := AValue; - PopulateChart; -end; + for i := 0 to ch.Series.Count-1 do + AddSeries(ch.Series[i]); -procedure TSWorkbookChartLink.SetWorkbookChartIndex(AValue: Integer); -begin - if AValue = FWorkbookChartIndex then - exit; - FWorkbookChartIndex := AValue; - PopulateChart; -end; - -procedure TsWorkbookChartLink.SetWorkbookSource(AValue: TsWorkbookSource); -begin - if AValue = FWorkbookSource then - exit; - if FWorkbookSource <> nil then - FWorkbookSource.RemoveListener(self); - FWorkbookSource := AValue; - if FWorkbookSource <> nil then - begin - FWorkbookSource.AddListener(self); - FWorkbook := FWorkbookSource.Workbook; - end else - FWorkbook := nil; - ListenerNotification([lniWorkbook, lniWorksheet]); - PopulateChart; + FChart.Prepare; + UpdateChartAxisLabels(ch); + UpdateBarSeries(ch); + FixAreaSeries(ch); end; procedure TsWorkbookChartLink.UpdateChartAxis(AWorkbookAxis: TsChartAxis); @@ -736,6 +929,19 @@ begin axis.Range.Max := AWorkbookAxis.Max; end; +procedure TsWorkbookChartLink.UpdateChartAxisLabels(AWorkbookChart: TsChart); +begin + if (FChart.SeriesCount > 0) and + (AWorkbookChart.GetChartType in [ctBar, ctLine, ctArea]) then + begin + FChart.BottomAxis.Marks.Source := TChartSeries(FChart.Series[0]).Source; + if not AWorkbookChart.Series[0].LabelRange.IsEmpty then + FChart.BottomAxis.Marks.Style := smsLabel + else + FChart.BottomAxis.Marks.Style := smsXValue; + end; +end; + procedure TsWorkbookChartLink.UpdateChartBackground(AWorkbookChart: TsChart); begin FChart.Color := Convert_sColor_to_Color(AWorkbookChart.Background.Color); @@ -744,6 +950,47 @@ begin FChart.Frame.Visible := AWorkbookChart.PlotArea.Border.Style <> clsNoLine; end; +procedure TsWorkbookChartLink.UpdateBarSeries(AWorkbookChart: TsChart); +var + i, n: Integer; + ser: TBarSeries; + barWidth, totalBarWidth: Integer; +begin + if AWorkbookChart.GetChartType <> ctBar then + exit; + + // Count the bar series + n := 0; + for i := 0 to AWorkbookChart.Series.Count-1 do + begin + if AWorkbookChart.Series[i].ChartType = ctBar then + inc(n); + end; + + // Iterate over bar series to put them side-by-side or to stack them + totalBarWidth := 90; + barWidth := round(totalBarWidth / n); + for i := 0 to FChart.SeriesCount-1 do + if FChart.Series[i] is TBarSeries then + begin + ser := TBarSeries(FChart.Series[i]); + case AWorkbookChart.Stackmode of + csmSideBySide: + begin + ser.BarWidthPercent := barWidth; + ser.BarWidthStyle := bwPercentMin; + ser.BarOffsetPercent := round((i - (n - 1)/2)*barWidth); + end; + csmStacked: + ser.Stacked := true; + csmStackedPercentage: + begin + ser.Stacked := true; + end; + end; + end; +end; + procedure TsWorkbookChartLink.UpdateChartBrush(AWorkbookFill: TsChartFill; ABrush: TBrush); begin @@ -778,6 +1025,7 @@ begin ALegend.Alignment := LEG_POS[AWorkbookLegend.Position]; ALegend.UseSidebar := not AWorkbookLegend.CanOverlapPlotArea; ALegend.Visible := AWorkbookLegend.Visible; + ALegend.Inverted := true; end; end; @@ -787,7 +1035,7 @@ begin if (AWorkbookLine <> nil) and (APen <> nil) then begin APen.Color := Convert_sColor_to_Color(AWorkbookLine.Color); - APen.Width := round(mmToIn(AWorkbookLine.Width) * GetParentForm(FChart).PixelsPerInch); + APen.Width := mmToPx(AWorkbookLine.Width, GetParentForm(FChart).PixelsPerInch); case AWorkbookLine.Style of clsNoLine: APen.Style := psClear;