mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-29 11:09:32 +02:00
TAChart: Add demo for the new OnCalculateNewExtent event of zoom/pan tools.
This commit is contained in:
wp_xyz
parent
ca8860602a
commit
07a5b364bf
@ -0,0 +1,5 @@
|
||||
{ "TAChart_tools_calculate_new_extent" : {
|
||||
"Category" : "TAChart",
|
||||
"Keywords" : ["TAChart", "Panning", "Zooming", "Extent"],
|
||||
"Description" : "Demonstrates the usage of the OnCalculateNewExtent event in zoom/pan tools of TAChart with fixed RatioLimit in order to rescale the axes."}
|
||||
}
|
||||
@ -0,0 +1,77 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="12"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<Title Value="calculate_new_extent_demo"/>
|
||||
<Scaled Value="True"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<XPManifest>
|
||||
<DpiAware Value="True"/>
|
||||
</XPManifest>
|
||||
</General>
|
||||
<BuildModes>
|
||||
<Item Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<UseFileFilters Value="True"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
</RunParams>
|
||||
<RequiredPackages>
|
||||
<Item>
|
||||
<PackageName Value="TAChartLazarusPkg"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item>
|
||||
</RequiredPackages>
|
||||
<Units>
|
||||
<Unit>
|
||||
<Filename Value="calculate_new_extent_demo.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="main.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="MainForm"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="calculate_new_extent_demo"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<DebugInfoType Value="dsDwarf3"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions>
|
||||
<Item>
|
||||
<Name Value="EAbort"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
@ -0,0 +1,25 @@
|
||||
program calculate_new_extent_demo;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}
|
||||
cthreads,
|
||||
{$ENDIF}
|
||||
{$IFDEF HASAMIGA}
|
||||
athreads,
|
||||
{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, main, tachartlazaruspkg
|
||||
{ you can add units after this };
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
RequireDerivedFormResource := True;
|
||||
Application.Scaled := True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TMainForm, MainForm);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
207
components/tachart/demo/tools_calculate_new_extent/main.lfm
Normal file
207
components/tachart/demo/tools_calculate_new_extent/main.lfm
Normal file
@ -0,0 +1,207 @@
|
||||
object MainForm: TMainForm
|
||||
Left = 529
|
||||
Height = 407
|
||||
Top = 250
|
||||
Width = 627
|
||||
Caption = 'Stretched Zooming and Panning Demo'
|
||||
ClientHeight = 407
|
||||
ClientWidth = 627
|
||||
LCLVersion = '4.99.0.0'
|
||||
OnCreate = FormCreate
|
||||
object Chart: TChart
|
||||
Left = 0
|
||||
Height = 307
|
||||
Top = 0
|
||||
Width = 627
|
||||
AutoFocus = True
|
||||
AxisList = <
|
||||
item
|
||||
Grid.Color = 16053492
|
||||
Grid.Style = psSolid
|
||||
Marks.LabelBrush.Style = bsClear
|
||||
Minors = <>
|
||||
Range.Max = 100
|
||||
Title.LabelFont.Orientation = 900
|
||||
Title.LabelBrush.Style = bsClear
|
||||
end
|
||||
item
|
||||
Grid.Color = 16053492
|
||||
Grid.Style = psSolid
|
||||
Alignment = calBottom
|
||||
Marks.LabelBrush.Style = bsClear
|
||||
Minors = <>
|
||||
Title.LabelBrush.Style = bsClear
|
||||
end>
|
||||
Title.Text.Strings = (
|
||||
'TAChart'
|
||||
)
|
||||
Toolset = ChartToolset
|
||||
Align = alClient
|
||||
object RedSeries: TLineSeries
|
||||
Title = 'Red'
|
||||
LinePen.Color = clRed
|
||||
end
|
||||
object BlueSeries: TLineSeries
|
||||
Title = 'Blue'
|
||||
LinePen.Color = clBlue
|
||||
end
|
||||
end
|
||||
object BottomPanel: TPanel
|
||||
Left = 12
|
||||
Height = 76
|
||||
Top = 319
|
||||
Width = 603
|
||||
Align = alBottom
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 12
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 76
|
||||
ClientWidth = 603
|
||||
TabOrder = 1
|
||||
object cbRotateAxes: TCheckBox
|
||||
AnchorSideLeft.Control = BottomPanel
|
||||
AnchorSideTop.Control = rbStretchedToAll
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 0
|
||||
Height = 19
|
||||
Top = 38
|
||||
Width = 83
|
||||
Caption = 'Axes rotated'
|
||||
TabOrder = 0
|
||||
OnChange = cbRotateAxesChange
|
||||
end
|
||||
object Label1: TLabel
|
||||
AnchorSideLeft.Control = rbStretchedToBlue
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = BottomPanel
|
||||
Left = 146
|
||||
Height = 60
|
||||
Top = 0
|
||||
Width = 190
|
||||
BorderSpacing.Left = 16
|
||||
BorderSpacing.Right = 20
|
||||
Caption = 'Zooming'#13#10'- Drag with left mouse button down'#13#10'- Ctrl+Click near chart border'#13#10'- Rotate mouse wheel'
|
||||
WordWrap = True
|
||||
end
|
||||
object Label2: TLabel
|
||||
AnchorSideLeft.Control = Label1
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = BottomPanel
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 356
|
||||
Height = 60
|
||||
Top = 0
|
||||
Width = 198
|
||||
BorderSpacing.Left = 20
|
||||
BorderSpacing.Right = 20
|
||||
Caption = 'Panning'#13#10'- Drag with right mouse button down'#13#10'- Shift+Click near chart border'#13#10'- Shift+Rotate mouse wheel'
|
||||
WordWrap = True
|
||||
end
|
||||
object cbStretched: TCheckBox
|
||||
AnchorSideLeft.Control = BottomPanel
|
||||
AnchorSideTop.Control = BottomPanel
|
||||
Left = 0
|
||||
Height = 19
|
||||
Top = 0
|
||||
Width = 82
|
||||
Caption = 'Stretched to'
|
||||
Checked = True
|
||||
State = cbChecked
|
||||
TabOrder = 1
|
||||
OnChange = cbRotateAxesChange
|
||||
end
|
||||
object rbStretchedToAll: TRadioButton
|
||||
AnchorSideLeft.Control = cbStretched
|
||||
AnchorSideTop.Control = cbStretched
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 12
|
||||
Height = 19
|
||||
Top = 19
|
||||
Width = 30
|
||||
BorderSpacing.Left = 12
|
||||
Caption = 'all'
|
||||
Checked = True
|
||||
TabOrder = 2
|
||||
TabStop = True
|
||||
end
|
||||
object rbStretchedToRed: TRadioButton
|
||||
AnchorSideLeft.Control = rbStretchedToAll
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = rbStretchedToAll
|
||||
Left = 48
|
||||
Height = 19
|
||||
Top = 19
|
||||
Width = 35
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Right = 6
|
||||
Caption = 'red'
|
||||
TabOrder = 3
|
||||
end
|
||||
object rbStretchedToBlue: TRadioButton
|
||||
AnchorSideLeft.Control = rbStretchedToRed
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = rbStretchedToAll
|
||||
Left = 89
|
||||
Height = 19
|
||||
Top = 19
|
||||
Width = 41
|
||||
Caption = 'blue'
|
||||
TabOrder = 4
|
||||
end
|
||||
object cbAnimated: TCheckBox
|
||||
AnchorSideLeft.Control = BottomPanel
|
||||
AnchorSideTop.Control = cbRotateAxes
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 0
|
||||
Height = 19
|
||||
Top = 57
|
||||
Width = 70
|
||||
Caption = 'Animated'
|
||||
TabOrder = 5
|
||||
OnChange = cbAnimatedChange
|
||||
end
|
||||
end
|
||||
object ChartToolset: TChartToolset
|
||||
Left = 80
|
||||
Top = 54
|
||||
object ZoomDragTool: TZoomDragTool
|
||||
Shift = [ssLeft]
|
||||
AnimationSteps = 20
|
||||
Brush.Color = clSilver
|
||||
DrawingMode = tdmNormal
|
||||
EscapeCancels = True
|
||||
Frame.Visible = False
|
||||
RatioLimit = zrlFixedY
|
||||
Transparency = 128
|
||||
OnCalculateNewExtent = ZoomDragToolCalculateNewExtent
|
||||
end
|
||||
object ZoomClickTool: TZoomClickTool
|
||||
Shift = [ssCtrl, ssLeft]
|
||||
ZoomFactor = 1.1
|
||||
OnCalculateNewExtent = ZoomDragToolCalculateNewExtent
|
||||
end
|
||||
object ZoomMouseWheelTool: TZoomMouseWheelTool
|
||||
ZoomFactor = 1.1
|
||||
OnCalculateNewExtent = ZoomDragToolCalculateNewExtent
|
||||
end
|
||||
object PanDragTool: TPanDragTool
|
||||
Shift = [ssRight]
|
||||
Directions = [pdLeft, pdRight]
|
||||
EscapeCancels = True
|
||||
OnCalculateNewExtent = ZoomDragToolCalculateNewExtent
|
||||
end
|
||||
object PanClickTool: TPanClickTool
|
||||
Shift = [ssShift, ssLeft]
|
||||
Margins.Left = 20
|
||||
Margins.Top = 20
|
||||
Margins.Right = 20
|
||||
Margins.Bottom = 20
|
||||
OnCalculateNewExtent = ZoomDragToolCalculateNewExtent
|
||||
end
|
||||
object PanMouseWheelTool: TPanMouseWheelTool
|
||||
Shift = [ssShift]
|
||||
WheelUpDirection = pdLeft
|
||||
OnCalculateNewExtent = ZoomDragToolCalculateNewExtent
|
||||
end
|
||||
end
|
||||
end
|
||||
164
components/tachart/demo/tools_calculate_new_extent/main.pas
Normal file
164
components/tachart/demo/tools_calculate_new_extent/main.pas
Normal file
@ -0,0 +1,164 @@
|
||||
unit main;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, ExtCtrls, StdCtrls, SysUtils, Forms, Controls, Graphics, Dialogs, Math,
|
||||
TAGraph, TATools, TASeries, TATransformations, TAChartUtils, TACustomSeries;
|
||||
|
||||
type
|
||||
{ TMainForm }
|
||||
|
||||
TMainForm = class(TForm)
|
||||
cbStretched: TCheckBox;
|
||||
Chart: TChart;
|
||||
BlueSeries: TLineSeries;
|
||||
cbAnimated: TCheckBox;
|
||||
Label1: TLabel;
|
||||
Label2: TLabel;
|
||||
rbStretchedToBlue: TRadioButton;
|
||||
rbStretchedToRed: TRadioButton;
|
||||
rbStretchedToAll: TRadioButton;
|
||||
RedSeries: TLineSeries;
|
||||
ChartToolset: TChartToolset;
|
||||
PanClickTool: TPanClickTool;
|
||||
PanDragTool: TPanDragTool;
|
||||
PanMouseWheelTool: TPanMouseWheelTool;
|
||||
ZoomClickTool: TZoomClickTool;
|
||||
ZoomDragTool: TZoomDragTool;
|
||||
ZoomMouseWheelTool: TZoomMouseWheelTool;
|
||||
cbRotateAxes: TCheckBox;
|
||||
BottomPanel: TPanel;
|
||||
procedure cbAnimatedChange(Sender: TObject);
|
||||
procedure ZoomDragToolCalculateNewExtent(ATool: TChartTool;
|
||||
var ANewExtent: TDoubleRect);
|
||||
procedure cbRotateAxesChange(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
public
|
||||
procedure RotateAxes;
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
MainForm: TMainForm;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TMainForm }
|
||||
|
||||
procedure TMainForm.FormCreate(Sender: TObject);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
RedSeries.Clear;
|
||||
BlueSeries.Clear;
|
||||
RedSeries.AddXY(0, 50);
|
||||
BlueSeries.AddXY(0, 40);
|
||||
for i := 1 to 100 do
|
||||
begin
|
||||
RedSeries.AddXY(i, RedSeries.GetYValue(i - 1) + Random(9) - 4);
|
||||
BlueSeries.AddXY(i, BlueSeries.GetYValue(i - 1) + Random(9) - 5);
|
||||
end;
|
||||
|
||||
RotateAxes;
|
||||
end;
|
||||
|
||||
procedure TMainForm.ZoomDragToolCalculateNewExtent(ATool: TChartTool;
|
||||
var ANewExtent: TDoubleRect);
|
||||
|
||||
procedure ResetRange(out min, max: Double);
|
||||
begin
|
||||
min := Infinity;
|
||||
max := -Infinity;
|
||||
end;
|
||||
|
||||
function StretchToSeries(ASeries: TBasicChartSeries): Boolean;
|
||||
begin
|
||||
Result := rbStretchedToAll.Checked or
|
||||
(rbStretchedToRed.Checked and (ASeries = RedSeries)) or
|
||||
(rbStretchedToBlue.Checked and (ASeries = BlueSeries));
|
||||
end;
|
||||
|
||||
var
|
||||
newExt: TDoubleRect;
|
||||
ymin, ymax: Double;
|
||||
ser: TBasicPointSeries;
|
||||
i: Integer;
|
||||
begin
|
||||
if not cbStretched.Checked then
|
||||
exit;
|
||||
|
||||
ResetRange(newExt.a.X, newExt.b.X);
|
||||
ResetRange(newExt.a.Y, newExt.b.Y);
|
||||
for i := 0 to ATool.Chart.SeriesCount-1 do
|
||||
if StretchToSeries(ATool.Chart.Series[i]) and (ATool.Chart.Series[i] is TBasicPointSeries) then
|
||||
begin
|
||||
ser := TBasicPointSeries(ATool.Chart.Series[i]);
|
||||
ResetRange(ymin, ymax);
|
||||
if ser.IsRotated then
|
||||
begin
|
||||
ser.FindYRange(ANewExtent.a.Y, ANewExtent.b.Y, ymin, ymax);
|
||||
UpdateMinMax(ymin, newExt.a.X, newExt.b.X);
|
||||
UpdateMinmax(ymax, newExt.a.X, newExt.b.X);
|
||||
end else
|
||||
begin
|
||||
ser.FindYRange(ANewExtent.a.X, ANewExtent.b.X, ymin, ymax);
|
||||
UpdateMinMax(ymin, newExt.a.Y, newExt.b.Y);
|
||||
UpdateMinMax(ymax, newExt.a.Y, newExt.b.Y);
|
||||
end;
|
||||
end;
|
||||
|
||||
if not IsInfinite(newExt.a.X) then ANewExtent.a.X := newExt.a.X;
|
||||
if not IsInfinite(newExt.a.Y) then ANewExtent.a.Y := newExt.a.Y;
|
||||
if not IsInfinite(newExt.b.X) then ANewExtent.b.X := newExt.b.X;
|
||||
if not IsInfinite(newExt.b.Y) then ANewExtent.b.Y := newExt.b.Y;
|
||||
end;
|
||||
|
||||
procedure TMainForm.cbAnimatedChange(Sender: TObject);
|
||||
var
|
||||
intvl: Integer;
|
||||
begin
|
||||
if cbAnimated.Checked then intvl := 10 else intvl := 0;
|
||||
ZoomDragTool.AnimationInterval := intvl;
|
||||
ZoomClickTool.AnimationInterval := intvl;
|
||||
ZoomMouseWheelTool.AnimationInterval := intvl;
|
||||
end;
|
||||
|
||||
procedure TMainForm.cbRotateAxesChange(Sender: TObject);
|
||||
begin
|
||||
RotateAxes;
|
||||
end;
|
||||
|
||||
procedure TMainForm.RotateAxes;
|
||||
var
|
||||
i: Integer;
|
||||
ser: TBasicPointSeries;
|
||||
begin
|
||||
Chart.ZoomFull;
|
||||
for i := 0 to Chart.SeriesCount-1 do
|
||||
begin
|
||||
if (Chart.Series[i] is TBasicPointSeries) then
|
||||
begin
|
||||
ser := TBasicPointSeries(Chart.Series[i]);
|
||||
if cbRotateAxes.Checked then
|
||||
begin
|
||||
ser.AxisIndexX := 0;
|
||||
ser.AxisIndexY := 1;
|
||||
ZoomDragTool.RatioLimit := zrlFixedX;
|
||||
end else
|
||||
begin
|
||||
ser.AxisIndexX := 1;
|
||||
ser.AxisIndexY := 0;
|
||||
ZoomDragTool.RatioLimit := zrlFixedY;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
Chart.Invalidate;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user