From e8953985b20cebef0809a23b7a6423321f2201d1 Mon Sep 17 00:00:00 2001 From: ask Date: Mon, 15 Jun 2009 14:04:55 +0000 Subject: [PATCH] TAChart: Bar drawing improvements. * Extract RectIntersectsRect and ExpandRange procedures. * Fix various issues with zoomed display of bar series. * Allow variable-width bars. * Replace hack in extent calculation with correct code. * Remove auto-adjustment of bar width to a multiple bar series. This was an ugly hack and should be re-implemented properly later. git-svn-id: trunk@20633 - --- components/tachart/tachartutils.pas | 37 +++++- components/tachart/taseries.pas | 167 ++++++++++++---------------- 2 files changed, 102 insertions(+), 102 deletions(-) diff --git a/components/tachart/tachartutils.pas b/components/tachart/tachartutils.pas index 54282807b0..cc4ac7754a 100644 --- a/components/tachart/tachartutils.pas +++ b/components/tachart/tachartutils.pas @@ -129,8 +129,7 @@ procedure Exchange(var A, B: Integer); overload; procedure Exchange(var A, B: Double); overload; procedure Exchange(var A, B: TDoublePoint); overload; -// True if float ranges [A, B] and [C, D] have at least one common point. -function FloatRangesOverlap(A, B, C, D: Double): Boolean; inline; +procedure ExpandRange(var ALo, AHi: Double; ACoeff: Double); inline; function GetIntervals(AMin, AMax: Double; AInverted: Boolean): TDoubleDynArray; @@ -141,6 +140,9 @@ function PointDist(const A, B: TPoint): Integer; inline; function PointDistX(const A, B: TPoint): Integer; inline; function PointDistY(const A, B: TPoint): Integer; inline; +function RectIntersectsRect( + var ARect: TDoubleRect; const AFixed: TDoubleRect): Boolean; + function RoundChecked(A: Double): Integer; inline; // Call this to silence 'parameter is unused' hint @@ -274,9 +276,13 @@ begin B := t; end; -function FloatRangesOverlap(A, B, C, D: Double): Boolean; inline; +procedure ExpandRange(var ALo, AHi: Double; ACoeff: Double); inline; +var + d: Double; begin - Result := (A <= D) and (C <= B); + d := AHi - ALo; + ALo -= d * ACoeff; + AHi += d * ACoeff; end; function GetIntervals(AMin, AMax: Double; AInverted: Boolean): TDoubleDynArray; @@ -320,13 +326,13 @@ var procedure AdjustX(var AP: TDoublePoint; ANewX: Double); inline; begin - AP.Y += dy / dx * (ANewX - AA.X); + AP.Y += dy / dx * (ANewX - AP.X); AP.X := ANewX; end; procedure AdjustY(var AP: TDoublePoint; ANewY: Double); inline; begin - AP.X += dx / dy * (ANewY - AA.Y); + AP.X += dx / dy * (ANewY - AP.Y); AP.Y := ANewY; end; @@ -373,6 +379,25 @@ end; {$HINTS OFF} +function RectIntersectsRect( + var ARect: TDoubleRect; const AFixed: TDoubleRect): Boolean; + + function RangesIntersect(L1, R1, L2, R2: Double; out L, R: Double): Boolean; + begin + if L1 > R1 then Exchange(L1, R1); + if L2 > R2 then Exchange(L2, R2); + L := Max(L1, L2); + R := Min(R1, R2); + Result := L <= R; + end; + +begin + with ARect do + Result := + RangesIntersect(a.X, b.X, AFixed.a.X, AFixed.b.X, a.X, b.X) and + RangesIntersect(a.Y, b.Y, AFixed.a.Y, AFixed.b.Y, a.Y, b.Y); +end; + function RoundChecked(A: Double): Integer; begin Result := Round(EnsureRange(A, -MaxInt, MaxInt)); diff --git a/components/tachart/taseries.pas b/components/tachart/taseries.pas index 761ef2f8b4..a17d9d29b4 100644 --- a/components/tachart/taseries.pas +++ b/components/tachart/taseries.pas @@ -111,8 +111,7 @@ type FBarPen: TPen; FBarWidthPercent: Integer; - procedure ExamineAllBarSeries(out ATotalNumber, AMyPos: Integer); - procedure SetAdjustBarWidth(AValue: Boolean); + function CalcBarWidth(AX: Double; AIndex: Integer): Double; procedure SetBarBrush(Value: TBrush); procedure SetBarPen(Value: TPen); procedure SetBarWidthPercent(Value: Integer); @@ -127,8 +126,6 @@ type procedure Draw(ACanvas: TCanvas); override; function Extent: TDoubleRect; override; published - property AdjustBarWidth: Boolean - read FAdjustBarWidth write SetAdjustBarWidth default false; property BarBrush: TBrush read FBarBrush write SetBarBrush; property BarPen: TPen read FBarPen write SetBarPen; property BarWidthPercent: Integer @@ -662,7 +659,6 @@ begin end; end; - procedure TLineSeries.AfterAdd; begin inherited AfterAdd; @@ -941,6 +937,19 @@ end; { TBarSeries } +function TBarSeries.CalcBarWidth(AX: Double; AIndex: Integer): Double; +begin + case CASE_OF_TWO[AIndex > 0, AIndex < Count - 1] of + cotNone: Result := 1.0; + cotFirst: Result := Abs(AX - Source[AIndex - 1]^.X); + cotSecond: Result := Abs(AX - Source[AIndex + 1]^.X); + cotBoth: Result := Min( + Abs(AX - Source[AIndex - 1]^.X), + Abs(AX - Source[AIndex + 1]^.X)); + end; + Result *= FBarWidthPercent * 0.01 / 2; +end; + constructor TBarSeries.Create(AOwner: TComponent); begin inherited Create(AOwner); @@ -988,57 +997,13 @@ begin end; procedure TBarSeries.Draw(ACanvas: TCanvas); -var - barTop: TDoublePoint; - i, barWidth, totalbarWidth, totalBarSeries, myPos: Integer; - r: TRect; - function PrepareBar: Boolean; + procedure DrawBar(const AR: TRect); var - barBottomY: Double; + sz: TSize; begin - barTop := DoublePoint(Source[i]^); - barBottomY := 0; - if barTop.Y < barBottomY then - Exchange(barTop.Y, barBottomY); - - with ParentChart do begin - // Check if bar is in view port. - Result := - InRange(barTop.X, XGraphMin, XGraphMax) and - FloatRangesOverlap(barBottomY, barTop.Y, YGraphMin, YGraphMax); - if not Result then exit; - - // Only draw to the limits. - if barTop.Y > YGraphMax then barTop.Y := YGraphMax; - if barBottomY < YGraphMin then barBottomY := YGraphMin; - - r.TopLeft := GraphToImage(barTop); - r.Bottom := YGraphToImage(barBottomY); - end; - - // Adjust for multiple bar series. - r.Left += myPos * barWidth - totalbarWidth div 2; - r.Right := r.Left + barWidth; - end; - -begin - if IsEmpty then exit; - - totalbarWidth := - Round(FBarWidthPercent * 0.01 * ParentChart.ChartWidth / Count); - ExamineAllBarSeries(totalBarSeries, myPos); - barWidth := totalbarWidth div totalBarSeries; - - ACanvas.Brush.Assign(BarBrush); - for i := 0 to Count - 1 do begin - if not PrepareBar then continue; - // Draw a line instead of an empty rectangle. - if r.Bottom = r.Top then Inc(r.Bottom); - if r.Left = r.Right then Inc(r.Right); - - ACanvas.Brush.Color := ColorOrDefault(Source[i]^.Color); - if (barWidth > 2) and (r.Bottom - r.Top > 2) then + sz := Size(AR); + if (sz.cx > 2) and (sz.cy > 2) then ACanvas.Pen.Assign(BarPen) else begin // Bars are too small to distinguish border from interior. @@ -1046,21 +1011,56 @@ begin ACanvas.Pen.Style := psSolid; end; - ACanvas.Rectangle(r); - if Depth > 0 then begin - DrawLineDepth(ACanvas, r.Left, r.Top, r.Right - 1, r.Top, Depth); - DrawLineDepth( - ACanvas, r.Right - 1, r.Top, r.Right - 1, r.Bottom - 1, Depth); + ACanvas.Rectangle(AR); + + if Depth = 0 then exit; + DrawLineDepth(ACanvas, AR.Left, AR.Top, AR.Right - 1, AR.Top, Depth); + DrawLineDepth( + ACanvas, AR.Right - 1, AR.Top, AR.Right - 1, AR.Bottom - 1, Depth); + end; + +var + i: Integer; + ext2, graphBar: TDoubleRect; + imageBar: TRect; + w: Double; + p: TDoublePoint; +begin + if IsEmpty then exit; + + ext2 := ParentChart.CurrentExtent; + ExpandRange(ext2.a.X, ext2.b.X, 1.0); + ExpandRange(ext2.a.Y, ext2.b.Y, 1.0); + + ACanvas.Brush.Assign(BarBrush); + for i := 0 to Count - 1 do begin + p := DoublePoint(Source[i]^); + w := CalcBarWidth(p.X, i); + graphBar := DoubleRect(p.X - w, 0, p.X + w, p.Y); + if not RectIntersectsRect(graphBar, ext2) then continue; + + with imageBar do begin + TopLeft := ParentChart.GraphToImage(graphBar.a); + BottomRight := ParentChart.GraphToImage(graphBar.b); + if Left > Right then + Exchange(Left, Right); + if Top > Bottom then + Exchange(Top, Bottom); + + // Draw a line instead of an empty rectangle. + if Bottom = Top then Dec(Top); + if Left = Right then Inc(Right); end; + ACanvas.Brush.Color := ColorOrDefault(Source[i]^.Color); + DrawBar(imageBar); end; if not Marks.IsMarkLabelsVisible then exit; - for i := 0 to Count - 1 do - if PrepareBar then - DrawLabel( - ACanvas, i, - Point((r.Left + r.Right) div 2, IfThen(barTop.Y = 0, r.Bottom, r.Top)), - barTop.Y = 0); + for i := 0 to Count - 1 do begin + p := DoublePoint(Source[i]^); + if ParentChart.IsPointInViewPort(p) then + DrawLabel(ACanvas, i, ParentChart.GraphToImage(p), p.Y < 0); + end; end; procedure TBarSeries.DrawLegend(ACanvas: TCanvas; const ARect: TRect); @@ -1071,34 +1071,16 @@ begin ACanvas.Rectangle(ARect); end; -procedure TBarSeries.ExamineAllBarSeries(out ATotalNumber, AMyPos: Integer); -var - i: Integer; -begin - if not AdjustBarWidth then begin - ATotalNumber := 1; - AMyPos := 0; - exit; - end; - ATotalNumber := 0; - AMyPos := -1; - for i := 0 to ParentChart.SeriesCount - 1 do begin - if ParentChart.Series[i] = Self then - AMyPos := ATotalNumber; - if ParentChart.Series[i] is TBarSeries then - Inc(ATotalNumber); - end; - Assert(AMyPos >= 0); -end; - function TBarSeries.Extent: TDoubleRect; begin Result := inherited Extent; - Result.a.Y := Min(Result.a.Y, 0); - Result.b.Y := Max(Result.b.Y, 0); - // The 0.6 is a hack to allow the bars to have some space apart - Result.a.X -= 0.6; - Result.b.X += 0.6; + if IsEmpty then exit; + UpdateMinMax(0, Result.a.Y, Result.b.Y); + // Show first and last bars fully. + with Source[0]^ do + Result.a.X := Min(Result.a.X, X - CalcBarWidth(X, 0)); + with Source[Count - 1]^ do + Result.b.X := Max(Result.b.X, X + CalcBarWidth(X, Count - 1)); end; function TBarSeries.GetSeriesColor: TColor; @@ -1106,13 +1088,6 @@ begin Result := FBarBrush.Color; end; -procedure TBarSeries.SetAdjustBarWidth(AValue: Boolean); -begin - if FAdjustBarWidth = AValue then exit; - FAdjustBarWidth := AValue; - UpdateParentChart; -end; - { TPieSeries } function TPieSeries.AddPie(Value: Double; Text: String; Color: TColor): Longint;