From 783241539dadb479c543a1627c18fd3ee754f088 Mon Sep 17 00:00:00 2001 From: wp Date: Tue, 10 Jan 2017 00:11:06 +0000 Subject: [PATCH] TAChart: Fix stacking of multi-valued Line/AreaSeries in case of axis transformations. New property Stacked to turn stacking off. git-svn-id: trunk@53907 - --- components/tachart/demo/multi/Main.lfm | 5 ++- components/tachart/demo/multi/multidemo.lpi | 5 +-- components/tachart/tacustomseries.pas | 35 +++++++++++++---- components/tachart/taseries.pas | 42 ++++++++++++++++++--- 4 files changed, 68 insertions(+), 19 deletions(-) diff --git a/components/tachart/demo/multi/Main.lfm b/components/tachart/demo/multi/Main.lfm index e0862fb13f..1687896654 100644 --- a/components/tachart/demo/multi/Main.lfm +++ b/components/tachart/demo/multi/Main.lfm @@ -14,9 +14,9 @@ object Form1: TForm1 Height = 459 Top = 0 Width = 529 - ActivePage = tsField + ActivePage = tsBubble Align = alClient - TabIndex = 4 + TabIndex = 0 TabOrder = 0 object tsBubble: TTabSheet Caption = 'Bubble' @@ -118,6 +118,7 @@ object Form1: TForm1 Marks.YIndex = -1 Depth = 10 MarkPositions = lmpInside + Stacked = True Source = ccsStacked Styles = ChartStyles1 end diff --git a/components/tachart/demo/multi/multidemo.lpi b/components/tachart/demo/multi/multidemo.lpi index 7d8be8af7d..6f2390082d 100644 --- a/components/tachart/demo/multi/multidemo.lpi +++ b/components/tachart/demo/multi/multidemo.lpi @@ -1,7 +1,7 @@ - + @@ -13,9 +13,6 @@ - - - diff --git a/components/tachart/tacustomseries.pas b/components/tachart/tacustomseries.pas index cff848f2ca..b696ea28cb 100644 --- a/components/tachart/tacustomseries.pas +++ b/components/tachart/tacustomseries.pas @@ -271,8 +271,8 @@ type function NearestXNumber(var AIndex: Integer; ADir: Integer): Double; procedure PrepareGraphPoints( const AExtent: TDoubleRect; AFilterByExtent: Boolean); - procedure UpdateGraphPoints(AIndex: Integer); overload; inline; - procedure UpdateGraphPoints(AIndex, ALo, AUp: Integer); overload; + procedure UpdateGraphPoints(AIndex: Integer; ACumulative: Boolean); overload; inline; + procedure UpdateGraphPoints(AIndex, ALo, AUp: Integer; ACumulative: Boolean); overload; procedure UpdateMinXRange; property Pointer: TSeriesPointer read FPointer write SetPointer; @@ -1327,21 +1327,40 @@ begin UpdateParentChart; end; -procedure TBasicPointSeries.UpdateGraphPoints(AIndex, ALo, AUp: Integer); +procedure TBasicPointSeries.UpdateGraphPoints(AIndex, ALo, AUp: Integer; + ACumulative: Boolean); var - i: Integer; + i, j: Integer; + y: Double; begin if IsRotated then for i := ALo to AUp do - FGraphPoints[i - ALo].X += AxisToGraphY(Source[i]^.YList[AIndex]) + begin + if ACumulative then begin + y := Source[i]^.Y; + for j := 0 to AIndex do + y += Source[i]^.YList[j]; + FGraphPoints[i - ALo].X := AxisToGraphY(y); + end else + FGraphPoints[i - Alo].X := AxisToGraphY(Source[i]^.YList[AIndex]); + end else for i := ALo to AUp do - FGraphPoints[i - ALo].Y += AxisToGraphY(Source[i]^.YList[AIndex]); + begin + if ACumulative then begin + y := Source[i]^.Y; + for j := 0 to AIndex do + y += Source[i]^.YList[j]; + FGraphPoints[i - ALo].Y := AxisToGraphY(y); + end else + FGraphPoints[i - Alo].Y := AxisToGraphY(Source[i]^.YList[AIndex]); + end; end; -procedure TBasicPointSeries.UpdateGraphPoints(AIndex: Integer); +procedure TBasicPointSeries.UpdateGraphPoints(AIndex: Integer; + ACumulative: Boolean); begin - UpdateGraphPoints(AIndex, FLoBound, FUpBound); + UpdateGraphPoints(AIndex, FLoBound, FUpBound, ACumulative); end; procedure TBasicPointSeries.UpdateMargins( diff --git a/components/tachart/taseries.pas b/components/tachart/taseries.pas index a2b944439f..42fc371288 100644 --- a/components/tachart/taseries.pas +++ b/components/tachart/taseries.pas @@ -137,6 +137,7 @@ type FAreaContourPen: TPen; FAreaLinesPen: TPen; FConnectType: TConnectType; + FStacked: Boolean; FUseZeroLevel: Boolean; FZeroLevel: Double; @@ -146,6 +147,7 @@ type procedure SetAreaLinesPen(AValue: TPen); procedure SetConnectType(AValue: TConnectType); procedure SetSeriesColor(AValue: TColor); + procedure SetStacked(AValue: Boolean); procedure SetUseZeroLevel(AValue: Boolean); procedure SetZeroLevel(AValue: Double); protected @@ -172,6 +174,7 @@ type property SeriesColor: TColor read GetSeriesColor write SetSeriesColor stored false default clWhite; property Source; + property Stacked: Boolean read FStacked write SetStacked default true; property Styles; property UseReticule; property UseZeroLevel: Boolean @@ -194,6 +197,7 @@ type FLineType: TLineType; FOnDrawPointer: TSeriesPointerDrawEvent; FShowPoints: Boolean; + FStacked: Boolean; procedure DrawSingleLineInStack(ADrawer: IChartDrawer; AIndex: Integer); function GetShowLines: Boolean; @@ -202,6 +206,7 @@ type procedure SetSeriesColor(AValue: TColor); procedure SetShowLines(Value: Boolean); procedure SetShowPoints(AValue: Boolean); + procedure SetStacked(AValue: Boolean); protected procedure AfterDrawPointer( ADrawer: IChartDrawer; AIndex: Integer; const APos: TPoint); override; @@ -212,6 +217,7 @@ type constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Draw(ADrawer: IChartDrawer); override; + function Extent: TDoubleRect; override; public procedure BeginUpdate; procedure EndUpdate; @@ -230,6 +236,8 @@ type read GetShowLines write SetShowLines stored false default true; property ShowPoints: Boolean read FShowPoints write SetShowPoints default false; + property Stacked: Boolean + read FStacked write SetStacked default false; property Source; property Styles; property UseReticule default true; @@ -419,11 +427,19 @@ begin PrepareGraphPoints(ext, LineType <> ltFromOrigin); DrawSingleLineInStack(ADrawer, 0); for i := 0 to Source.YCount - 2 do begin - UpdateGraphPoints(i); + UpdateGraphPoints(i, FStacked); DrawSingleLineInStack(ADrawer, i + 1); end; end; +function TLineSeries.Extent: TDoubleRect; +begin + if FStacked then + Result := Source.ExtentCumulative + else + Result := Source.ExtentList; +end; + procedure TLineSeries.DrawSingleLineInStack( ADrawer: IChartDrawer; AIndex: Integer); var @@ -655,6 +671,13 @@ begin UpdateParentChart; end; +procedure TLineSeries.SetStacked(AValue: Boolean); +begin + if FStacked = AValue then exit; + FStacked := AValue; + UpdateParentChart; +end; + { TManhattanSeries } procedure TManhattanSeries.Assign(ASource: TPersistent); @@ -1288,6 +1311,7 @@ begin FAreaContourPen.OnChange := @StyleChanged; FAreaLinesPen := TPen.Create; FAreaLinesPen.OnChange := @StyleChanged; + FStacked := true; end; destructor TAreaSeries.Destroy; @@ -1347,9 +1371,7 @@ var for j := 0 to Source.YCount - 1 do begin if j > 0 then - UpdateGraphPoints(j - 1{, AStart, AEnd}); - // The modification in above line fixes a drawing error reported in - // forum.lazarus.freepascal.org/index.php/topic,28025.msg174184 + UpdateGraphPoints(j - 1, AStart, AEnd, FStacked); numPts := 0; a := ProjToRect(FGraphPoints[AStart], ext2); PushPoint(ProjToLine(a, z1)); @@ -1444,7 +1466,10 @@ end; function TAreaSeries.Extent: TDoubleRect; begin - Result := inherited Extent; + if FStacked then + Result := Source.ExtentCumulative + else + Result := Source.ExtentList; if not IsEmpty and UseZeroLevel then UpdateMinMax(ZeroLevel, Result.a.Y, Result.b.Y); end; @@ -1499,6 +1524,13 @@ begin FAreaBrush.Color := AValue; end; +procedure TAreaSeries.SetStacked(AValue: Boolean); +begin + if FStacked = AValue then exit; + FStacked := AValue; + UpdateParentChart; +end; + procedure TAreaSeries.SetUseZeroLevel(AValue: Boolean); begin if FUseZeroLevel = AValue then exit;