Implementing 'Drag Scrolling' in a Grid (as Excel has..)

Problem/Question/Abstract:

When dragging an object over a grid, if the cell you require is not visible, or only partially visible, it would be useful to have the grid automatically scroll to bring the cell into view (a kind of drag-hot-tracking).

Excel does it, Lotus 123 does it, now let's make a humble TStringGrid do it.

This builds on the article/ tutorial of 'Published Objects in Components'

Answer:

This article builds on information given in the article 'Published Objects in Components' (ID 3039) about how to add 'dropdown' properties in the object inspector. You do not need to read or understand that article, but it would serve as background reading!

To provide a 'drag-scrolling' mechanism to a grid, the main principles are:

override the dragover method, and within it:  check whether the cursor is within certain user-defined margins, if within the margins, start the drag-scroll process, initialising a timer  if not within the margins, stop the timer
provide a timer method which will check (at a user-defined interval) whether the cursor still falls within the margin, if so, continue scrolling

The timer is used, as if the user stops moving, but is still over the grid, it will still need checking (a dragmove will only occur when the mouse actually moves).

To facilitate all this, and provide a suite of options, I have gone the route of providing a new object (TDragScrollOptions) which encapsulates all the requied options - margins, timer values, etc. This, in turn, has some objects defined within itself as well (TDragScrollDelays, TDragScrollMargins)..

The structure is as follows:

TDragScrollOptions

property Active: boolean;
  property Delays: TDragScrollDelays;
    |
      - property InitialDelay: integer;
      - property RepeatDelay: integer;
  property Margins: TDragScrollMargins;
          |
            - property TopMargin: integer;
            - property BottomMargin: integer;
            - property LeftMargin: integer;
            - property RightMargin: integer;
end;

The Delays work as one would now expect with any windows application - an initial wait, then a faster response afterwards - hence the Initial and Repeat delays.

The Margins are application from the edges of the component. If the cursor falls between an edge and its repective margin, a scroll can happen.

An Event has been added to allow the developer to monitor the drag scrolling, with an option to cancel the operation (the CanScroll parameter):

TDragScrollEvent = procedure(Sender: TObject; TopRow, LeftCol: LongInt; var
  DragScrollDir: TDragScrollDirection; var CanScroll: boolean) of object;

Enough waffle!! Here is the base component. Copy it into a unit, save and install! Feel free to take out the drag scroll stuff for your own favourite grid (my most used grid has features from all over the place - I wrote this part all myself tho' - no copyright infringement!).

If you use the component, or take the drag scroll engine elsewhere, please let me know (just out of interest really!) - duncanparsons@hotmail.com

unit DragScrollGrid;

{© Duncan Parsons 2002
This Component is freeware, but I am interested in where it ends up!!
Drop me a line on duncanparsons@hotmail.com

Grid with 'Drag Scroll' Option - when an object is dragged over the control,
                                  it will scroll to reveal the hidden cells as needed

If you make any good changes, let me know!
Happy Coding
Duncan Parsons}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, ExtCtrls;

type
  //For Drag-Scrolling
  TDragScrollDelays = class(TPersistent)
  private
    fInitialDelay: integer;
    fRepeatDelay: integer;
  published
    property InitialDelay: integer read fInitialDelay write fInitialDelay default
      1000;
    property RepeatDelay: integer read fRepeatDelay write fRepeatDelay default 250;
  end;
  TDragScrollMargins = class(TPersistent)
  private
    fTopMargin: integer;
    fBottomMargin: integer;
    fLeftMargin: Integer;
    fRightMargin: Integer;
  published
    property TopMargin: integer read fTopMargin write fTopMargin default 50;
    property BottomMargin: integer read fBottomMargin write fBottomMargin default 50;
    property LeftMargin: Integer read fLeftMargin write fLeftMargin default 50;
    property RightMargin: Integer read fRightMargin write fRightMargin default 50;
  end;

  TDragScrollOptions = class(TPersistent)
  private
    fActive: Boolean;
    fDelays: TDragScrollDelays;
    fMargins: TDragScrollMargins;
  public
    constructor create; //override;
    destructor destroy; override;
  published
    property Active: boolean read fActive write fActive;
    property Delays: TDragScrollDelays read fDelays write fDelays;
    property Margins: TDragScrollMargins read fMargins write fMargins;
  end;

  TDragScrollDirections = (dsdUp, dsdDown, dsdLeft, dsdRight);
  TDragScrollDirection = set of TDragScrollDirections;
  TDragScrollEvent = procedure(Sender: TObject; TopRow, LeftCol: LongInt; var
    DragScrollDir: TDragScrollDirection; var CanScroll: boolean) of object;

type
  TDragScrollGrid = class(TStringGrid)
  private
    { Private declarations }
    //Drag Scrolling
    fDragScrollOptions: TDragScrollOptions;
    fTmr: TTimer;
    fDragScrollDirection: TDragScrollDirection;
    fOnDragScroll: TDragScrollEvent;
    procedure SetDragScrollOptions(Value: TDragScrollOptions);
  protected
    { Protected declarations }
    procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept:
      Boolean); override;
    procedure TimerProc(Sender: Tobject);
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property OnDragScroll: TDragScrollEvent read fOnDragScroll
      write fOnDragScroll;
    property DragScrollOptions: TDragScrollOptions read fDragScrollOptions write
      SetDragScrollOptions;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TDragScrollGrid]);
