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

TAChart: Add TBasicChartSeries.MovePoint procedure.

Browse Source 
+ Implement MovePoint and GetNearestPoint for TConstantLine series

git-svn-id: trunk@25760 -
This commit is contained in:
ask 2010-05-30 08:12:53 +00:00
parent 0106d929e9
commit 5fb8c6c91b
2 changed files with 64 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
components/tachart/tagraph.pas
View File

@ -81,6 +81,7 @@ type
ADistFunc: TPointDistFunc; const APoint: TPoint;
out AIndex: Integer; out AImg: TPoint; out AValue: TDoublePoint): Boolean;
virtual;
procedure MovePoint(AIndex: Integer; const ANewPos: TPoint); virtual;
function IsEmpty: Boolean; virtual; abstract;
property Active: Boolean read FActive write SetActive default true;
@ -1123,10 +1124,14 @@ begin
Result := AY;
end;
procedure TBasicChartSeries.MovePoint(AIndex: Integer; const ANewPos: TPoint);
begin
Unused(AIndex, ANewPos)
end;
procedure TBasicChartSeries.UpdateMargins(
ACanvas: TCanvas; var AMargins: TRect);
begin
// nothing
Unused(ACanvas, AMargins);
end;

68
components/tachart/taseries.pas
View File

@ -60,6 +60,7 @@ type
ADistFunc: TPointDistFunc; const APoint: TPoint;
out AIndex: Integer; out AImg: TPoint; out AValue: TDoublePoint): Boolean;
override;
procedure MovePoint(AIndex: Integer; const ANewPos: TPoint); override;
end;
{ TBarSeries }
@ -226,6 +227,7 @@ type
FUseBounds: Boolean;
function GetSeriesColor: TColor;
procedure SavePosToCoord(var APoint: TDoublePoint);
procedure SetLineStyle(AValue: TLineStyle);
procedure SetPen(AValue: TPen);
procedure SetPos(AValue: Double);
@ -239,6 +241,11 @@ type
destructor Destroy; override;
procedure Draw(ACanvas: TCanvas); override;
function GetNearestPoint(
ADistFunc: TPointDistFunc;
const APoint: TPoint; out AIndex: Integer; out AImg: TPoint;
out AValue: TDoublePoint): Boolean; override;
procedure MovePoint(AIndex: Integer; const ANewPos: TPoint); override;
published
property Active default true;
@ -505,16 +512,8 @@ end;
procedure TConstantLine.GetBounds(var ABounds: TDoubleRect);
begin
if not UseBounds then exit;
case LineStyle of
lsHorizontal: begin
ABounds.a.Y := FPosGraph;
ABounds.b.Y := FPosGraph;
end;
lsVertical: begin
ABounds.a.X := FPosGraph;
ABounds.b.X := FPosGraph;
end;
end;
SavePosToCoord(ABounds.a);
SavePosToCoord(ABounds.b);
end;
procedure TConstantLine.GetLegendItems(AItems: TChartLegendItems);
@ -522,11 +521,47 @@ begin
AItems.Add(TLegendItemLine.Create(Pen, Title));
end;
function TConstantLine.GetNearestPoint(ADistFunc: TPointDistFunc;
const APoint: TPoint; out AIndex: Integer; out AImg: TPoint; out
AValue: TDoublePoint): Boolean;
begin
Result := true;
AIndex := -1;
AImg := APoint;
// Return the actual nearest point of the line.
if LineStyle = lsVertical then begin
AValue.Y := FChart.YImageToGraph(APoint.Y);
AImg.X := FChart.XGraphToImage(Position);
end
else begin
AValue.X := FChart.XImageToGraph(APoint.X);
AImg.Y := FChart.YGraphToImage(Position);
end;
SavePosToCoord(AValue);
end;
function TConstantLine.GetSeriesColor: TColor;
begin
Result := FPen.Color;
end;
procedure TConstantLine.MovePoint(AIndex: Integer; const ANewPos: TPoint);
begin
Unused(AIndex);
if LineStyle = lsVertical then
Position := FChart.XImageToGraph(ANewPos.X)
else
Position := FChart.YImageToGraph(ANewPos.Y);
end;
procedure TConstantLine.SavePosToCoord(var APoint: TDoublePoint);
begin
if LineStyle = lsVertical then
APoint.X := Position
else
APoint.Y := Position;
end;
procedure TConstantLine.SetLineStyle(AValue: TLineStyle);
begin
if FLineStyle = AValue then exit;
@ -633,6 +668,19 @@ begin
end;
end;
procedure TBasicPointSeries.MovePoint(AIndex: Integer; const ANewPos: TPoint);
var
p: TDoublePoint;
begin
if not InRange(AIndex, 0, Count - 1) then exit;
p := FChart.ImageToGraph(ANewPos);
with ListSource.Item[AIndex]^ do begin
X := p.X;
Y := p.Y;
end;
UpdateParentChart;
end;
procedure TBasicPointSeries.SetUseReticule(AValue: Boolean);
begin
if FUseReticule = AValue then exit;