paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 23:59:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

TChart: Fix drawing of line series under the large zoom.

Browse Source 
* Extract LineIntersectsRect function. 
* Introduce RoundChecked function.
* Mark connectors are now drawn below series pointers.

git-svn-id: trunk@20624 -
This commit is contained in:
ask 2009-06-14 06:47:22 +00:00
parent 3952cd81b8
commit db62e824ab
3 changed files with 84 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
components/tachart/tachartutils.pas
View File

@ -95,6 +95,8 @@ type
procedure Recall;
end;
TCaseOfTwo = (cotNone, cotFirst, cotSecond, cotBoth);
const
// 0-value, 1-percent, 2-label, 3-total, 4-xvalue
SERIES_MARK_FORMATS: array [TSeriesMarksStyle] of String = (
@ -112,6 +114,8 @@ const
EmptyDoubleRect: TDoubleRect = (coords: (0, 0, 0, 0));
EmptyExtent: TDoubleRect =
(coords: (Infinity, Infinity, NegInfinity, NegInfinity));
CASE_OF_TWO: array [Boolean, Boolean] of TCaseOfTwo =
((cotNone, cotSecond), (cotFirst, cotBoth));
procedure CalculateIntervals(
AMin, AMax: Double; AxisScale: TAxisScale; out AStart, AStep: Double);
@ -130,10 +134,15 @@ function FloatRangesOverlap(A, B, C, D: Double): Boolean; inline;
function GetIntervals(AMin, AMax: Double; AInverted: Boolean): TDoubleDynArray;
function LineIntersectsRect(
var AA, AB: TDoublePoint; const ARect: TDoubleRect): Boolean;
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 RoundChecked(A: Double): Integer; inline;
// Call this to silence 'parameter is unused' hint
procedure Unused(const A1);
procedure Unused(const A1, A2);
@ -304,6 +313,49 @@ begin
end;
end;
function LineIntersectsRect(
var AA, AB: TDoublePoint; const ARect: TDoubleRect): Boolean;
var
dx, dy: Double;
procedure AdjustX(var AP: TDoublePoint; ANewX: Double); inline;
begin
AP.Y += dy / dx * (ANewX - AA.X);
AP.X := ANewX;
end;
procedure AdjustY(var AP: TDoublePoint; ANewY: Double); inline;
begin
AP.X += dx / dy * (ANewY - AA.Y);
AP.Y := ANewY;
end;
begin
dx := AB.X - AA.X;
dy := AB.Y - AA.Y;
case CASE_OF_TWO[AA.X < ARect.a.X, AB.X < ARect.a.X] of
cotFirst: AdjustX(AA, ARect.a.X);
cotSecond: AdjustX(AB, ARect.a.X);
cotBoth: exit(false);
end;
case CASE_OF_TWO[AA.X > ARect.b.X, AB.X > ARect.b.X] of
cotFirst: AdjustX(AA, ARect.b.X);
cotSecond: AdjustX(AB, ARect.b.X);
cotBoth: exit(false);
end;
case CASE_OF_TWO[AA.Y < ARect.a.Y, AB.Y < ARect.a.Y] of
cotFirst: AdjustY(AA, ARect.a.Y);
cotSecond: AdjustY(AB, ARect.a.Y);
cotBoth: exit(false);
end;
case CASE_OF_TWO[AA.Y > ARect.b.Y, AB.Y > ARect.b.Y] of
cotFirst: AdjustY(AA, ARect.b.Y);
cotSecond: AdjustY(AB, ARect.b.Y);
cotBoth: exit(false);
end;
Result := true;
end;
function PointDist(const A, B: TPoint): Integer;
begin
Result := Sqr(A.X - B.X) + Sqr(A.Y - B.Y);
@ -320,6 +372,12 @@ begin
end;
{$HINTS OFF}
function RoundChecked(A: Double): Integer;
begin
Result := Round(EnsureRange(A, -MaxInt, MaxInt));
end;
procedure Unused(const A1);
begin
end;

5
components/tachart/tagraph.pas
View File

@ -235,6 +235,7 @@ type
property ChartHeight: Integer read GetChartHeight;
property ChartWidth: Integer read GetChartWidth;
property ClipRect: TRect read FClipRect;
property CurrentExtent: TDoubleRect read FCurrentExtent;
property SeriesCount: Integer read GetSeriesCount;
property XGraphMax: Double read FCurrentExtent.b.X;
property XGraphMin: Double read FCurrentExtent.a.X;
@ -736,12 +737,12 @@ end;
function TChart.XGraphToImage(AX: Double): Integer;
begin
Result := Round(FScale.X * AX + FOffset.X);
Result := RoundChecked(FScale.X * AX + FOffset.X);
end;
function TChart.YGraphToImage(AY: Double): Integer;
begin
Result := Round(FScale.Y * AY + FOffset.Y);
Result := RoundChecked(FScale.Y * AY + FOffset.Y);
end;
function TChart.GraphToImage(const AGraphPoint: TDoublePoint): TPoint;

95
components/tachart/taseries.pas
View File

@ -626,89 +626,40 @@ begin
end;
procedure TLineSeries.Draw(ACanvas: TCanvas);
var
i1, i2: TPoint;
g1, g2: TDoublePoint;
function PrepareLine: Boolean;
begin
Result := false;
if not FShowLines then exit;
with ParentChart do
if // line is totally outside the viewport
(g1.X < XGraphMin) and (g2.X < XGraphMin) or
(g1.X > XGraphMax) and (g2.X > XGraphMax) or
(g1.Y < YGraphMin) and (g2.Y < YGraphMin) or
(g1.Y > YGraphMax) and (g2.Y > YGraphMax)
then
exit;
Result := true;
// line is totally inside the viewport
with ParentChart do
if IsPointInViewPort(g1) and IsPointInViewPort(g2) then
exit;
if g1.Y > g2.Y then
Exchange(g1, g2);
if g1.Y = g2.Y then begin
if g1.X > g2.X then
Exchange(g1, g2);
if g1.X < ParentChart.XGraphMin then i1.X := ParentChart.ClipRect.Left;
if g2.X > ParentChart.XGraphMax then i2.X := ParentChart.ClipRect.Right;
end
else if g1.X = g2.X then begin
if g1.Y < ParentChart.YGraphMin then i1.Y := ParentChart.ClipRect.Bottom;
if g2.Y > ParentChart.YGraphMax then i2.Y := ParentChart.ClipRect.Top;
end
else if ParentChart.LineInViewPort(g1, g2) then begin
i1 := ParentChart.GraphToImage(g1);
i2 := ParentChart.GraphToImage(g2);
end
else
Result := false;
end;
procedure DrawPoint(AIndex: Integer);
begin
if FShowPoints and PtInRect(ParentChart.ClipRect, i1) then begin
FPointer.Draw(ACanvas, i1, SeriesColor);
if Assigned(FOnDrawPointer) then
FOnDrawPointer(Self, ACanvas, AIndex, i1);
end;
end;
var
i: Integer;
ai, bi: TPoint;
a, b: TDoublePoint;
begin
if Count = 0 then exit;
for i := 0 to Count - 2 do begin
GetCoords(i, g1, i1);
GetCoords(i + 1, g2, i2);
if PrepareLine then begin
if FShowLines then
for i := 0 to Count - 2 do begin
a := DoublePoint(Source[i]^);
b := DoublePoint(Source[i + 1]^);
if not LineIntersectsRect(a, b, ParentChart.CurrentExtent) then continue;
ai := ParentChart.GraphToImage(a);
bi := ParentChart.GraphToImage(b);
ACanvas.Pen.Assign(LinePen);
if Depth = 0 then begin
ACanvas.Pen.Color := GetColor(i);
ACanvas.Line(i1, i2);
end
if Depth = 0 then
ACanvas.Line(ai, bi)
else begin
ACanvas.Brush.Style := bsSolid;
ACanvas.Brush.Color := ACanvas.Pen.Color;
ACanvas.Pen.Color := clBlack;
ACanvas.Brush.Color := GetColor(i);
DrawLineDepth(ACanvas, i1, i2, Depth);
DrawLineDepth(ACanvas, ai, bi, Depth);
end;
end;
DrawPoint(i);
end;
// Draw last point
GetCoords(Count - 1, g1, i1);
DrawPoint(i);
DrawLabels(ACanvas, true);
if FShowPoints then
for i := 0 to Count - 1 do begin
a := DoublePoint(Source[i]^);
if not ParentChart.IsPointInViewPort(a) then continue;
ai := ParentChart.GraphToImage(a);
FPointer.Draw(ACanvas, ai, GetColor(i));
if Assigned(FOnDrawPointer) then
FOnDrawPointer(Self, ACanvas, i, ai);
end;
end;