paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-16 12:49:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

TAChart: Implement TZoomDragTool using LogicalExtent instead of ZoomToRect

Browse Source 
git-svn-id: trunk@24352 -
This commit is contained in:
ask 2010-04-01 13:24:27 +00:00
parent d216b60a2f
commit af9b033b42
3 changed files with 31 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/tachart/tachartutils.pas
View File

@ -192,7 +192,7 @@ procedure UpdateMinMax(AValue: Double; var AMin, AMax: Double);
operator +(const A: TPoint; B: TSize): TPoint; overload; inline;
operator +(const A, B: TPoint): TPoint; overload; inline;
operator +(const A, B: TDoublePoint): TDoublePoint; overload; inline;
operator - (const A, B: TPoint): TPoint; overload; inline;
operator -(const A, B: TPoint): TPoint; overload; inline;
operator -(const A, B: TDoublePoint): TDoublePoint; overload; inline;
operator =(const A, B: TMethod): Boolean; overload; inline;

38
components/tachart/tagraph.pas
View File

@ -100,9 +100,9 @@ type
strict protected
FChart: TChart;
function Index: Integer; virtual; abstract;
procedure Activate; virtual;
procedure Deactivate; virtual;
function Index: Integer; virtual; abstract;
end;
TChartToolEventId = (evidMouseDown, evidMouseMove, evidMouseUp);
@ -173,6 +173,7 @@ type
function GetMargins(ACanvas: TCanvas): TRect;
function GetSeriesCount: Integer;
function GetToolset: TBasicChartToolset;
procedure HideReticule;
procedure SetAxis(AIndex: Integer; AValue: TChartAxis);
procedure SetAxisList(AValue: TChartAxisList);
@ -233,8 +234,6 @@ type
procedure SaveToFile(AClass: TRasterImageClass; const AFileName: String);
function SaveToImage(AClass: TRasterImageClass): TRasterImage;
procedure ZoomFull;
procedure ZoomToRect(const ARect: TRect);
public // Coordinate conversion
function GraphToImage(const AGraphPoint: TDoublePoint): TPoint;
function ImageToGraph(const APoint: TPoint): TDoublePoint;
@ -501,6 +500,12 @@ begin
end;
end;
procedure TChart.HideReticule;
begin
// Hide reticule - - it will be drawn again in the next MouseMove.
FReticulePos := Point( - 1, - 1);
end;
procedure TChart.CalculateTransformationCoeffs(const AMargin: TRect);
type
TConvFunc = function (AX: Integer): Double of object;
@ -902,6 +907,7 @@ end;
procedure TChart.SetLogicalExtent(const AValue: TDoubleRect);
begin
HideReticule;
FLogicalExtent := AValue;
FIsZoomed := true;
FCurrentExtent := FLogicalExtent;
@ -1050,34 +1056,12 @@ end;
procedure TChart.ZoomFull;
begin
if not FIsZoomed then exit;
HideReticule;
FIsZoomed := false;
Invalidate;
end;
procedure TChart.ZoomToRect(const ARect: TRect);
var
oldIsZoomed: Boolean;
begin
oldIsZoomed := FIsZoomed;
with ARect do
FIsZoomed := (Left < Right) and (Top < Bottom);
if FIsZoomed then
with FCurrentExtent do begin
a := ImageToGraph(ARect.TopLeft);
b := ImageToGraph(ARect.BottomRight);
if a.X > b.X then
Exchange(a.X, b.X);
if a.Y > b.Y then
Exchange(a.Y, b.Y);
end;
if FIsZoomed or oldIsZoomed then begin
// Hide reticule -- it will be drawn again in the next MouseMove.
FReticulePos := Point(-1, -1);
Invalidate;
end;
end;
{ TBasicChartSeries }
procedure TBasicChartSeries.AfterAdd;

23
components/tachart/tatools.pas
View File

@ -523,14 +523,29 @@ begin
end;
procedure TZoomDragTool.MouseUp(APoint: TPoint);
var
ext: TDoubleRect;
begin
Unused(APoint);
Deactivate;
with FChart do begin
PrepareXorPen(Canvas);
Canvas.Rectangle(FSelectionRect);
ZoomToRect(FSelectionRect);
PrepareXorPen(FChart.Canvas);
FChart.Canvas.Rectangle(FSelectionRect);
with FSelectionRect do begin
if (Left >= Right) or (Top >= Bottom) then begin
FChart.ZoomFull;
exit;
end;
ext.a := FChart.ImageToGraph(TopLeft);
ext.b := FChart.ImageToGraph(BottomRight);
end;
with ext do begin
if a.X > b.X then
Exchange(a.X, b.X);
if a.Y > b.Y then
Exchange(a.Y, b.Y);
end;
FChart.LogicalExtent := ext;
end;
{ TReticuleTool }