end;

//---TDragScrollOptions

constructor TDragScrollOptions.create;
begin
  inherited;
  fDelays := TDragScrollDelays.create;
  fDelays.InitialDelay := 1000;
  fDelays.RepeatDelay := 250;
  fMargins := TDragScrollMargins.create;
  fMargins.TopMargin := 50;
  fMargins.BottomMargin := 50;
  fMargins.LeftMargin := 50;
  fMargins.RightMargin := 50;
end;

destructor TDragScrollOptions.destroy;
begin
  fDelays.free;
  fMargins.free;
  inherited;
end;

//---TDragScrollGrid

constructor TDragScrollGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fDragScrollOptions := TDragScrollOptions.create;
end;

destructor TDragScrollGrid.Destroy;
begin
  if Assigned(fTmr) then
  begin
    fTmr.enabled := false;
    fTmr.Free;
  end;
  fDragScrollOptions.free;

  inherited Destroy;
end;

//---Drag Scroll initialisation and finalisation

procedure TDragScrollGrid.DragOver(Source: TObject; X, Y: Integer; State: TDragState;
  var Accept: Boolean);
var
  CurrentlyScrolling: boolean;
begin
  if not (fDragScrollOptions.Active) then
  begin
    if Assigned(fTmr) then
    begin
      fTmr.enabled := false;
      fTmr.free;
      fTmr := nil;
    end;
    inherited;
    exit;
  end;
  if fDragScrollDirection = [] then
    CurrentlyScrolling := false
  else
    CurrentlyScrolling := true;
  fDragScrollDirection := [];
  case State of
    dsDragEnter, dsDragMove:
      begin
        //Moving in the Grid, Check the Borders
        if y Include(fDragScrollDirection, dsdUp)
  else
    if y > (Height - fDragScrollOptions.Margins.BottomMargin) then
      Include(fDragScrollDirection, dsdDown);
    if x Include(fDragScrollDirection, dsdLeft)
  else
    if x > (width - fDragScrollOptions.Margins.RightMargin) then
      Include(fDragScrollDirection, dsdRight);
    //Any Borders hit?
    if fDragScrollDirection = [] then
    begin
      //Turn Timer off
      if Assigned(fTmr) then
      begin
        fTmr.Enabled := false;
        fTmr.free;
        fTmr := nil;
      end;
    end
    else
    begin
      if not (Assigned(fTmr)) then
      begin
        fTmr := TTimer.Create(Parent);
        fTmr.Interval := fDragScrollOptions.Delays.InitialDelay;
        fTmr.OnTimer := TimerProc;
        fTmr.enabled := true;
      end
      else
      begin
        //Reset the Timer if a new scroll is required
        if not (CurrentlyScrolling) then
          fTmr.Interval := fDragScrollOptions.Delays.InitialDelay;
      end;
    end;
  end;
  dsDragLeave:
  begin
    if Assigned(fTmr) then
    begin
      fTmr.Enabled := false;
      fTmr.free;
      fTmr := nil;
    end;
  end;
end;
inherited;
end;

//---Drag Scroll Timer..

procedure TDragScrollGrid.TimerProc(Sender: Tobject);
var
  CanScroll: Boolean;
  DSD: TDragScrollDirection;
begin
  if not (fDragScrollOptions.Active) then
  begin
    fTmr.Enabled := false;
    fTmr.free;
    fTmr := nil;
    exit;
  end;
  fTmr.Interval := fDragScrollOptions.Delays.RepeatDelay;
  //Do Scroll if User is OK with it
  DSD := fDragScrollDirection;
  if Assigned(fOnDragScroll) then
  begin
    CanScroll := true;
    fOnDragScroll(Self, TopRow, LeftCol, DSD, CanScroll);
    if not (CanScroll) then
      exit;
  end;
  //Allow scroll
  if dsdUp in DSD then
  begin
    if TopRow > FixedRows then
      TopRow := TopRow - 1;
  end;
  if dsdDown in DSD then
  begin
    if (TopRow + VisibleRowCount) < (RowCount) then
      TopRow := TopRow + 1;
  end;
  if dsdLeft in DSD then
  begin
    if LeftCol > FixedCols then
      LeftCol := LeftCol - 1;
  end;
  if dsdRight in DSD then
  begin
    if (LeftCol + VisibleColCount) < (ColCount) then
      LeftCol := LeftCol + 1;
  end;
end;

//---

procedure TDragScrollGrid.SetDragScrollOptions(Value: TDragScrollOptions);
begin
  fDragScrollOptions.Assign(Value);
  if csDesigning in ComponentState then
    invalidate;
end;

end.


Component Download: DragScrollGrid.zip