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

TAChart: Add "zoom on endpoint" feature to the "distance" demo

Browse Source 
git-svn-id: trunk@38870 -
This commit is contained in:
ask 2012-09-27 16:21:44 +00:00
parent 9c7f6a203e
commit 4fc027fcf4
2 changed files with 34 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
components/tachart/demo/distance/Main.lfm
View File

@ -13,6 +13,7 @@ object Form1: TForm1
Height = 367
Top = 0
Width = 800
AutoFocus = True
AxisList = <
item
TickColor = clBlue
@ -315,7 +316,7 @@ object Form1: TForm1
Width = 800
Align = alBottom
BevelOuter = bvNone
Caption = 'Left-drag --> measure 1st distance Ctrl+left-drag --> measure 2nd distance Right-drag --> show values'
Caption = 'Left-drag --> measure 1st distance, Shift to zoom while dragging Ctrl+left-drag --> measure 2nd distance Right-drag --> show values'
Color = clGray
Font.Color = clWhite
ParentColor = False
@ -352,6 +353,8 @@ object Form1: TForm1
end
object ctDistance1: TDataPointDistanceTool
Shift = [ssLeft]
OnBeforeKeyDown = ctDistance1BeforeKeyDown
OnBeforeKeyUp = ctDistance1BeforeKeyUp
LinePen.Width = 2
Marks.Distance = 30
Marks.Format = 'dist='#13#10'%0:.9g / %1:.9g'

31
components/tachart/demo/distance/Main.pas
View File

@ -8,7 +8,7 @@ uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls, Spin, ComCtrls,
TAChartUtils, TATransformations, TAGraph, TASources, TASeries,
TATools, TADataTools;
TATools, TADataTools, types;
type
@ -55,6 +55,8 @@ type
procedure clrFontColorColorChanged(Sender: TObject);
procedure clrPenColorColorChanged(Sender: TObject);
procedure ctCrosshairDraw(ASender: TDataPointCrosshairTool);
procedure ctDistance1BeforeKeyDown(ATool: TChartTool; APoint: TPoint);
procedure ctDistance1BeforeKeyUp(ATool: TChartTool; APoint: TPoint);
procedure ctDistance1Measure(
ASender: TDataPointDistanceTool);
procedure edEndbarLengthChange(Sender: TObject);
@ -134,6 +136,33 @@ begin
Statusbar1.SimpleText := '';
end;
procedure TForm1.ctDistance1BeforeKeyDown(ATool: TChartTool; APoint: TPoint);
const
ZOOM_FACTOR = 2;
var
ext: TDoubleRect;
x, sz, ratio: Double;
begin
if not (ssShift in ATool.Toolset.DispatchedShiftState) then exit;
ext := Chart1.LogicalExtent;
if ext.b.x - ext.a.x >= 10 then begin
x := Chart1.XImageToGraph(APoint.X);
sz := ext.b.x - ext.a.x;
ratio := (x - ext.a.x) / sz;
ext.a.x := x - sz * ratio / ZOOM_FACTOR;
ext.b.x := x + sz * (1 - ratio) / ZOOM_FACTOR;
Chart1.LogicalExtent := ext;
end;
ATool.Handled;
end;
procedure TForm1.ctDistance1BeforeKeyUp(ATool: TChartTool; APoint: TPoint);
begin
Unused(APoint);
Chart1.ZoomFull;
ATool.Handled;
end;
procedure TForm1.ctDistance1Measure(
ASender: TDataPointDistanceTool);
const