From 07a5b364bf9799af86e9ca4af44dd0422ff53319 Mon Sep 17 00:00:00 2001 From: wp_xyz Date: Thu, 26 Dec 2024 00:32:21 +0100 Subject: [PATCH] TAChart: Add demo for the new OnCalculateNewExtent event of zoom/pan tools. --- ...TAChart_tools_calculate_new_extent.ex-meta | 5 + .../calculate_new_extent_demo.lpi | 77 +++++++ .../calculate_new_extent_demo.lpr | 25 +++ .../demo/tools_calculate_new_extent/main.lfm | 207 ++++++++++++++++++ .../demo/tools_calculate_new_extent/main.pas | 164 ++++++++++++++ 5 files changed, 478 insertions(+) create mode 100644 components/tachart/demo/tools_calculate_new_extent/TAChart_tools_calculate_new_extent.ex-meta create mode 100644 components/tachart/demo/tools_calculate_new_extent/calculate_new_extent_demo.lpi create mode 100644 components/tachart/demo/tools_calculate_new_extent/calculate_new_extent_demo.lpr create mode 100644 components/tachart/demo/tools_calculate_new_extent/main.lfm create mode 100644 components/tachart/demo/tools_calculate_new_extent/main.pas diff --git a/components/tachart/demo/tools_calculate_new_extent/TAChart_tools_calculate_new_extent.ex-meta b/components/tachart/demo/tools_calculate_new_extent/TAChart_tools_calculate_new_extent.ex-meta new file mode 100644 index 0000000000..c1fa9bcb77 --- /dev/null +++ b/components/tachart/demo/tools_calculate_new_extent/TAChart_tools_calculate_new_extent.ex-meta @@ -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."} +} \ No newline at end of file diff --git a/components/tachart/demo/tools_calculate_new_extent/calculate_new_extent_demo.lpi b/components/tachart/demo/tools_calculate_new_extent/calculate_new_extent_demo.lpi new file mode 100644 index 0000000000..be2177c8c9 --- /dev/null +++ b/components/tachart/demo/tools_calculate_new_extent/calculate_new_extent_demo.lpi @@ -0,0 +1,77 @@ + + + + + + + + + <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> diff --git a/components/tachart/demo/tools_calculate_new_extent/calculate_new_extent_demo.lpr b/components/tachart/demo/tools_calculate_new_extent/calculate_new_extent_demo.lpr new file mode 100644 index 0000000000..99d05182f6 --- /dev/null +++ b/components/tachart/demo/tools_calculate_new_extent/calculate_new_extent_demo.lpr @@ -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. + diff --git a/components/tachart/demo/tools_calculate_new_extent/main.lfm b/components/tachart/demo/tools_calculate_new_extent/main.lfm new file mode 100644 index 0000000000..6d2b061b00 --- /dev/null +++ b/components/tachart/demo/tools_calculate_new_extent/main.lfm @@ -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 diff --git a/components/tachart/demo/tools_calculate_new_extent/main.pas b/components/tachart/demo/tools_calculate_new_extent/main.pas new file mode 100644 index 0000000000..abe3681a0c --- /dev/null +++ b/components/tachart/demo/tools_calculate_new_extent/main.pas @@ -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. +