Right-anchored zoom

Here is my attempt to extend TZoomMouseWheelTool to support a right-anchored zoom mode, which is important for financial/time-series charts where the user wants to zoom while keeping the latest bar fixed on the right edge. I couldn't find a way to do this with the standard TZoomMouseWheelTool. Hope I didn't reinvent the wheel?

The logic adjusts the X-extent while respecting dataset boundaries and recalculates Y automatically based on visible data.

Code: Pascal [Select][+]

unit uAnchoredZoomTool;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, Math, TAGraph, TAChartUtils, TATools, TASeries;
 
type
  TZoomAnchorMode = (zamCursor, zamCenter, zamRightPinned);
 
  { -------------------------------------------------------------------
    Patched Zoom Tool
    -------------------------------------------------------------------
         FIX: Override Handled and guard against Toolset=nil so the app
         never crashes on: Toolset.FIsHandled := true;
    ------------------------------------------------------------------- }
 
  TAnchoredZoomMouseWheelTool = class(TZoomMouseWheelTool)
  private
    FAnchorMode : TZoomAnchorMode;
 
    procedure HandleCalculateNewExtent(ATool: TChartTool;
      var ANewExtent: TDoubleRect);
 
    function FirstDataX: Double;
    function LastDataX: Double;
    procedure RecalcYRange(const AXMin, AXMax: Double;
      out AYMin, AYMax: Double);
  public
    constructor Create(AOwner: TComponent); override;
 
    // ********** CRASH PATCH **********
    procedure Handled;
    // **********************************
 
  published
    property AnchorMode : TZoomAnchorMode
      read FAnchorMode write FAnchorMode default zamCursor;
  end;
 
implementation
 
uses
  TACustomSeries;
 
{ ===================================================================
  Constructor
  =================================================================== }
 
constructor TAnchoredZoomMouseWheelTool.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAnchorMode := zamCursor;
  OnCalculateNewExtent := @HandleCalculateNewExtent;
end;
 
{ ===================================================================
  HARD CRASH FIX
  =================================================================== }
 
procedure TAnchoredZoomMouseWheelTool.Handled;
begin
  // TAChart calls this even when Toolset=nil → causes NIL dereference
  if Toolset <> nil then
    inherited Handled;
end;
 
{ ===================================================================
  Data helpers
  =================================================================== }
 
function TAnchoredZoomMouseWheelTool.FirstDataX: Double;
var
  S: TChartSeries;
begin
  Result := Chart.LogicalExtent.a.x;
  if Chart.SeriesCount = 0 then Exit;
  S := TChartSeries(Chart.Series[0]);
  if S.Count > 0 then
    Result := S.XValue[0];
end;
 
function TAnchoredZoomMouseWheelTool.LastDataX: Double;
var
  S: TChartSeries;
begin
  Result := Chart.LogicalExtent.b.x;
  if Chart.SeriesCount = 0 then Exit;
  S := TChartSeries(Chart.Series[0]);
  if S.Count > 0 then
    Result := S.XValue[S.Count - 1];
end;
 
{ ===================================================================
  Recalculate Y-axis range
  =================================================================== }
 
procedure TAnchoredZoomMouseWheelTool.RecalcYRange(const AXMin, AXMax: Double;
  out AYMin, AYMax: Double);
var
  i, j: Integer;
  S: TChartSeries;
  Y: Double;
begin
  AYMin :=  1E308;
  AYMax := -1E308;
 
  for i := 0 to Chart.SeriesCount - 1 do
    if Chart.Series[i] is TChartSeries then
    begin
      S := TChartSeries(Chart.Series[i]);
      for j := 0 to S.Count - 1 do
        if (S.XValue[j] >= AXMin) and (S.XValue[j] <= AXMax) then
        begin
          Y := S.YValue[j];
          AYMin := Min(AYMin, Y);
          AYMax := Max(AYMax, Y);
        end;
    end;
 
  if AYMin < AYMax then
  begin
    Y := (AYMax - AYMin) * 0.05;
    AYMin -= Y;
    AYMax += Y;
  end;
end;
 
{ ===================================================================
  MAIN ZOOM LOGIC
  =================================================================== }
 
procedure TAnchoredZoomMouseWheelTool.HandleCalculateNewExtent(
  ATool: TChartTool; var ANewExtent: TDoubleRect);
var
  OldExt   : TDoubleRect;
  OldW, NewW: Double;
  DataMin, DataMax: Double;
  X1, X2: Double;
  YMin, YMax: Double;
