Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to Implement 'Drag Scrolling' in a Grid (as Excel has..) Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
21-Jul-03
Category
VCL-General
Language
Delphi 2.x
Views
157
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			Author: Duncan Parsons

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: 

1   TDragScrollOptions
2   
3   property Active: boolean;
4     property Delays: TDragScrollDelays;
5       |
6         - property InitialDelay: integer;
7         - property RepeatDelay: integer;
8     property Margins: TDragScrollMargins;
9             |
10              - property TopMargin: integer;
11              - property BottomMargin: integer;
12              - property LeftMargin: integer;
13              - property RightMargin: integer;
14  end;
15  
16  The Delays work as one would now expect with any windows application - an initial 
17  wait, then a faster response afterwards - hence the Initial and repeat delays. 
18  
19  The Margins are application from the edges of the component. if the cursor falls 
20  between an edge and its repective margin, a scroll can happen. 
21  
22  An Event has been added to allow the developer to monitor the drag scrolling, with 
23  an option to cancel the operation (the CanScroll parameter): 
24  
25  TDragScrollEvent = procedure(Sender: TObject; TopRow, LeftCol: LongInt; var
26    DragScrollDir: TDragScrollDirection; var CanScroll: boolean) of object;
27  
28  Enough waffle!! Here is the base component. Copy it into a unit, save and install! 
29  Feel free to take out the drag scroll stuff for your own favourite grid (my most 
30  used grid has features from all over the place - I wrote this part all myself tho' 
31  - no copyright infringement!). 
32  
33  If you use the component, or take the drag scroll engine elsewhere, please let me 
34  know (just out of interest really!) - 
35  duncanparsons@hotmail.commailto:duncanparsons@hotmail.com 
36  
37  unit DragScrollGrid;
38  
39  { Duncan Parsons 2002
40  This Component is freeware, but I am interested in where it ends up!!
41  Drop me a line on duncanparsons@hotmail.com
42  
43  Grid with '' Option - when an object is dragged over the control,
44                                    it will scroll to reveal the hidden cells as 
45  needed
46  
47  If you make any good changes, let me know!
48  Happy Coding
49  Duncan Parsons}
50  
51  interface
52  
53  uses
54    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
55    Grids, ExtCtrls;
56  
57  type
58    //For Drag-Scrolling
59    TDragScrollDelays = class(TPersistent)
60    private
61      fInitialDelay: integer;
62      fRepeatDelay: integer;
63    published
64      property InitialDelay: integer read fInitialDelay write fInitialDelay default
65        1000;
66      property RepeatDelay: integer read fRepeatDelay write fRepeatDelay default 250;
67    end;
68    TDragScrollMargins = class(TPersistent)
69    private
70      fTopMargin: integer;
71      fBottomMargin: integer;
72      fLeftMargin: Integer;
73      fRightMargin: Integer;
74    published
75      property TopMargin: integer read fTopMargin write fTopMargin default 50;
76      property BottomMargin: integer read fBottomMargin write fBottomMargin default 
77  50;
78      property LeftMargin: Integer read fLeftMargin write fLeftMargin default 50;
79      property RightMargin: Integer read fRightMargin write fRightMargin default 50;
80    end;
81  
82    TDragScrollOptions = class(TPersistent)
83    private
84      fActive: Boolean;
85      fDelays: TDragScrollDelays;
86      fMargins: TDragScrollMargins;
87    public
88      constructor create; //override;
89      destructor destroy; override;
90    published
91      property Active: boolean read fActive write fActive;
92      property Delays: TDragScrollDelays read fDelays write fDelays;
93      property Margins: TDragScrollMargins read fMargins write fMargins;
94    end;
95  
96    TDragScrollDirections = (dsdUp, dsdDown, dsdLeft, dsdRight);
97    TDragScrollDirection = set of TDragScrollDirections;
98    TDragScrollEvent = procedure(Sender: TObject; TopRow, LeftCol: LongInt; var
99      DragScrollDir: TDragScrollDirection; var CanScroll: boolean) of object;
100 
101 type
102   TDragScrollGrid = class(TStringGrid)
103   private
104     { Private declarations }
105     //Drag Scrolling
106     fDragScrollOptions: TDragScrollOptions;
107     fTmr: TTimer;
108     fDragScrollDirection: TDragScrollDirection;
109     fOnDragScroll: TDragScrollEvent;
110     procedure SetDragScrollOptions(Value: TDragScrollOptions);
111   protected
112     { Protected declarations }
113     procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; var 
114 Accept:
115       Boolean); override;
116     procedure TimerProc(Sender: Tobject);
117   public
118     { Public declarations }
119     constructor Create(AOwner: TComponent); override;
120     destructor Destroy; override;
121   published
122     { Published declarations }
123     property OnDragScroll: TDragScrollEvent read fOnDragScroll
124       write fOnDragScroll;
125     property DragScrollOptions: TDragScrollOptions read fDragScrollOptions write
126       SetDragScrollOptions;
127   end;
128 
129 procedure Register;
130 
131 implementation
132 
133 procedure Register;
134 begin
135   RegisterComponents('Grid]);
136 end;
137 
138 //---TDragScrollOptions
139 
140 constructor TDragScrollOptions.create;
141 begin
142   inherited;
143   fDelays := TDragScrollDelays.create;
144   fDelays.InitialDelay := 1000;
145   fDelays.RepeatDelay := 250;
146   fMargins := TDragScrollMargins.create;
147   fMargins.TopMargin := 50;
148   fMargins.BottomMargin := 50;
149   fMargins.LeftMargin := 50;
150   fMargins.RightMargin := 50;
151 end;
152 
153 destructor TDragScrollOptions.destroy;
154 begin
155   fDelays.free;
156   fMargins.free;
157   inherited;
158 end;
159 
160 //---TDragScrollGrid
161 
162 constructor TDragScrollGrid.Create(AOwner: TComponent);
163 begin
164   inherited Create(AOwner);
165   fDragScrollOptions := TDragScrollOptions.create;
166 end;
167 
168 destructor TDragScrollGrid.Destroy;
169 begin
170   if Assigned(fTmr) then
171   begin
172     fTmr.enabled := false;
173     fTmr.Free;
174   end;
175   fDragScrollOptions.free;
176 
177   inherited Destroy;
178 end;
179 
180 //---Drag Scroll initialisation and finalisation
181 
182 procedure TDragScrollGrid.DragOver(Source: TObject; X, Y: Integer; State: 
183 TDragState;
184   var Accept: Boolean);
185 var
186   CurrentlyScrolling: boolean;
187 begin
188   if not (fDragScrollOptions.Active) then
189   begin
190     if Assigned(fTmr) then
191     begin
192       fTmr.enabled := false;
193       fTmr.free;
194       fTmr := nil;
195     end;
196     inherited;
197     exit;
198   end;
199   if fDragScrollDirection = [] then
200     CurrentlyScrolling := false
201   else
202     CurrentlyScrolling := true;
203   fDragScrollDirection := [];
204   case State of
205     dsDragEnter, dsDragMove:
206       begin
207         //Moving in the Grid, Check the Borders
208         if y Include(fDragScrollDirection, dsdUp)
209   else
210     if y > (Height - fDragScrollOptions.Margins.BottomMargin) then
211       Include(fDragScrollDirection, dsdDown);
212     if x Include(fDragScrollDirection, dsdLeft)
213   else
214     if x > (width - fDragScrollOptions.Margins.RightMargin) then
215       Include(fDragScrollDirection, dsdRight);
216     //Any Borders hit?
217     if fDragScrollDirection = [] then
218     begin
219       //Turn Timer off
220       if Assigned(fTmr) then
221       begin
222         fTmr.Enabled := false;
223         fTmr.free;
224         fTmr := nil;
225       end;
226     end
227     else
228     begin
229       if not (Assigned(fTmr)) then
230       begin
231         fTmr := TTimer.Create(Parent);
232         fTmr.Interval := fDragScrollOptions.Delays.InitialDelay;
233         fTmr.OnTimer := TimerProc;
234         fTmr.enabled := true;
235       end
236       else
237       begin
238         //Reset the Timer if a new scroll is required
239         if not (CurrentlyScrolling) then
240           fTmr.Interval := fDragScrollOptions.Delays.InitialDelay;
241       end;
242     end;
243   end;
244   dsDragLeave:
245   begin
246     if Assigned(fTmr) then
247     begin
248       fTmr.Enabled := false;
249       fTmr.free;
250       fTmr := nil;
251     end;
252   end;
253 end;
254 inherited;
255 end;
256 
257 //---Drag Scroll Timer..
258 
259 procedure TDragScrollGrid.TimerProc(Sender: Tobject);
260 var
261   CanScroll: Boolean;
262   DSD: TDragScrollDirection;
263 begin
264   if not (fDragScrollOptions.Active) then
265   begin
266     fTmr.Enabled := false;
267     fTmr.free;
268     fTmr := nil;
269     exit;
270   end;
271   fTmr.Interval := fDragScrollOptions.Delays.RepeatDelay;
272   //Do Scroll if User is OK with it
273   DSD := fDragScrollDirection;
274   if Assigned(fOnDragScroll) then
275   begin
276     CanScroll := true;
277     fOnDragScroll(Self, TopRow, LeftCol, DSD, CanScroll);
278     if not (CanScroll) then
279       exit;
280   end;
281   //Allow scroll
282   if dsdUp in DSD then
283   begin
284     if TopRow > FixedRows then
285       TopRow := TopRow - 1;
286   end;
287   if dsdDown in DSD then
288   begin
289     if (TopRow + VisibleRowCount) < (RowCount) then
290       TopRow := TopRow + 1;
291   end;
292   if dsdLeft in DSD then
293   begin
294     if LeftCol > FixedCols then
295       LeftCol := LeftCol - 1;
296   end;
297   if dsdRight in DSD then
298   begin
299     if (LeftCol + VisibleColCount) < (ColCount) then
300       LeftCol := LeftCol + 1;
301   end;
302 end;
303 
304 //---
305 
306 procedure TDragScrollGrid.SetDragScrollOptions(Value: TDragScrollOptions);
307 begin
308   fDragScrollOptions.Assign(Value);
309   if csDesigning in ComponentState then
310     invalidate;
311 end;
312 
313 end.
 


Component Download: http://www.dsparsons.co.uk/DragScrollGrid.zip

			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC