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

TAChart: Add TPanDragTool. This is part of issue #16109

Browse Source 
git-svn-id: trunk@24337 -
This commit is contained in:
ask 2010-04-01 10:49:29 +00:00
parent 55e3c12e7d
commit d059542372
2 changed files with 56 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
components/tachart/tagraph.pas
View File

@ -159,6 +159,7 @@ type
FClipRect: TRect;
FCurrentExtent: TDoubleRect;
FIsZoomed: Boolean;
FLogicalExtent: TDoubleRect;
FOffset: TDoublePoint; // Coordinates transformation
FReticuleMode: TReticuleMode;
FReticulePos: TPoint;
@ -227,6 +228,7 @@ type
procedure CopyToClipboardBitmap;
procedure DeleteSeries(ASeries: TBasicChartSeries);
procedure PaintOnCanvas(ACanvas: TCanvas; ARect: TRect);
procedure Pan(const ADelta: TPoint);
procedure SaveToBitmapFile(const AFileName: String); inline;
procedure SaveToFile(AClass: TRasterImageClass; const AFileName: String);
function SaveToImage(AClass: TRasterImageClass): TRasterImage;
@ -463,6 +465,7 @@ begin
if not FIsZoomed then
UpdateExtent;
FLogicalExtent := FCurrentExtent;
DrawTitleFoot(ACanvas);
PrepareLegend(ACanvas, legendItems, legendRect);
try
@ -478,6 +481,21 @@ begin
Series[i].AfterDraw;
end;
procedure TChart.Pan(const ADelta: TPoint);
var
d: TDoublePoint;
begin
d.X := ADelta.X / FScale.X;
d.Y := ADelta.Y / FScale.Y;
with FLogicalExtent do begin
a += d;
b += d;
end;
FIsZoomed := true;
FCurrentExtent := FLogicalExtent;
Invalidate;
end;
procedure TChart.PrepareLegend(
ACanvas: TCanvas; out ALegendItems: TChartLegendItems; out ARect: TRect);
var

38
components/tachart/tatools.pas
View File

@ -113,6 +113,18 @@ type
read FZoomFactor write FZoomFactor stored ZoomFactorIsStored;
end;
{ TPanDragTool }
TPanDragTool = class(TChartTool)
private
FOrigin: TPoint;
public
constructor Create(AOwner: TComponent); override;
procedure MouseDown(APoint: TPoint); override;
procedure MouseMove(APoint: TPoint); override;
procedure MouseUp(APoint: TPoint); override;
end;
{ TReticuleTool }
TReticuleTool = class(TChartTool)
@ -528,12 +540,38 @@ begin
Result := FZoomFactor <> 1.0;
end;
constructor TPanDragTool.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
{ TPanDragTool }
procedure TPanDragTool.MouseDown(APoint: TPoint);
begin
Activate;
FOrigin := APoint;
end;
procedure TPanDragTool.MouseMove(APoint: TPoint);
begin
FChart.Pan(APoint - FOrigin);
FOrigin := APoint;
end;
procedure TPanDragTool.MouseUp(APoint: TPoint);
begin
Unused(APoint);
Deactivate;
end;
initialization
ToolsClassRegistry := TStringList.Create;
OnInitBuiltinTools := @InitBuitlinTools;
RegisterChartToolClass(TZoomDragTool, 'Zoom drag tool');
RegisterChartToolClass(TZoomClickTool, 'Zoom click tool');
RegisterChartToolClass(TPanDragTool, 'Panning drag tool');
RegisterChartToolClass(TReticuleTool, 'Reticule tool');
finalization