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
|
