delphi3000.com Article

Implementing 'Drag Scrolling' in a Grid (as Excel has..)
Undertitle:A practical outworking of Published objects in components
URL:http://www.delphi3000.com/article.asp?ID=3069
Category:Component Writing
Uploader:duncan parsons
 
Question: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:

i. 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
ii.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 < fDragScrollOptions.Margins.TopMargin then
                                           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.
Copyright 2000 delphi3000.com
Contact: delphi3000@bluestep.com'

Comments to this article
Write a new comment