paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 03:39: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 Height = 367
Top = 0 Top = 0
Width = 800 Width = 800
AutoFocus = True
AxisList = < AxisList = <
item item
TickColor = clBlue TickColor = clBlue
@ -315,7 +316,7 @@ object Form1: TForm1
Width = 800 Width = 800
Align = alBottom Align = alBottom
BevelOuter = bvNone 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 Color = clGray
Font.Color = clWhite Font.Color = clWhite
ParentColor = False ParentColor = False
@ -352,6 +353,8 @@ object Form1: TForm1
end end
object ctDistance1: TDataPointDistanceTool object ctDistance1: TDataPointDistanceTool
Shift = [ssLeft] Shift = [ssLeft]
OnBeforeKeyDown = ctDistance1BeforeKeyDown
OnBeforeKeyUp = ctDistance1BeforeKeyUp
LinePen.Width = 2 LinePen.Width = 2
Marks.Distance = 30 Marks.Distance = 30
Marks.Format = 'dist='#13#10'%0:.9g / %1:.9g' 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, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls, Spin, ComCtrls, StdCtrls, Spin, ComCtrls,
TAChartUtils, TATransformations, TAGraph, TASources, TASeries, TAChartUtils, TATransformations, TAGraph, TASources, TASeries,
TATools, TADataTools; TATools, TADataTools, types;
type type
@ -55,6 +55,8 @@ type
procedure clrFontColorColorChanged(Sender: TObject); procedure clrFontColorColorChanged(Sender: TObject);
procedure clrPenColorColorChanged(Sender: TObject); procedure clrPenColorColorChanged(Sender: TObject);
procedure ctCrosshairDraw(ASender: TDataPointCrosshairTool); procedure ctCrosshairDraw(ASender: TDataPointCrosshairTool);
procedure ctDistance1BeforeKeyDown(ATool: TChartTool; APoint: TPoint);
procedure ctDistance1BeforeKeyUp(ATool: TChartTool; APoint: TPoint);
procedure ctDistance1Measure( procedure ctDistance1Measure(
ASender: TDataPointDistanceTool); ASender: TDataPointDistanceTool);
procedure edEndbarLengthChange(Sender: TObject); procedure edEndbarLengthChange(Sender: TObject);
@ -134,6 +136,33 @@ begin
Statusbar1.SimpleText := ''; Statusbar1.SimpleText := '';
end; 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( procedure TForm1.ctDistance1Measure(
ASender: TDataPointDistanceTool); ASender: TDataPointDistanceTool);
const const