lazarus/components/tachart/tanavigation.pas

{
 *****************************************************************************
 *                                                                           *
 *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
 *  for details about the copyright.                                         *
 *                                                                           *
 *  This program is distributed in the hope that it will be useful,          *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 *                                                                           *
 *****************************************************************************

Authors: Alexander Klenin

}

unit TANavigation;

{$H+}

interface

uses
  Classes, Controls, Graphics, StdCtrls, TAChartUtils, TAGraph;

type

  { TChartNavScrollBar }

  TChartNavScrollBar = class (TCustomScrollBar)
  private
    FAutoPageSize: Boolean;
    FChart: TChart;
    FListener: TListener;
    procedure ChartExtentChanged(ASender: TObject);
    procedure SetAutoPageSize(AValue: Boolean);
    procedure SetChart(AValue: TChart);
  protected
    procedure Scroll(
      AScrollCode: TScrollCode; var AScrollPos: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property AutoPageSize: Boolean
      read FAutoPageSize write SetAutoPageSize default false;
    property Chart: TChart read FChart write SetChart;
  published
    property Align;
    property Anchors;
    property BidiMode;
    property BorderSpacing;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Kind;
    property LargeChange;
    property Max;
    property Min;
    property PageSize;
    property ParentBidiMode;
    property ParentShowHint;
    property PopupMenu;
    property Position;
    property ShowHint;
    property SmallChange;
    property TabOrder;
    property TabStop;
    property Visible;
  published
    property OnChange;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnScroll;
    property OnStartDrag;
    property OnUTF8KeyPress;
  end;

  { TChartNavPanel }

  TChartNavPanel = class(TCustomControl)
  private
    FIsDragging: Boolean;
    FLogicalExtentRect: TRect;
    FOffset: TDoublePoint;
    FOldCursor: TCursor;
    FPrevPoint: TDoublePoint;
    FScale: TDoublePoint;
    procedure ChartExtentChanged(ASender: TObject);
  private
    FAllowDragNavigation: Boolean;
    FChart: TChart;
    FDragCursor: TCursor;
    FFullExtentPen: TPen;
    FListener: TListener;
    FLogicalExtentPen: TPen;
    FMiniMap: Boolean;
    FProportional: Boolean;
    FShift: TShiftState;
    procedure SetChart(AValue: TChart);
    procedure SetDragCursor(AValue: TCursor);
    procedure SetFullExtentPen(AValue: TPen);
    procedure SetLogicalExtentPen(AValue: TPen);
    procedure SetMiniMap(AValue: Boolean);
    procedure SetProportional(AValue: Boolean);
  protected
    procedure MouseDown(
      AButton: TMouseButton; AShift: TShiftState; AX, AY: Integer); override;
    procedure MouseMove(AShift: TShiftState; AX, AY: Integer); override;
    procedure MouseUp(
      AButton: TMouseButton; AShift: TShiftState; AX, AY: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
  published
    property AllowDragNavigation: Boolean
      read FAllowDragNavigation write FAllowDragNavigation default true;
    property Chart: TChart read FChart write SetChart;
    property DragCursor: TCursor read FDragCursor write SetDragCursor default crSizeAll;
    property FullExtentPen: TPen read FFullExtentPen write SetFullExtentPen;
    property LogicalExtentPen: TPen read FLogicalExtentPen write SetLogicalExtentPen;
    property MiniMap: Boolean read FMiniMap write SetMiniMap default false;
    property Proportional: Boolean read FProportional write SetProportional default false;
    property Shift: TShiftState read FShift write FShift default [ssLeft];
  published
    property Align;
  end;

procedure Register;

implementation

uses
  Forms, SysUtils, TAGeometry;

procedure Register;
begin
  RegisterComponents(
    CHART_COMPONENT_IDE_PAGE, [TChartNavScrollBar, TChartNavPanel]);
end;

{ TChartNavScrollBar }

procedure TChartNavScrollBar.ChartExtentChanged(ASender: TObject);
var
  fe, le: TDoubleRect;
  fw, lw: Double;
begin
  Unused(ASender);
  if Chart = nil then exit;
  fe := Chart.GetFullExtent;
  le := Chart.LogicalExtent;
  if le = EmptyExtent then
    le := fe;
  case Kind of
    sbHorizontal: begin
      fw := fe.b.X - fe.a.X;
      if fw <= 0 then
        Position := 0
      else
        Position := Round(WeightedAverage(Min, Max, (le.a.X - fe.a.X) / fw));
      lw := le.b.X - le.a.X;
    end;
    sbVertical: begin
      fw := fe.b.Y - fe.a.Y;
      if fw <= 0 then
        Position := 0
      else
        Position := Round(WeightedAverage(Max, Min, (le.a.Y - fe.a.Y) / fw));
      lw := le.b.Y - le.a.Y;
    end;
  end;
  if AutoPageSize and not (csDesigning in ComponentState) then
    PageSize := Round(lw / fw * (Max - Min));
end;

constructor TChartNavScrollBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FListener := TListener.Create(@FChart, @ChartExtentChanged);
end;

destructor TChartNavScrollBar.Destroy;
begin
  FreeAndNil(FListener);
  inherited Destroy;
end;

procedure TChartNavScrollBar.Scroll(
  AScrollCode: TScrollCode; var AScrollPos: Integer);
var
  fe, le: TDoubleRect;
  d, w: Double;
begin
  inherited Scroll(AScrollCode, AScrollPos);
  if Chart = nil then exit;
  w := Max - Min;
  if w = 0 then exit;
  fe := Chart.GetFullExtent;
  le := Chart.LogicalExtent;
  if le = EmptyExtent then
    le := fe;
  case Kind of
    sbHorizontal: begin
      d := WeightedAverage(fe.a.X, fe.b.X, Position / w);
      le.b.X += d - le.a.X;
      le.a.X := d;
    end;
    sbVertical: begin
      d := WeightedAverage(fe.b.Y, fe.a.Y, Position / w);
      le.b.Y += d - le.a.Y;
      le.a.Y := d;
    end;
  end;
  Chart.LogicalExtent := le;
  // Focused ScrollBar is glitchy under Win32, especially after PageSize change.
  Chart.SetFocus;
end;

procedure TChartNavScrollBar.SetAutoPageSize(AValue: Boolean);
begin
  if FAutoPageSize = AValue then exit;
  FAutoPageSize := AValue;
  ChartExtentChanged(Self);
end;

procedure TChartNavScrollBar.SetChart(AValue: TChart);
begin
  if FChart = AValue then exit;

  if FListener.IsListening then
    FChart.ExtentBroadcaster.Unsubscribe(FListener);
  FChart := AValue;
  if FChart <> nil then
    FChart.ExtentBroadcaster.Subscribe(FListener);
  ChartExtentChanged(Self);
end;

{ TChartNavPanel }

procedure TChartNavPanel.ChartExtentChanged(ASender: TObject);
begin
  Unused(ASender);
  Invalidate;
end;

constructor TChartNavPanel.Create(AOwner: TComponent);
const
  DEF_WIDTH = 40;
  DEF_HEIGHT = 20;
begin
  inherited Create(AOwner);
  FListener := TListener.Create(@FChart, @ChartExtentChanged);
  FFullExtentPen := TPen.Create;
  FFullExtentPen.OnChange := @ChartExtentChanged;
  FLogicalExtentPen := TPen.Create;
  FLogicalExtentPen.OnChange := @ChartExtentChanged;
  FLogicalExtentRect := Rect(0, 0, 0, 0);
  Width := DEF_WIDTH;
  Height := DEF_HEIGHT;
  FAllowDragNavigation := true;
  FDragCursor := crSizeAll;
  FShift := [ssLeft];
end;

destructor TChartNavPanel.Destroy;
begin
  FreeAndNil(FListener);
  FreeAndNil(FFullExtentPen);
  FreeAndNil(FLogicalExtentPen);
  inherited Destroy;
end;

procedure TChartNavPanel.MouseDown(
  AButton: TMouseButton; AShift: TShiftState; AX, AY: Integer);
begin
  if (Chart <> nil) and AllowDragNavigation then begin
    FPrevPoint := (DoublePoint(AX, Height - AY) - FOffset) / FScale;
    FIsDragging :=
      (AShift = Shift) and IsPointInRect(Point(AX, AY), FLogicalExtentRect);
    if FIsDragging then begin
      FOldCursor := Cursor;
      Cursor := DragCursor;
    end;
  end;
  inherited MouseDown(AButton, AShift, AX, AY);
end;

procedure TChartNavPanel.MouseMove(AShift: TShiftState; AX, AY: Integer);
var
  p: TDoublePoint;
  le: TDoubleRect;
begin
  if (Chart <> nil) and FIsDragging then begin
    p := (DoublePoint(AX, Height - AY) - FOffset) / FScale;
    le := Chart.LogicalExtent;
    le.a += p - FPrevPoint;
    le.b += p - FPrevPoint;
    Chart.LogicalExtent := le;
    FPrevPoint := p;
  end;
  inherited MouseMove(AShift, AX, AY);
end;

procedure TChartNavPanel.MouseUp(
  AButton: TMouseButton; AShift: TShiftState; AX, AY: Integer);
begin
  if FIsDragging then
    Cursor := FOldCursor;
  FIsDragging := false;
  inherited MouseUp(AButton, AShift, AX, AY);
end;

procedure TChartNavPanel.Paint;

  function GraphRect(ARect: TDoubleRect): TRect;
  begin
    with ARect do begin
      a := a * FScale + FOffset;
      b := b * FScale + FOffset;
      Result := Rect(
        Round(a.X), Height - Round(a.Y), Round(b.X), Height - Round(b.Y));
    end;
  end;

var
  fe, le, ext: TDoubleRect;
  sz: TDoublePoint;
  oldAxisVisible: Boolean;
  feRect: TRect;
begin
  if Chart = nil then exit;
  fe := Chart.GetFullExtent;
  le := Chart.LogicalExtent;
  if le = EmptyExtent then
    le := fe;
  ext := fe;
  ExpandRect(ext, le.a);
  ExpandRect(ext, le.b);
  sz := ext.b - ext.a;
  if (sz.X <= 0) or (sz.Y <= 0) then exit;
  FScale := DoublePoint(Width, Height) / sz;
  FOffset := ZeroDoublePoint;
  if Proportional then begin
    if FScale.X < FScale.Y then begin
      FScale.Y := FScale.X;
      FOffset.Y := (Height - sz.Y * FScale.Y) / 2;
    end
    else begin
      FScale.X := FScale.Y;
      FOffset.X := (Width - sz.X * FScale.X) / 2;
    end;
  end;
  FOffset -= ext.a * FScale;

  feRect := GraphRect(fe);
  if MiniMap then begin
    oldAxisVisible := Chart.AxisVisible;
    Chart.AxisVisible := false;
    Chart.PaintOnAuxCanvas(Canvas, feRect);
    Chart.AxisVisible := oldAxisVisible;
  end
  else begin
    Canvas.Brush.Color := Chart.BackColor;
    Canvas.Brush.Style := bsSolid;
    Canvas.FillRect(ClientRect);
  end;
  Canvas.Brush.Style := bsClear;
  Canvas.Pen := FullExtentPen;
  Canvas.Rectangle(feRect);
  Canvas.Pen := LogicalExtentPen;
  FLogicalExtentRect := GraphRect(le);
  Canvas.Rectangle(FLogicalExtentRect);
end;

procedure TChartNavPanel.SetChart(AValue: TChart);
begin
  if FChart = AValue then exit;

  if FListener.IsListening then
    FChart.ExtentBroadcaster.Unsubscribe(FListener);
  FChart := AValue;
  if FChart <> nil then
    FChart.ExtentBroadcaster.Subscribe(FListener);
  ChartExtentChanged(Self);
end;

procedure TChartNavPanel.SetDragCursor(AValue: TCursor);
begin
  if FDragCursor = AValue then exit;
  FDragCursor := AValue;
  if MouseCapture then
    Cursor := FDragCursor;
end;

procedure TChartNavPanel.SetFullExtentPen(AValue: TPen);
begin
  if FFullExtentPen = AValue then exit;
  FFullExtentPen := AValue;
  Invalidate;
end;

procedure TChartNavPanel.SetLogicalExtentPen(AValue: TPen);
begin
  if FLogicalExtentPen = AValue then exit;
  FLogicalExtentPen := AValue;
  Invalidate;
end;

procedure TChartNavPanel.SetMiniMap(AValue: Boolean);
begin
  if FMiniMap = AValue then exit;
  FMiniMap := AValue;
  Invalidate;
end;

procedure TChartNavPanel.SetProportional(AValue: Boolean);
begin
  if FProportional = AValue then exit;
  FProportional := AValue;
  Invalidate;
end;

end.