begin
  // Default TAChart behavior → skip custom logic
  if AnchorMode = zamCursor then
    Exit;
 
  OldExt := Chart.LogicalExtent;
 
  OldW := OldExt.b.x - OldExt.a.x;
  NewW := ANewExtent.b.x - ANewExtent.a.x;
  if (OldW <= 0) or (NewW <= 0) then
    Exit;
 
  DataMin := FirstDataX;
  DataMax := LastDataX;
 
  case AnchorMode of
 
    { ------------------------------------------------------------
      CENTER-ANCHORED ZOOM
      ------------------------------------------------------------ }
    zamCenter:
      begin
        X1 := OldExt.a.x + (OldW - NewW) * 0.5;
        X2 := X1 + NewW;
 
        if (X2 - X1) > (DataMax - DataMin) then
        begin
          X1 := DataMin;
          X2 := DataMax;
        end
        else
        begin
          if X1 < DataMin then
          begin
            X1 := DataMin;
            X2 := X1 + NewW;
          end;
          if X2 > DataMax then
          begin
            X2 := DataMax;
            X1 := X2 - NewW;
          end;
        end;
 
        ANewExtent.a.x := X1;
        ANewExtent.b.x := X2;
      end;
 
    { ------------------------------------------------------------
      RIGHT-ANCHORED ZOOM
      ------------------------------------------------------------ }
    zamRightPinned:
      begin
        X2 := DataMax;
        X1 := X2 - NewW;
 
        if X1 < DataMin then
        begin
          X1 := DataMin;
          X2 := DataMin + NewW;
          if X2 > DataMax then
            X2 := DataMax;
        end;
 
        ANewExtent.a.x := X1;
        ANewExtent.b.x := X2;
      end;
 
  else
    Exit;
  end;
 
  // Recalculate Y-axis after final X-range is known
  RecalcYRange(ANewExtent.a.x, ANewExtent.b.x, YMin, YMax);
  ANewExtent.a.y := YMin;
  ANewExtent.b.y := YMax;
end;
 
end.

Demo app for testing the zoom. Buttons work identically to mousewheel. Note that without the workaround, moving the wheel results in exception because Toolset is nil and I dont know how to set it.

Code: Pascal [Select][+]

unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
  TAGraph, TASeries, TASources, Types, TATools, TAChartUtils;
 
type
  TForm1 = class(TForm)
    btnZoom20Pct: TButton;
    btnZoomOut20Pct: TButton;
    Chart1: TChart;
    Chart1LineSeries1: TLineSeries;
    ListChartSource: TListChartSource;
    procedure FormCreate(Sender: TObject);
    procedure btnZoom20PctClick(Sender: TObject);
    procedure btnZoomOut20PctClick(Sender: TObject);
  private
    FToolset  : TChartToolset;
    FZoomTool : TZoomMouseWheelTool;
    procedure ZoomToolCalcExtent(
      ATool: TChartTool;
      var ANewExtent: TDoubleRect
    );
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.lfm}
 
uses
  Math, DateUtils;
 
type
  TDataRecord = record
    Date  : TDateTime;
    Value : Double;
  end;
 
  TDataArray = array of TDataRecord;
 
var
  DataArray: TDataArray;
 
function AddRecord(var A: TDataArray): Integer;
var
  R: TDataRecord;
  LastValue: Double;
  ChangePercent: Double;
begin
  if Length(A) = 0 then
  begin
    R.Date := Now;
    R.Value := Random(51) + 50;
  end
  else
  begin
    R.Date := A[High(A)].Date + 1;
    LastValue := A[High(A)].Value;
    ChangePercent := (Random(601) - 300) / 10000;
    R.Value := LastValue * (1 + ChangePercent);
    if R.Value < 50 then
      R.Value := 50;
  end;
 
  SetLength(A, Length(A) + 1);
  A[High(A)] := R;
  Result := High(A);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var
  i, j: Integer;
begin
  Randomize;
 
  for j := 0 to 599 do
  begin
    i := AddRecord(DataArray);
    ListChartSource.Add(
      DataArray[i].Date,
      DataArray[i].Value,
      FormatDateTime('yyyy-mm-dd', DataArray[i].Date)
    );
  end;
 
  // TOOLSET
  FToolset := TChartToolset.Create(Self);
  Chart1.Toolset := FToolset;
 
  // ZOOM TOOL – ÄGS AV TOOLSET (VIKTIGT)
  FZoomTool := TZoomMouseWheelTool.Create(FToolset);
  FZoomTool.ZoomFactor := 0.80;
  FZoomTool.OnCalculateNewExtent := @ZoomToolCalcExtent;
  FZoomTool.Enabled := True;
 
  FToolset.Tools.Add(FZoomTool);
end;
 
