Mega Code Archive
Implementing Drag Scrolling in a Grid (as Excel has..)
<![CDATA[
Title: Implementing 'Drag Scrolling' in a Grid (as Excel has..)
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 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) end;
if dsdLeft in DSD then
begin
if LeftCol FixedCols then LeftCol:=LeftCol-1;
end;
if dsdRight in DSD then
begin
if (LeftCol+VisibleColCount) end;
end;
//---
procedure TDragScrollGrid.SetDragScrollOptions(Value:TDragScrollOptions);
begin
fDragScrollOptions.Assign(Value);
if csDesigning in ComponentState then invalidate;
end;
end.
]]>