procedure TForm1.ZoomToolCalcExtent(
  ATool: TChartTool;
  var ANewExtent: TDoubleRect
);
var
  i, iend: Integer;
  RightX, LeftX: Double;
  YMin, YMax: Double;
begin
  iend := Chart1LineSeries1.Count - 1;
  if iend < 0 then Exit;
 
  RightX := Chart1LineSeries1.XValue[iend];
  LeftX := RightX - (ANewExtent.b.x - ANewExtent.a.x);
 
  if LeftX < Chart1LineSeries1.XValue[0] then
    LeftX := Chart1LineSeries1.XValue[0];
 
  ANewExtent.a.x := LeftX;
  ANewExtent.b.x := RightX;
 
  YMin :=  1E308;
  YMax := -1E308;
 
  for i := 0 to iend do
    if (Chart1LineSeries1.XValue[i] >= ANewExtent.a.x) and
       (Chart1LineSeries1.XValue[i] <= ANewExtent.b.x) then
    begin
      YMin := Min(YMin, Chart1LineSeries1.YValue[i]);
      YMax := Max(YMax, Chart1LineSeries1.YValue[i]);
    end;
 
  ANewExtent.a.y := YMin;
  ANewExtent.b.y := YMax;
end;
 
procedure TForm1.btnZoom20PctClick(Sender: TObject);
var
  i, iend: Integer;
  ext: TDoubleRect;
begin
  iend := Chart1LineSeries1.Count - 1;
  if iend < 0 then Exit;
 
  ext := Chart1.LogicalExtent;
  ext.a.x := ext.a.x + 0.20 * (ext.b.x - ext.a.x);
  ext.b.x := ext.a.x + (ext.b.x - ext.a.x) * 0.80;
 
  ext.a.y :=  1E308;
  ext.b.y := -1E308;
 
  for i := 0 to iend do
    if (Chart1LineSeries1.XValue[i] >= ext.a.x) and
       (Chart1LineSeries1.XValue[i] <= ext.b.x) then
    begin
      ext.a.y := Min(ext.a.y, Chart1LineSeries1.YValue[i]);
      ext.b.y := Max(ext.b.y, Chart1LineSeries1.YValue[i]);
    end;
 
  Chart1.LogicalExtent := ext;
end;
 
procedure TForm1.btnZoomOut20PctClick(Sender: TObject);
var
  i, iend: Integer;
  ext: TDoubleRect;
begin
  iend := Chart1LineSeries1.Count - 1;
  if iend < 0 then Exit;
 
  ext := Chart1.LogicalExtent;
  ext.a.x := ext.a.x - 0.20 * (ext.b.x - ext.a.x);
  ext.b.x := ext.a.x + (ext.b.x - ext.a.x) * 1.20;
 
  if ext.a.x < Chart1LineSeries1.XValue[0] then
    ext.a.x := Chart1LineSeries1.XValue[0];
  if ext.b.x > Chart1LineSeries1.XValue[iend] then
    ext.b.x := Chart1LineSeries1.XValue[iend];
 
  ext.a.y :=  1E308;
  ext.b.y := -1E308;
 
  for i := 0 to iend do
    if (Chart1LineSeries1.XValue[i] >= ext.a.x) and
       (Chart1LineSeries1.XValue[i] <= ext.b.x) then
    begin
      ext.a.y := Min(ext.a.y, Chart1LineSeries1.YValue[i]);
      ext.b.y := Max(ext.b.y, Chart1LineSeries1.YValue[i]);
    end;
 
  Chart1.LogicalExtent := ext;
end;
 
end.
 

Since I don't fully understand how to set up Toolset and Tools at runtime, a workaround to guard against Toolset=nil in TChartTool.Handled was added. I assume there is a cleaner, intended usage pattern? Without the workaround there will be an exception when moving the wheel for zooming. Hopefully just a silly mistake from my side. Temporarily, for testing the zoom:

Code: Pascal [Select][+]

procedure TChartTool.Handled;
begin
  if (Toolset <> nil) then
    Toolset.FIsHandled := true;
end;
 

Likewise and probably for same reason exception at app close:

Code: Pascal [Select][+]

destructor TChartToolset.Destroy;
begin
  while Tools.Count > 0 do
    Item[Tools.Count - 1].Free;
  FreeAndNil(FTools);
  inherited;
end;   
 

Lazarus

Bookstore

Search

Recent

Author Topic: Right-anchored zoom (Read 359 times)

kapibara

Right-anchored zoom

wp

Re: Right-anchored zoom

kapibara

Re: Right-anchored zoom

	Computer Math and Games in Pascal (preview)
	Lazarus Handbook