1 |
tony |
23 |
{ |
2 |
|
|
/*************************************************************************** |
3 |
|
|
DBControlGrid.pas |
4 |
|
|
----------- |
5 |
|
|
An interface to DB aware Controls |
6 |
|
|
Initial Revision : Sun Mar 8 2015 |
7 |
|
|
|
8 |
|
|
|
9 |
|
|
***************************************************************************/ |
10 |
|
|
|
11 |
|
|
Unashameably hacked from DBGrid.Pas (Copyright (C) 2003 Jesus Reyes Aguilar.) |
12 |
|
|
by Tony Whyman (tony@mwasoftware.co.uk) .Additional source code is |
13 |
|
|
Copyright (c) McCallum Whyman Associates Ltd (trading as MWA Software) 2015. |
14 |
|
|
|
15 |
|
|
This unit defines TDBControlGrid: a lookalike rather than a clone for the Delphi |
16 |
|
|
TDBCrtlGrid. TDBControlGrid is a single column grid that replicates a TWinControl |
17 |
|
|
- typically a TPanel or a TFrame in each row. Each row corresponding to the rows |
18 |
|
|
of the linked DataSource. Any data aware control on the replicated (e.g.) TPanel |
19 |
|
|
will then appear to have the appropriate value for the row. |
20 |
|
|
|
21 |
|
|
The replicated control is not part of this control but must be added by the |
22 |
|
|
programmer at design time, and linked to the "DrawPanel" property. |
23 |
|
|
|
24 |
|
|
Rows can be edited, inserted (append only) or deleted. |
25 |
|
|
|
26 |
|
|
Distributed and licensed under the Library GNU General Public License |
27 |
|
|
see https://www.gnu.org/licenses/lgpl.html with the following modification: |
28 |
|
|
|
29 |
|
|
As a special exception, the copyright holders of this library give you |
30 |
|
|
permission to link this library with independent modules to produce an |
31 |
|
|
executable, regardless of the license terms of these independent modules, |
32 |
|
|
and to copy and distribute the resulting executable under terms of your choice, |
33 |
|
|
provided that you also meet, for each linked independent module, the terms |
34 |
|
|
and conditions of the license of that module. An independent module is a |
35 |
|
|
module which is not derived from or based on this library. If you modify this |
36 |
|
|
library, you may extend this exception to your version of the library, but |
37 |
|
|
you are not obligated to do so. If you do not wish to do so, delete this |
38 |
|
|
exception statement from your version. |
39 |
|
|
|
40 |
|
|
} |
41 |
|
|
unit DBControlGrid; |
42 |
|
|
|
43 |
|
|
{$mode objfpc}{$H+} |
44 |
|
|
|
45 |
|
|
interface |
46 |
|
|
|
47 |
|
|
uses |
48 |
|
|
Classes, Controls, SysUtils, DB, Grids, DBGrids, Graphics, StdCtrls, |
49 |
|
|
LMessages; |
50 |
|
|
|
51 |
|
|
{ |
52 |
|
|
The TRowCache is where we keep track of the DataSet and cache images of each row. |
53 |
|
|
TDBControlGrid is really a slight of hand. Only the active record is shown in |
54 |
|
|
the panel and the others are cached and displayed as images. |
55 |
|
|
|
56 |
|
|
The image cache is indexed by TDataSet.RecNo and accessed by current active |
57 |
|
|
record number (the data being displayed on the panel) and row offset from this |
58 |
|
|
record number. |
59 |
|
|
|
60 |
|
|
This is efficient but gives us a problem as the TDataSet model does not remove |
61 |
|
|
deleted records. Instead it simply marks them as deleted. Likewise, we need to |
62 |
|
|
keep track of deleted rows and skip over them when accessing the cache. |
63 |
|
|
|
64 |
|
|
When alternate row colours are in use, the cache is also used to keep track of the |
65 |
|
|
correct row colour as we must similarly ignore delete rows when calculating the |
66 |
|
|
correct colour. Odd and Even row numbers is not good enough here. |
67 |
|
|
} |
68 |
|
|
|
69 |
|
|
type |
70 |
|
|
TRowCacheState = (rcEmpty,rcPresent,rcDeleted); |
71 |
|
|
TRowDetails = record |
72 |
|
|
FState: TRowCacheState; |
73 |
|
|
FAlternateColor: boolean; |
74 |
|
|
FBitmap: TBitmap; |
75 |
|
|
end; |
76 |
|
|
|
77 |
|
|
{ TRowCache } |
78 |
|
|
|
79 |
|
|
TRowCache = class |
80 |
|
|
private |
81 |
|
|
FAltColorStartNormal: boolean; |
82 |
|
|
FHeight: integer; |
83 |
|
|
FList: array of TRowDetails; |
84 |
|
|
FUseAlternateColors: boolean; |
85 |
|
|
FWidth: integer; |
86 |
|
|
procedure FreeImages(Reset: boolean); |
87 |
|
|
function GetAlternateColor(RecNo: integer): boolean; |
88 |
|
|
function Render(Control: TWinControl): TBitmap; |
89 |
|
|
procedure ExtendCache(aMaxIndex: integer); |
90 |
|
|
procedure OnWidthChange(Sender: TObject); |
91 |
|
|
procedure SetHeight(AValue: integer); |
92 |
|
|
procedure SetUseAlternateColors(AValue: boolean); |
93 |
|
|
procedure SetWidth(AValue: integer); |
94 |
|
|
public |
95 |
|
|
constructor Create; |
96 |
|
|
destructor Destroy; override; |
97 |
|
|
procedure ClearCache; |
98 |
|
|
function Add2Cache(RecNo: Longint; Control: TWinControl): TBitmap; |
99 |
|
|
function GetRowImage(RecNo, Offset: integer): TBitmap; |
100 |
|
|
function IsEmpty(RecNo: integer): boolean; |
101 |
|
|
procedure MarkAsDeleted(RecNo: integer); |
102 |
|
|
property AlternateColor[RecNo: integer]: boolean read GetAlternateColor; |
103 |
|
|
property Width: integer read FWidth write SetWidth; |
104 |
|
|
property Height: integer read FHeight write SetHeight; |
105 |
|
|
property AltColorStartNormal: boolean read FAltColorStartNormal write FAltColorStartNormal; |
106 |
|
|
property UseAlternateColors: boolean read FUseAlternateColors write SetUseAlternateColors; |
107 |
|
|
end; |
108 |
|
|
|
109 |
|
|
{ TDBControlGridDataLink } |
110 |
|
|
|
111 |
|
|
TDBControlGridDataLink = class(TComponentDataLink) |
112 |
|
|
private |
113 |
|
|
FOnCheckBrowseMode: TDataSetNotifyEvent; |
114 |
|
|
protected |
115 |
|
|
procedure CheckBrowseMode; override; |
116 |
|
|
public |
117 |
|
|
property OnCheckBrowseMode: TDataSetNotifyEvent read FOnCheckBrowseMode write FOnCheckBrowseMode; |
118 |
|
|
end; |
119 |
|
|
|
120 |
|
|
TKeyDownHandler = procedure (Sender: TObject; var Key: Word; Shift: TShiftState; var Done: boolean) of object; |
121 |
|
|
|
122 |
|
|
TPanelGridOption = (dgpIndicator,dgpDisableInsert,dgpCancelOnExit); |
123 |
|
|
TPanelGridOptions = set of TPanelGridOption; |
124 |
|
|
|
125 |
|
|
{ TDBControlGrid } |
126 |
|
|
|
127 |
|
|
TDBControlGrid = class(TCustomGrid) |
128 |
|
|
private |
129 |
|
|
{ Private declarations } |
130 |
|
|
FDataLink: TDBControlGridDataLink; |
131 |
|
|
FDefaultPositionAtEnd: boolean; |
132 |
|
|
FDrawPanel: TWinControl; |
133 |
|
|
FDrawingActiveRecord: boolean; |
134 |
|
|
FOldPosition: Integer; |
135 |
|
|
FOnKeyDownHander: TKeyDownHandler; |
136 |
|
|
FOptions: TPanelGridOptions; |
137 |
|
|
FWeHaveFocus: boolean; |
138 |
|
|
FRowCache: TRowCache; |
139 |
|
|
FDrawRow: integer; {The current row in the draw panel} |
140 |
|
|
FSelectedRow: integer; {The row containing the current selection} |
141 |
|
|
FSelectedRecNo: integer; {The DataSet RecNo for the current row} |
142 |
|
|
FRequiredRecNo: integer; {Used after a big jump and is the dataset recno |
143 |
|
|
that we want to end up with} |
144 |
|
|
FInCacheRefresh: boolean; {Cache refresh in progress during paint} |
145 |
|
|
FCacheRefreshQueued: boolean; {cache refresh requested during wmpaint} |
146 |
|
|
FModified: boolean; |
147 |
|
|
FLastRecordCount: integer; |
148 |
|
|
|
149 |
|
|
{Used to pass mouse clicks to panel when focused row changes} |
150 |
|
|
FLastMouse: TPoint; |
151 |
|
|
FLastMouseButton: TMouseButton; |
152 |
|
|
FLastMouseShiftState: TShiftState; |
153 |
|
|
|
154 |
|
|
procedure EmptyGrid; |
155 |
|
|
function GetDataSource: TDataSource; |
156 |
|
|
function GetRecordCount: Integer; |
157 |
|
|
procedure GetScrollbarParams(out aRange, aPage, aPos: Integer); |
158 |
|
|
function GridCanModify: boolean; |
159 |
|
|
procedure DoDrawRow(aRow: integer; aRect: TRect; aState: TGridDrawState); |
160 |
|
|
procedure DoMoveRecord(Data: PtrInt); |
161 |
|
|
procedure DoScrollDataSet(Data: PtrInt); |
162 |
|
|
procedure DoSetupDrawPanel(Data: PtrInt); |
163 |
|
|
procedure DoSendMouseClicks(Data: PtrInt); |
164 |
|
|
procedure KeyDownHandler(Sender: TObject; var Key: Word; Shift: TShiftState); |
165 |
|
|
procedure OnRecordChanged(Field:TField); |
166 |
|
|
procedure OnCheckBrowseMode(aDataSet: TDataSet); |
167 |
|
|
procedure OnDataSetChanged(aDataSet: TDataSet); |
168 |
|
|
procedure OnDataSetOpen(aDataSet: TDataSet); |
169 |
|
|
procedure OnDataSetClose(aDataSet: TDataSet); |
170 |
|
|
procedure OnDrawPanelResize(Sender: TObject); |
171 |
|
|
procedure OnEditingChanged(aDataSet: TDataSet); |
172 |
|
|
procedure OnInvalidDataSet(aDataSet: TDataSet); |
173 |
|
|
procedure OnInvalidDataSource(aDataSet: TDataset); |
174 |
|
|
procedure OnLayoutChanged(aDataSet: TDataSet); |
175 |
|
|
procedure OnNewDataSet(aDataSet: TDataset); |
176 |
|
|
procedure OnDataSetScrolled(aDataSet:TDataSet; Distance: Integer); |
177 |
|
|
procedure OnUpdateData(aDataSet: TDataSet); |
178 |
|
|
procedure SetDataSource(AValue: TDataSource); |
179 |
|
|
procedure SetDrawPanel(AValue: TWinControl); |
180 |
|
|
procedure SetOptions(AValue: TPanelGridOptions); |
181 |
|
|
procedure SetupDrawPanel(aRow: integer); |
182 |
|
|
function UpdateGridCounts: Integer; |
183 |
|
|
procedure UpdateBufferCount; |
184 |
|
|
procedure UpdateDrawPanelBounds(aRow: integer); |
185 |
|
|
procedure UpdateScrollbarRange; |
186 |
|
|
procedure WMVScroll(var Message : TLMVScroll); message LM_VScroll; |
187 |
|
|
function ISEOF: boolean; |
188 |
|
|
function ValidDataSet: boolean; |
189 |
|
|
function InsertCancelable: boolean; |
190 |
|
|
protected |
191 |
|
|
{ Protected declarations } |
192 |
|
|
function GetBufferCount: integer; virtual; |
193 |
|
|
procedure DoEnter; override; |
194 |
|
|
procedure DoExit; override; |
195 |
|
|
procedure DoGridResize; |
196 |
|
|
procedure DoOnResize; override; |
197 |
|
|
procedure DrawAllRows; override; |
198 |
|
|
procedure DrawRow(ARow: Integer); override; |
199 |
|
|
procedure DrawCell(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState); override; |
200 |
|
|
procedure DrawIndicator(ACanvas: TCanvas; aRow: integer; R: TRect; Opt: TDataSetState; MultiSel: boolean); virtual; |
201 |
|
|
procedure GridMouseWheel(shift: TShiftState; Delta: Integer); override; |
202 |
|
|
procedure KeyDown(var Key : Word; Shift : TShiftState); override; |
203 |
|
|
procedure LinkActive(Value: Boolean); virtual; |
204 |
|
|
procedure LayoutChanged; virtual; |
205 |
|
|
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override; |
206 |
|
|
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override; |
207 |
|
|
procedure MoveSelection; override; |
208 |
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override; |
209 |
|
|
procedure PrepareCanvas(aCol,aRow: Integer; aState:TGridDrawState); override; |
210 |
|
|
procedure ResetSizes; override; |
211 |
|
|
procedure SetColor(Value: TColor); override; |
212 |
|
|
procedure UpdateActive; virtual; |
213 |
|
|
procedure UpdateData; virtual; |
214 |
|
|
procedure UpdateShowing; override; |
215 |
|
|
procedure UpdateVertScrollbar(const aVisible: boolean; const aRange,aPage,aPos: Integer); override; |
216 |
|
|
public |
217 |
|
|
{ Public declarations } |
218 |
|
|
constructor Create(AOwner: TComponent); override; |
219 |
|
|
destructor Destroy; override; |
220 |
|
|
function MouseToRecordOffset(const x, y: Integer; out RecordOffset: Integer |
221 |
|
|
): TGridZone; |
222 |
|
|
function ExecuteAction(AAction: TBasicAction): Boolean; override; |
223 |
|
|
function UpdateAction(AAction: TBasicAction): Boolean; override; |
224 |
|
|
property Datalink: TDBControlGridDataLink read FDatalink; |
225 |
|
|
published |
226 |
|
|
{ Published declarations } |
227 |
|
|
property Align; |
228 |
|
|
property AlternateColor; |
229 |
|
|
property AltColorStartNormal; |
230 |
|
|
property Anchors; |
231 |
|
|
property BiDiMode; |
232 |
|
|
property BorderSpacing; |
233 |
|
|
property BorderStyle; |
234 |
|
|
property CellHintPriority; |
235 |
|
|
property Color; |
236 |
|
|
property Constraints; |
237 |
|
|
property DataSource: TDataSource read GetDataSource write SetDataSource; |
238 |
|
|
property DefaultRowHeight; |
239 |
|
|
property DefaultPositionAtEnd: boolean read FDefaultPositionAtEnd write FDefaultPositionAtEnd; |
240 |
|
|
property DragCursor; |
241 |
|
|
property DragMode; |
242 |
|
|
property DrawPanel: TWinControl read FDrawPanel write SetDrawPanel; |
243 |
|
|
property Enabled; |
244 |
|
|
property FixedColor; |
245 |
|
|
property FixedCols; |
246 |
|
|
property Flat; |
247 |
|
|
property Font; |
248 |
|
|
property Options: TPanelGridOptions read FOptions write SetOptions; |
249 |
|
|
property ParentBiDiMode; |
250 |
|
|
property ParentColor default false; |
251 |
|
|
property ParentFont; |
252 |
|
|
property PopupMenu; |
253 |
|
|
property Scrollbars default ssAutoVertical; |
254 |
|
|
property ShowHint; |
255 |
|
|
property TabOrder; |
256 |
|
|
property TabStop; |
257 |
|
|
property UseXORFeatures; |
258 |
|
|
property Visible; |
259 |
|
|
property OnContextPopup; |
260 |
|
|
property OnDblClick; |
261 |
|
|
property OnDragDrop; |
262 |
|
|
property OnDragOver; |
263 |
|
|
property OnEndDrag; |
264 |
|
|
property OnEnter; |
265 |
|
|
property OnExit; |
266 |
|
|
property OnGetCellHint; |
267 |
|
|
property OnKeyDown; |
268 |
|
|
property OnKeyPress; |
269 |
|
|
property OnKeyUp; |
270 |
|
|
property OnKeyDownHander: TKeyDownHandler read FOnKeyDownHander write FOnKeyDownHander; |
271 |
|
|
property OnMouseDown; |
272 |
|
|
property OnMouseEnter; |
273 |
|
|
property OnMouseLeave; |
274 |
|
|
property OnMouseMove; |
275 |
|
|
property OnMouseUp; |
276 |
|
|
property OnMouseWheel; |
277 |
|
|
property OnMouseWheelDown; |
278 |
|
|
property OnMouseWheelUp; |
279 |
|
|
property OnPrepareCanvas; |
280 |
|
|
property OnStartDrag; |
281 |
|
|
property OnUTF8KeyPress; |
282 |
|
|
end; |
283 |
|
|
|
284 |
|
|
implementation |
285 |
|
|
|
286 |
|
|
uses LCLType, Math, LCLIntf, Forms, LCLMessageGlue; |
287 |
|
|
|
288 |
|
|
{ TDBControlGridDataLink } |
289 |
|
|
|
290 |
|
|
procedure TDBControlGridDataLink.CheckBrowseMode; |
291 |
|
|
begin |
292 |
|
|
inherited CheckBrowseMode; |
293 |
|
|
if assigned(FOnCheckBrowseMode) then |
294 |
|
|
OnCheckBrowseMode(DataSet); |
295 |
|
|
end; |
296 |
|
|
|
297 |
|
|
{ TRowCache } |
298 |
|
|
|
299 |
|
|
function TRowCache.Render(Control: TWinControl): TBitmap; |
300 |
|
|
var Container: TBitmap; |
301 |
|
|
Msg: TLMPaint; |
302 |
|
|
begin |
303 |
|
|
Container := TBitmap.Create; |
304 |
|
|
try |
305 |
|
|
Container.SetSize(Control.Width,Control.Height); |
306 |
|
|
Control.PaintTo(Container.Canvas,0,0); |
307 |
|
|
except |
308 |
|
|
Container.Free; |
309 |
|
|
raise |
310 |
|
|
end; |
311 |
|
|
Result := Container; |
312 |
|
|
end; |
313 |
|
|
|
314 |
|
|
procedure TRowCache.FreeImages(Reset: boolean); |
315 |
|
|
var i: integer; |
316 |
|
|
altColor: boolean; |
317 |
|
|
begin |
318 |
|
|
altColor := not AltColorStartNormal; |
319 |
|
|
for i := 0 to Length(FList) - 1 do |
320 |
|
|
begin |
321 |
|
|
if (FList[i].FState <> rcEmpty) and (FList[i].FBitmap <> nil) then |
322 |
|
|
begin |
323 |
|
|
FList[i].FBitmap.Free; |
324 |
|
|
FList[i].FBitmap := nil; |
325 |
|
|
end; |
326 |
|
|
if Reset or (FList[i].FState = rcPresent) then |
327 |
|
|
FList[i].FState := rcEmpty; |
328 |
|
|
if FList[i].FState <> rcDeleted then |
329 |
|
|
begin |
330 |
|
|
FList[i].FAlternateColor := altColor; |
331 |
|
|
altColor := not altColor; |
332 |
|
|
end; |
333 |
|
|
end; |
334 |
|
|
end; |
335 |
|
|
|
336 |
|
|
function TRowCache.GetAlternateColor(RecNo: integer): boolean; |
337 |
|
|
begin |
338 |
|
|
ExtendCache(RecNo); |
339 |
|
|
Dec(RecNo); |
340 |
|
|
if (RecNo >= 0) and (RecNo < Length(FList)) then |
341 |
|
|
Result := FList[RecNo].FAlternateColor |
342 |
|
|
else |
343 |
|
|
Result := false; |
344 |
|
|
end; |
345 |
|
|
|
346 |
|
|
procedure TRowCache.ExtendCache(aMaxIndex: integer); |
347 |
|
|
var i: integer; |
348 |
|
|
StartIndex: integer; |
349 |
|
|
altColor: boolean; |
350 |
|
|
begin |
351 |
|
|
if aMaxIndex > Length(FList) then |
352 |
|
|
begin |
353 |
|
|
aMaxIndex := aMaxIndex + 10; |
354 |
|
|
StartIndex := Length(FList); |
355 |
|
|
SetLength(FList,aMaxIndex); |
356 |
|
|
if not UseAlternateColors then |
357 |
|
|
altColor := false |
358 |
|
|
else |
359 |
|
|
if StartIndex = 0 then |
360 |
|
|
altColor := not AltColorStartNormal |
361 |
|
|
else |
362 |
|
|
altColor := not FList[StartIndex-1].FAlternateColor; |
363 |
|
|
|
364 |
|
|
for i := StartIndex to Length(FList) - 1 do |
365 |
|
|
begin |
366 |
|
|
FList[i].FState := rcEmpty; |
367 |
|
|
FList[i].FAlternateColor := altColor; |
368 |
|
|
if UseAlternateColors then |
369 |
|
|
altColor := not altColor; |
370 |
|
|
end; |
371 |
|
|
end; |
372 |
|
|
end; |
373 |
|
|
|
374 |
|
|
procedure TRowCache.OnWidthChange(Sender: TObject); |
375 |
|
|
begin |
376 |
|
|
FreeImages(false); |
377 |
|
|
end; |
378 |
|
|
|
379 |
|
|
procedure TRowCache.SetHeight(AValue: integer); |
380 |
|
|
begin |
381 |
|
|
if FHeight = AValue then Exit; |
382 |
|
|
FHeight := AValue; |
383 |
|
|
FreeImages(false); |
384 |
|
|
end; |
385 |
|
|
|
386 |
|
|
procedure TRowCache.SetUseAlternateColors(AValue: boolean); |
387 |
|
|
begin |
388 |
|
|
if FUseAlternateColors = AValue then Exit; |
389 |
|
|
FUseAlternateColors := AValue; |
390 |
|
|
FreeImages(false); |
391 |
|
|
end; |
392 |
|
|
|
393 |
|
|
procedure TRowCache.SetWidth(AValue: integer); |
394 |
|
|
begin |
395 |
|
|
if FWidth = AValue then Exit; |
396 |
|
|
FWidth := AValue; |
397 |
|
|
FreeImages(false); |
398 |
|
|
end; |
399 |
|
|
|
400 |
|
|
constructor TRowCache.Create; |
401 |
|
|
begin |
402 |
|
|
SetLength(FList,0); |
403 |
|
|
end; |
404 |
|
|
|
405 |
|
|
destructor TRowCache.Destroy; |
406 |
|
|
begin |
407 |
|
|
ClearCache; |
408 |
|
|
inherited Destroy; |
409 |
|
|
end; |
410 |
|
|
|
411 |
|
|
procedure TRowCache.ClearCache; |
412 |
|
|
begin |
413 |
|
|
FreeImages(true); |
414 |
|
|
end; |
415 |
|
|
|
416 |
|
|
function TRowCache.Add2Cache(RecNo: Longint; Control: TWinControl): TBitmap; |
417 |
|
|
var i: integer; |
418 |
|
|
begin |
419 |
|
|
Dec(RecNo); {Adust to zero base} |
420 |
|
|
ExtendCache(RecNo + 1); |
421 |
|
|
FList[RecNo].FState := rcPresent; |
422 |
|
|
FList[RecNo].FBitmap := Render(Control); |
423 |
|
|
Result := FList[RecNo].FBitmap; |
424 |
|
|
end; |
425 |
|
|
|
426 |
|
|
function TRowCache.GetRowImage(RecNo, Offset: integer): TBitmap; |
427 |
|
|
begin |
428 |
|
|
Result := nil; |
429 |
|
|
Dec(RecNo); {adjust to zero base} |
430 |
|
|
if (RecNo < 0) or (RecNo >= Length(FList)) then |
431 |
|
|
Exit; |
432 |
|
|
|
433 |
|
|
if Offset >= 0 then |
434 |
|
|
repeat |
435 |
|
|
while (RecNo < Length(FList)) and (FList[RecNo].FState = rcDeleted) do |
436 |
|
|
Inc(RecNo); |
437 |
|
|
|
438 |
|
|
if RecNo >= Length(FList) then |
439 |
|
|
Exit; |
440 |
|
|
|
441 |
|
|
if Offset = 0 then |
442 |
|
|
begin |
443 |
|
|
if FList[RecNo].FState = rcPresent then |
444 |
|
|
Result := FList[RecNo].FBitmap; |
445 |
|
|
Exit; |
446 |
|
|
end; |
447 |
|
|
Inc(RecNo); |
448 |
|
|
Dec(Offset); |
449 |
|
|
until false |
450 |
|
|
else |
451 |
|
|
repeat |
452 |
|
|
Inc(Offset); |
453 |
|
|
Dec(RecNo); |
454 |
|
|
while (RecNo > 0) and (FList[RecNo].FState = rcDeleted) do |
455 |
|
|
Dec(RecNo); |
456 |
|
|
|
457 |
|
|
if RecNo < 0 then |
458 |
|
|
Exit; |
459 |
|
|
|
460 |
|
|
if Offset = 0 then |
461 |
|
|
begin |
462 |
|
|
if FList[RecNo].FState = rcPresent then |
463 |
|
|
Result := FList[RecNo].FBitmap; |
464 |
|
|
Exit; |
465 |
|
|
end; |
466 |
|
|
until false; |
467 |
|
|
end; |
468 |
|
|
|
469 |
|
|
function TRowCache.IsEmpty(RecNo: integer): boolean; |
470 |
|
|
begin |
471 |
|
|
Dec(RecNo); |
472 |
|
|
Result := (RecNo < 0) or (RecNo >= Length(FList)) or (FList[RecNo].FState = rcEmpty); |
473 |
|
|
end; |
474 |
|
|
|
475 |
|
|
procedure TRowCache.MarkAsDeleted(RecNo: integer); |
476 |
|
|
var altColor: boolean; |
477 |
|
|
i: integer; |
478 |
|
|
begin |
479 |
|
|
Dec(RecNo); {adjust to zero base} |
480 |
|
|
if (RecNo < 0) or (RecNo >= Length(FList)) then |
481 |
|
|
Exit; |
482 |
|
|
|
483 |
|
|
FList[RecNo].FState := rcDeleted; |
484 |
|
|
if not UseAlternateColors then |
485 |
|
|
Exit; |
486 |
|
|
|
487 |
|
|
{Reset Alternate Colours} |
488 |
|
|
|
489 |
|
|
if RecNo = 0 then |
490 |
|
|
altColor := not AltColorStartNormal |
491 |
|
|
else |
492 |
|
|
altColor := not FList[RecNo-1].FAlternateColor; |
493 |
|
|
|
494 |
|
|
for i := RecNo + 1 to Length(FList) - 1 do |
495 |
|
|
begin |
496 |
|
|
if FList[i].FState <> rcDeleted then |
497 |
|
|
begin |
498 |
|
|
FList[i].FAlternateColor := altColor; |
499 |
|
|
altColor := not altColor; |
500 |
|
|
if FList[i].FState = rcPresent then |
501 |
|
|
begin |
502 |
|
|
FList[i].FBitmap.Free; |
503 |
|
|
FList[i].FState := rcEmpty; |
504 |
|
|
end; |
505 |
|
|
end; |
506 |
|
|
end; |
507 |
|
|
end; |
508 |
|
|
|
509 |
|
|
{ TDBControlGrid } |
510 |
|
|
|
511 |
|
|
procedure TDBControlGrid.EmptyGrid; |
512 |
|
|
var |
513 |
|
|
OldFixedRows: Integer; |
514 |
|
|
begin |
515 |
|
|
OldFixedRows := FixedRows; |
516 |
|
|
Clear; |
517 |
|
|
RowCount := OldFixedRows + 1; |
518 |
|
|
if dgpIndicator in FOptions then |
519 |
|
|
ColWidths[0]:=12; |
520 |
|
|
if assigned(FDrawPanel) then |
521 |
|
|
FDrawPanel.Visible := false; |
522 |
|
|
end; |
523 |
|
|
|
524 |
|
|
function TDBControlGrid.GetDataSource: TDataSource; |
525 |
|
|
begin |
526 |
|
|
Result:= FDataLink.DataSource; |
527 |
|
|
end; |
528 |
|
|
|
529 |
|
|
function TDBControlGrid.GetRecordCount: Integer; |
530 |
|
|
begin |
531 |
|
|
if assigned(FDataLink.DataSet) then |
532 |
|
|
result := FDataLink.DataSet.RecordCount |
533 |
|
|
else |
534 |
|
|
result := 0; |
535 |
|
|
end; |
536 |
|
|
|
537 |
|
|
procedure TDBControlGrid.GetScrollbarParams(out aRange, aPage, aPos: Integer); |
538 |
|
|
begin |
539 |
|
|
if (FDatalink<>nil) and (FDataLink.DataSet <> nil) and FDatalink.Active then begin |
540 |
|
|
if FDatalink.dataset.IsSequenced then begin |
541 |
|
|
aRange := GetRecordCount + VisibleRowCount - 1; |
542 |
|
|
aPage := VisibleRowCount; |
543 |
|
|
if aPage<1 then aPage := 1; |
544 |
|
|
if FDatalink.BOF then aPos := 0 else |
545 |
|
|
if FDatalink.EOF then aPos := aRange |
546 |
|
|
else |
547 |
|
|
aPos := FDataLink.DataSet.RecNo - 1; // RecNo is 1 based |
548 |
|
|
if aPos<0 then aPos:=0; |
549 |
|
|
end else begin |
550 |
|
|
aRange := 6; |
551 |
|
|
aPage := 2; |
552 |
|
|
if FDatalink.EOF then aPos := 4 else |
553 |
|
|
if FDatalink.BOF then aPos := 0 |
554 |
|
|
else aPos := 2; |
555 |
|
|
end; |
556 |
|
|
end else begin |
557 |
|
|
aRange := 0; |
558 |
|
|
aPage := 0; |
559 |
|
|
aPos := 0; |
560 |
|
|
end; |
561 |
|
|
end; |
562 |
|
|
|
563 |
|
|
function TDBControlGrid.GridCanModify: boolean; |
564 |
|
|
begin |
565 |
|
|
result := not FDataLink.ReadOnly |
566 |
|
|
and ValidDataSet and FDatalink.DataSet.CanModify; |
567 |
|
|
end; |
568 |
|
|
|
569 |
|
|
|
570 |
|
|
procedure TDBControlGrid.DoDrawRow(aRow: integer; aRect: TRect; |
571 |
|
|
aState: TGridDrawState); |
572 |
|
|
var CachedRow: TBitmap; |
573 |
|
|
begin |
574 |
|
|
CachedRow := FRowCache.GetRowImage(FSelectedRecNo,aRow-FDrawRow); |
575 |
|
|
{if the row is in the cache then draw it - otherwise schedule a cache refresh cycle} |
576 |
|
|
if CachedRow = nil then |
577 |
|
|
begin |
578 |
|
|
if not FCacheRefreshQueued then |
579 |
|
|
begin |
580 |
|
|
FCacheRefreshQueued := true; |
581 |
|
|
Application.QueueAsyncCall(@DoMoveRecord,PtrInt(aRow)); |
582 |
|
|
end |
583 |
|
|
end |
584 |
|
|
else |
585 |
|
|
Canvas.Draw(aRect.Left,aRect.Top,CachedRow) |
586 |
|
|
end; |
587 |
|
|
|
588 |
|
|
procedure TDBControlGrid.DoMoveRecord(Data: PtrInt); |
589 |
|
|
var aRow: integer; |
590 |
|
|
begin |
591 |
|
|
if AppDestroying in Application.Flags then Exit; |
592 |
|
|
|
593 |
|
|
FCacheRefreshQueued := false; |
594 |
|
|
aRow := integer(Data); |
595 |
|
|
FInCacheRefresh := true; |
596 |
|
|
if assigned(FDataLink.DataSet) then |
597 |
|
|
FDatalink.DataSet.MoveBy(aRow - FDrawRow) |
598 |
|
|
end; |
599 |
|
|
|
600 |
|
|
procedure TDBControlGrid.DoSetupDrawPanel(Data: PtrInt); |
601 |
|
|
begin |
602 |
|
|
if AppDestroying in Application.Flags then Exit; |
603 |
|
|
SetupDrawPanel(FDrawRow); |
604 |
|
|
end; |
605 |
|
|
|
606 |
|
|
procedure TDBControlGrid.DoSendMouseClicks(Data: PtrInt); |
607 |
|
|
var P: TPoint; |
608 |
|
|
Control: TControl; |
609 |
|
|
begin |
610 |
|
|
if AppDestroying in Application.Flags then Exit; |
611 |
|
|
|
612 |
|
|
if assigned(FDrawPanel) and (FLastMouse.X <> 0) then |
613 |
|
|
begin |
614 |
|
|
P := ClientToScreen(FLastMouse); |
615 |
|
|
Control := FindControlAtPosition(P,false); |
616 |
|
|
if (Control <> nil) and (Control is TWinControl) then |
617 |
|
|
TWinControl(Control).SetFocus |
618 |
|
|
else |
619 |
|
|
Control := FDrawPanel; |
620 |
|
|
|
621 |
|
|
P := Control.ScreenToClient(P); |
622 |
|
|
|
623 |
|
|
LCLSendMouseDownMsg(Control,P.X,P.Y,FLastMouseButton,FLastMouseShiftState); |
624 |
|
|
LCLSendMouseUpMsg(Control,P.X,P.Y, FLastMouseButton,FLastMouseShiftState); |
625 |
|
|
|
626 |
|
|
end; |
627 |
|
|
FLastMouse.X := 0; |
628 |
|
|
end; |
629 |
|
|
|
630 |
|
|
procedure TDBControlGrid.KeyDownHandler(Sender: TObject; var Key: Word; |
631 |
|
|
Shift: TShiftState); |
632 |
|
|
var Done: boolean; |
633 |
|
|
begin |
634 |
|
|
if Visible and assigned(FDrawPanel) and FDrawPanel.Visible and FWeHaveFocus then |
635 |
|
|
begin |
636 |
|
|
Done := false; |
637 |
|
|
if assigned(FOnKeyDownHander) then |
638 |
|
|
OnKeyDownHander(Sender,Key,Shift,Done); |
639 |
|
|
if Done then Exit; |
640 |
|
|
|
641 |
|
|
KeyDown(Key,Shift) |
642 |
|
|
end; |
643 |
|
|
end; |
644 |
|
|
|
645 |
|
|
procedure TDBControlGrid.OnRecordChanged(Field: TField); |
646 |
|
|
begin |
647 |
|
|
UpdateActive |
648 |
|
|
end; |
649 |
|
|
|
650 |
|
|
procedure TDBControlGrid.OnCheckBrowseMode(aDataSet: TDataSet); |
651 |
|
|
var RecNo: integer; |
652 |
|
|
begin |
653 |
|
|
if assigned(FDrawPanel) and (aDataSet.RecNo > 0) |
654 |
|
|
and (FModified or (FRowCache.IsEmpty(aDataSet.RecNo))) then |
655 |
|
|
begin |
656 |
|
|
RecNo := aDataSet.RecNo; |
657 |
|
|
Application.ProcessMessages; {A couple of trips round the message loop seems to be necessary} |
658 |
|
|
Application.ProcessMessages; |
659 |
|
|
if RecNo = aDataSet.RecNo then {Guard against sudden changes} |
660 |
|
|
FRowCache.Add2Cache(aDataSet.RecNo,FDrawPanel); |
661 |
|
|
end; |
662 |
|
|
end; |
663 |
|
|
|
664 |
|
|
procedure TDBControlGrid.OnDataSetChanged(aDataSet: TDataSet); |
665 |
|
|
begin |
666 |
|
|
if (aDataSet.State = dsBrowse) and (FLastRecordCount > GetRecordCount) then |
667 |
|
|
begin |
668 |
|
|
{must be delete} |
669 |
|
|
FRowCache.MarkAsDeleted(FSelectedRecNo); |
670 |
|
|
Dec(FSelectedRow); |
671 |
|
|
LayoutChanged; |
672 |
|
|
end; |
673 |
|
|
FLastRecordCount := GetRecordCount; |
674 |
|
|
if aDataSet.State = dsInsert then |
675 |
|
|
FRequiredRecNo := aDataSet.RecNo + 1; |
676 |
|
|
UpdateActive |
677 |
|
|
end; |
678 |
|
|
|
679 |
|
|
procedure TDBControlGrid.OnDataSetOpen(aDataSet: TDataSet); |
680 |
|
|
begin |
681 |
|
|
LinkActive(true); |
682 |
|
|
UpdateActive; |
683 |
|
|
end; |
684 |
|
|
|
685 |
|
|
procedure TDBControlGrid.OnDataSetClose(aDataSet: TDataSet); |
686 |
|
|
begin |
687 |
|
|
LinkActive(false); |
688 |
|
|
end; |
689 |
|
|
|
690 |
|
|
procedure TDBControlGrid.OnDrawPanelResize(Sender: TObject); |
691 |
|
|
begin |
692 |
|
|
FRowCache.Height := FDrawPanel.Height; |
693 |
|
|
DefaultRowHeight := FDrawPanel.Height; |
694 |
|
|
end; |
695 |
|
|
|
696 |
|
|
procedure TDBControlGrid.OnEditingChanged(aDataSet: TDataSet); |
697 |
|
|
begin |
698 |
|
|
FModified := true; |
699 |
|
|
end; |
700 |
|
|
|
701 |
|
|
procedure TDBControlGrid.OnInvalidDataSet(aDataSet: TDataSet); |
702 |
|
|
begin |
703 |
|
|
LinkActive(False); |
704 |
|
|
end; |
705 |
|
|
|
706 |
|
|
procedure TDBControlGrid.OnInvalidDataSource(aDataSet: TDataset); |
707 |
|
|
begin |
708 |
|
|
LinkActive(False); |
709 |
|
|
end; |
710 |
|
|
|
711 |
|
|
procedure TDBControlGrid.OnLayoutChanged(aDataSet: TDataSet); |
712 |
|
|
begin |
713 |
|
|
LayoutChanged; |
714 |
|
|
end; |
715 |
|
|
|
716 |
|
|
procedure TDBControlGrid.OnNewDataSet(aDataSet: TDataset); |
717 |
|
|
begin |
718 |
|
|
LinkActive(True); |
719 |
|
|
UpdateActive; |
720 |
|
|
end; |
721 |
|
|
|
722 |
|
|
procedure TDBControlGrid.OnDataSetScrolled(aDataSet: TDataSet; Distance: Integer); |
723 |
|
|
begin |
724 |
|
|
UpdateScrollBarRange; |
725 |
|
|
if Distance <> 0 then |
726 |
|
|
begin |
727 |
|
|
FDrawRow := FixedRows + FDataLink.ActiveRecord; |
728 |
|
|
|
729 |
|
|
if not FInCacheRefresh then |
730 |
|
|
begin |
731 |
|
|
Row := FDrawRow; |
732 |
|
|
FSelectedRow := FDrawRow; |
733 |
|
|
FSelectedRecNo := aDataSet.RecNo; |
734 |
|
|
SetupDrawPanel(FDrawRow); |
735 |
|
|
end |
736 |
|
|
else |
737 |
|
|
Application.QueueAsyncCall(@DoSetupDrawPanel,0); |
738 |
|
|
end |
739 |
|
|
else |
740 |
|
|
UpdateActive; |
741 |
|
|
end; |
742 |
|
|
|
743 |
|
|
procedure TDBControlGrid.OnUpdateData(aDataSet: TDataSet); |
744 |
|
|
begin |
745 |
|
|
UpdateData; |
746 |
|
|
end; |
747 |
|
|
|
748 |
|
|
procedure TDBControlGrid.SetDataSource(AValue: TDataSource); |
749 |
|
|
begin |
750 |
|
|
if AValue = FDatalink.Datasource then Exit; |
751 |
|
|
FDataLink.DataSource := AValue; |
752 |
|
|
UpdateActive; |
753 |
|
|
end; |
754 |
|
|
|
755 |
|
|
procedure TDBControlGrid.SetDrawPanel(AValue: TWinControl); |
756 |
|
|
var theForm: TWinControl; |
757 |
|
|
begin |
758 |
|
|
if FDrawPanel = AValue then Exit; |
759 |
|
|
if FDrawPanel <> nil then |
760 |
|
|
begin |
761 |
|
|
RemoveFreeNotification(FDrawPanel); |
762 |
|
|
FDrawPanel.RemoveAllHandlersOfObject(self); |
763 |
|
|
theForm := Parent; |
764 |
|
|
while not (theForm is TCustomForm) and (theForm.Parent <> nil) do |
765 |
|
|
theForm := theForm.Parent; |
766 |
|
|
FDrawPanel.Parent := theForm; |
767 |
|
|
end; |
768 |
|
|
FRowCache.ClearCache; |
769 |
|
|
try |
770 |
|
|
FDrawPanel := AValue; |
771 |
|
|
if assigned(FDrawPanel) then |
772 |
|
|
begin |
773 |
|
|
FDrawPanel.Parent := self; |
774 |
|
|
DefaultRowHeight := FDrawPanel.Height; |
775 |
|
|
if csDesigning in ComponentState then |
776 |
|
|
UpdateDrawPanelBounds(0) |
777 |
|
|
else |
778 |
|
|
FDrawPanel.Visible := false; |
779 |
|
|
FRowCache.Height := FDrawPanel.Height; |
780 |
|
|
FRowCache.Width := FDrawPanel.Width; |
781 |
|
|
AddHandlerOnResize(@OnDrawPanelResize); |
782 |
|
|
FreeNotification(FDrawPanel); |
783 |
|
|
end; |
784 |
|
|
except |
785 |
|
|
FDrawPanel := nil; |
786 |
|
|
raise; |
787 |
|
|
end; |
788 |
|
|
end; |
789 |
|
|
|
790 |
|
|
procedure TDBControlGrid.SetOptions(AValue: TPanelGridOptions); |
791 |
|
|
begin |
792 |
|
|
if FOptions = AValue then Exit; |
793 |
|
|
FOptions := AValue; |
794 |
|
|
if dgpIndicator in FOptions then |
795 |
|
|
begin |
796 |
|
|
FixedCols := 1; |
797 |
|
|
ColWidths[0] := 12 |
798 |
|
|
end |
799 |
|
|
else |
800 |
|
|
FixedCols := 0; |
801 |
|
|
end; |
802 |
|
|
|
803 |
|
|
procedure TDBControlGrid.SetupDrawPanel(aRow: integer); |
804 |
|
|
begin |
805 |
|
|
if ValidDataSet and FRowCache.AlternateColor[FDataLink.DataSet.RecNo] then |
806 |
|
|
FDrawPanel.Color := AlternateColor |
807 |
|
|
else |
808 |
|
|
FDrawPanel.Color := self.Color; |
809 |
|
|
FDrawPanel.Visible := true; |
810 |
|
|
UpdateDrawPanelBounds(aRow); {Position Draw Panel over expanded Row} |
811 |
|
|
Invalidate; |
812 |
|
|
end; |
813 |
|
|
|
814 |
|
|
function TDBControlGrid.UpdateGridCounts: Integer; |
815 |
|
|
var |
816 |
|
|
RecCount: Integer; |
817 |
|
|
FRCount, FCCount: Integer; |
818 |
|
|
begin |
819 |
|
|
BeginUpdate; |
820 |
|
|
try |
821 |
|
|
FRCount := 0; |
822 |
|
|
if dgpIndicator in FOptions then |
823 |
|
|
FCCount := 1 |
824 |
|
|
else |
825 |
|
|
FCCount := 0; |
826 |
|
|
if FDataLink.Active then begin |
827 |
|
|
UpdateBufferCount; |
828 |
|
|
RecCount := FDataLink.RecordCount; |
829 |
|
|
if RecCount<1 then |
830 |
|
|
RecCount := 1; |
831 |
|
|
end else begin |
832 |
|
|
RecCount := 0; |
833 |
|
|
if FRCount=0 then |
834 |
|
|
// need to be large enough to hold indicator |
835 |
|
|
// if there is one, and if there are no titles |
836 |
|
|
RecCount := FCCount; |
837 |
|
|
end; |
838 |
|
|
|
839 |
|
|
Inc(RecCount, FRCount); |
840 |
|
|
|
841 |
|
|
RowCount := RecCount; |
842 |
|
|
FixedRows := FRCount; |
843 |
|
|
Result := RowCount ; |
844 |
|
|
finally |
845 |
|
|
EndUpdate; |
846 |
|
|
end; |
847 |
|
|
end; |
848 |
|
|
|
849 |
|
|
procedure TDBControlGrid.UpdateBufferCount; |
850 |
|
|
var |
851 |
|
|
BCount: Integer; |
852 |
|
|
begin |
853 |
|
|
if FDataLink.Active then begin |
854 |
|
|
BCount := GetBufferCount; |
855 |
|
|
if BCount<1 then |
856 |
|
|
BCount := 1; |
857 |
|
|
FDataLink.BufferCount:= BCount; |
858 |
|
|
end; |
859 |
|
|
end; |
860 |
|
|
|
861 |
|
|
procedure TDBControlGrid.UpdateDrawPanelBounds(aRow: integer); |
862 |
|
|
var R: TRect; |
863 |
|
|
begin |
864 |
|
|
R := Rect(0,0,0,0); |
865 |
|
|
if assigned(FDrawPanel) and |
866 |
|
|
(aRow >= 0) and (aRow < RowCount) then |
867 |
|
|
begin |
868 |
|
|
// Upper and Lower bounds for this row |
869 |
|
|
ColRowToOffSet(False, True, aRow, R.Top, R.Bottom); |
870 |
|
|
//Bounds for visible Column |
871 |
|
|
ColRowToOffSet(True,True,ColCount-1,R.Left,R.RIght); |
872 |
|
|
FDrawPanel.BoundsRect := R; |
873 |
|
|
end; |
874 |
|
|
end; |
875 |
|
|
|
876 |
|
|
procedure TDBControlGrid.UpdateScrollbarRange; |
877 |
|
|
var |
878 |
|
|
aRange, aPage, aPos: Integer; |
879 |
|
|
ScrollInfo: TScrollInfo; |
880 |
|
|
begin |
881 |
|
|
|
882 |
|
|
if not HandleAllocated then exit; |
883 |
|
|
|
884 |
|
|
|
885 |
|
|
GetScrollBarParams(aRange, aPage, aPos); |
886 |
|
|
|
887 |
|
|
FillChar(ScrollInfo, SizeOf(ScrollInfo), 0); |
888 |
|
|
ScrollInfo.cbSize := SizeOf(ScrollInfo); |
889 |
|
|
|
890 |
|
|
{TODO: try to move this out} |
891 |
|
|
{$ifdef WINDOWS} |
892 |
|
|
ScrollInfo.fMask := SIF_ALL or SIF_DISABLENOSCROLL; |
893 |
|
|
ScrollInfo.ntrackPos := 0; |
894 |
|
|
{$else} |
895 |
|
|
ScrollInfo.fMask := SIF_ALL or SIF_UPDATEPOLICY; |
896 |
|
|
//ScrollInfo.ntrackPos := SB_POLICY_CONTINUOUS; |
897 |
|
|
ScrollInfo.ntrackPos := SB_POLICY_DISCONTINUOUS; |
898 |
|
|
{$endif} |
899 |
|
|
ScrollInfo.nMin := 0; |
900 |
|
|
ScrollInfo.nMax := aRange; |
901 |
|
|
ScrollInfo.nPos := Min(aPos,aRange-aPage); |
902 |
|
|
ScrollInfo.nPage := aPage; |
903 |
|
|
// the redraw argument of SetScrollInfo means under gtk |
904 |
|
|
// if the scrollbar is visible or not, in windows it |
905 |
|
|
// seems to mean if the scrollbar is redrawn or not |
906 |
|
|
// to reflect the scrollbar changes made |
907 |
|
|
SetScrollInfo(Handle, SB_VERT, ScrollInfo, |
908 |
|
|
(ScrollBars in [ssBoth, ssVertical]) or |
909 |
|
|
((Scrollbars in [ssAutoVertical, ssAutoBoth]) and (aRange>aPAge)) |
910 |
|
|
); |
911 |
|
|
FOldPosition := aPos; |
912 |
|
|
end; |
913 |
|
|
|
914 |
|
|
procedure TDBControlGrid.WMVScroll(var Message: TLMVScroll); |
915 |
|
|
var |
916 |
|
|
IsSeq: boolean; |
917 |
|
|
aPos, aRange, aPage: Integer; |
918 |
|
|
DeltaRec: integer; |
919 |
|
|
|
920 |
|
|
function MaxPos: Integer; |
921 |
|
|
begin |
922 |
|
|
if IsSeq then |
923 |
|
|
result := GetRecordCount - 1 |
924 |
|
|
else |
925 |
|
|
result := 4; |
926 |
|
|
end; |
927 |
|
|
|
928 |
|
|
procedure DsMoveBy(Delta: Integer); |
929 |
|
|
begin |
930 |
|
|
FDataLink.DataSet.MoveBy(Delta); |
931 |
|
|
GetScrollbarParams(aRange, aPage, aPos); |
932 |
|
|
end; |
933 |
|
|
|
934 |
|
|
procedure DsGoto(BOF: boolean); |
935 |
|
|
begin |
936 |
|
|
if BOF then FDatalink.DataSet.First |
937 |
|
|
else FDataLink.DataSet.Last; |
938 |
|
|
GetScrollbarParams(aRange, aPage, aPos); |
939 |
|
|
end; |
940 |
|
|
|
941 |
|
|
function DsPos: boolean; |
942 |
|
|
begin |
943 |
|
|
result := false; |
944 |
|
|
aPos := Message.Pos; |
945 |
|
|
if aPos=FOldPosition then begin |
946 |
|
|
result := true; |
947 |
|
|
exit; |
948 |
|
|
end; |
949 |
|
|
if aPos>=MaxPos then |
950 |
|
|
dsGoto(False) |
951 |
|
|
else if aPos<=0 then |
952 |
|
|
dsGoto(True) |
953 |
|
|
else if IsSeq then |
954 |
|
|
FDatalink.DataSet.RecNo := aPos + 1 |
955 |
|
|
else begin |
956 |
|
|
DeltaRec := Message.Pos - FOldPosition; |
957 |
|
|
if DeltaRec=0 then begin |
958 |
|
|
result := true; |
959 |
|
|
exit |
960 |
|
|
end |
961 |
|
|
else if DeltaRec<-1 then |
962 |
|
|
DsMoveBy(-VisibleRowCount) |
963 |
|
|
else if DeltaRec>1 then |
964 |
|
|
DsMoveBy(VisibleRowCount) |
965 |
|
|
else |
966 |
|
|
DsMoveBy(DeltaRec); |
967 |
|
|
end; |
968 |
|
|
end; |
969 |
|
|
|
970 |
|
|
begin |
971 |
|
|
if not FDatalink.Active or not assigned(FDataLink.DataSet) then exit; |
972 |
|
|
|
973 |
|
|
IsSeq := FDatalink.DataSet.IsSequenced and not FDataLink.DataSet.Filtered; |
974 |
|
|
case Message.ScrollCode of |
975 |
|
|
SB_TOP: |
976 |
|
|
DsGoto(True); |
977 |
|
|
SB_BOTTOM: |
978 |
|
|
DsGoto(False); |
979 |
|
|
SB_PAGEUP: |
980 |
|
|
DsMoveBy(-VisibleRowCount); |
981 |
|
|
SB_LINEUP: |
982 |
|
|
DsMoveBy(-1); |
983 |
|
|
SB_LINEDOWN: |
984 |
|
|
DsMoveBy(1); |
985 |
|
|
SB_PAGEDOWN: |
986 |
|
|
DsMoveBy(VisibleRowCount); |
987 |
|
|
SB_THUMBPOSITION: |
988 |
|
|
if DsPos then |
989 |
|
|
exit; |
990 |
|
|
SB_THUMBTRACK: |
991 |
|
|
if not (FDatalink.DataSet.IsSequenced) or DsPos then |
992 |
|
|
begin |
993 |
|
|
exit; |
994 |
|
|
end; |
995 |
|
|
else begin |
996 |
|
|
Exit; |
997 |
|
|
end; |
998 |
|
|
end; |
999 |
|
|
|
1000 |
|
|
ScrollBarPosition(SB_VERT, aPos); |
1001 |
|
|
FOldPosition:=aPos; end; |
1002 |
|
|
|
1003 |
|
|
function TDBControlGrid.ISEOF: boolean; |
1004 |
|
|
begin |
1005 |
|
|
with FDatalink do |
1006 |
|
|
result := ValidDataSet and DataSet.EOF; |
1007 |
|
|
end; |
1008 |
|
|
|
1009 |
|
|
function TDBControlGrid.ValidDataSet: boolean; |
1010 |
|
|
begin |
1011 |
|
|
result := FDatalink.Active And (FDatalink.DataSet<>nil) |
1012 |
|
|
end; |
1013 |
|
|
|
1014 |
|
|
function TDBControlGrid.InsertCancelable: boolean; |
1015 |
|
|
begin |
1016 |
|
|
Result := ValidDataSet; |
1017 |
|
|
if Result then |
1018 |
|
|
with FDatalink.DataSet do |
1019 |
|
|
Result := (State=dsInsert) and not Modified ; |
1020 |
|
|
end; |
1021 |
|
|
|
1022 |
|
|
function TDBControlGrid.GetBufferCount: integer; |
1023 |
|
|
begin |
1024 |
|
|
Result := ClientHeight div DefaultRowHeight; |
1025 |
|
|
end; |
1026 |
|
|
|
1027 |
|
|
procedure TDBControlGrid.DoEnter; |
1028 |
|
|
begin |
1029 |
|
|
inherited DoEnter; |
1030 |
|
|
FWeHaveFocus := true; |
1031 |
|
|
end; |
1032 |
|
|
|
1033 |
|
|
procedure TDBControlGrid.DoExit; |
1034 |
|
|
begin |
1035 |
|
|
FWeHaveFocus := false; |
1036 |
|
|
if ValidDataSet and (dgpCancelOnExit in Options) and |
1037 |
|
|
InsertCancelable then |
1038 |
|
|
begin |
1039 |
|
|
FDataLink.DataSet.Cancel; |
1040 |
|
|
end; |
1041 |
|
|
inherited DoExit; |
1042 |
|
|
end; |
1043 |
|
|
|
1044 |
|
|
procedure TDBControlGrid.DoGridResize; |
1045 |
|
|
begin |
1046 |
|
|
if Columns.Count = 0 then Exit; |
1047 |
|
|
|
1048 |
|
|
if ColCount > 1 then |
1049 |
|
|
Columns[0].Width := ClientWidth - ColWidths[0] |
1050 |
|
|
else |
1051 |
|
|
Columns[0].Width := ClientWidth; |
1052 |
|
|
|
1053 |
|
|
FRowCache.Width := Columns[0].Width; |
1054 |
|
|
UpdateDrawPanelBounds(Row); |
1055 |
|
|
end; |
1056 |
|
|
|
1057 |
|
|
procedure TDBControlGrid.DoOnResize; |
1058 |
|
|
begin |
1059 |
|
|
inherited DoOnResize; |
1060 |
|
|
DoGridResize; |
1061 |
|
|
end; |
1062 |
|
|
|
1063 |
|
|
procedure TDBControlGrid.DoScrollDataSet(Data: PtrInt); |
1064 |
|
|
begin |
1065 |
|
|
if AppDestroying in Application.Flags then Exit; |
1066 |
|
|
FDataLink.DataSet.MoveBy(integer(Data) - FDataLink.DataSet.RecNo); |
1067 |
|
|
end; |
1068 |
|
|
|
1069 |
|
|
procedure TDBControlGrid.DrawAllRows; |
1070 |
|
|
begin |
1071 |
|
|
inherited DrawAllRows; |
1072 |
|
|
if ValidDataSet and FDatalink.DataSet.Active then |
1073 |
|
|
begin |
1074 |
|
|
if FInCacheRefresh and not FCacheRefreshQueued then |
1075 |
|
|
{We are at the end of a cache refresh cycle} |
1076 |
|
|
begin |
1077 |
|
|
if FRequiredRecNo > 0 then |
1078 |
|
|
begin |
1079 |
|
|
if FRequiredRecNo <> FDataLink.DataSet.RecNo then |
1080 |
|
|
Application.QueueAsyncCall(@DoScrollDataSet,FRequiredRecNo); |
1081 |
|
|
FRequiredRecNo := 0; |
1082 |
|
|
end |
1083 |
|
|
else |
1084 |
|
|
if FDrawRow <> FSelectedRow then |
1085 |
|
|
Application.QueueAsyncCall(@DoMoveRecord,FSelectedRow); |
1086 |
|
|
end; |
1087 |
|
|
FInCacheRefresh := false; |
1088 |
|
|
end; |
1089 |
|
|
end; |
1090 |
|
|
|
1091 |
|
|
procedure TDBControlGrid.DrawRow(ARow: Integer); |
1092 |
|
|
begin |
1093 |
|
|
if (ARow>=FixedRows) and FDataLink.Active then |
1094 |
|
|
FDrawingActiveRecord := (ARow = FDrawRow) |
1095 |
|
|
else |
1096 |
|
|
FDrawingActiveRecord := False; |
1097 |
|
|
inherited DrawRow(ARow); |
1098 |
|
|
end; |
1099 |
|
|
|
1100 |
|
|
procedure TDBControlGrid.DrawCell(aCol, aRow: Integer; aRect: TRect; |
1101 |
|
|
aState: TGridDrawState); |
1102 |
|
|
|
1103 |
|
|
function GetDatasetState: TDataSetState; |
1104 |
|
|
begin |
1105 |
|
|
if ValidDataSet then |
1106 |
|
|
result := FDataLink.DataSet.State |
1107 |
|
|
else |
1108 |
|
|
result := dsInactive; |
1109 |
|
|
end; |
1110 |
|
|
|
1111 |
|
|
var |
1112 |
|
|
DataCol: Integer; |
1113 |
|
|
begin |
1114 |
|
|
PrepareCanvas(aCol, aRow, aState); |
1115 |
|
|
|
1116 |
|
|
if aCol < FixedCols then |
1117 |
|
|
DrawIndicator(Canvas,aRow, aRect,GetDataSetState,false) |
1118 |
|
|
else |
1119 |
|
|
if not FDrawingActiveRecord and FDataLink.Active then |
1120 |
|
|
DoDrawRow(aRow,aRect,aState); |
1121 |
|
|
{if we are drawing the active record then this is rendered by the Draw Panel |
1122 |
|
|
i.e. a child control - so we need do nothing here} |
1123 |
|
|
|
1124 |
|
|
DrawCellGrid(aCol, aRow, aRect, aState); |
1125 |
|
|
end; |
1126 |
|
|
|
1127 |
|
|
procedure TDBControlGrid.DrawIndicator(ACanvas: TCanvas; aRow: integer; |
1128 |
|
|
R: TRect; Opt: TDataSetState; MultiSel: boolean); |
1129 |
|
|
var |
1130 |
|
|
dx,dy, x, y: Integer; |
1131 |
|
|
procedure CenterY; |
1132 |
|
|
begin |
1133 |
|
|
y := R.Top + (R.Bottom-R.Top) div 2; |
1134 |
|
|
end; |
1135 |
|
|
procedure CenterX; |
1136 |
|
|
begin |
1137 |
|
|
X := R.Left + (R.Right-R.Left) div 2; |
1138 |
|
|
end; |
1139 |
|
|
procedure DrawEdit(clr: Tcolor); |
1140 |
|
|
begin |
1141 |
|
|
ACanvas.Pen.Color := clr; |
1142 |
|
|
CenterY; |
1143 |
|
|
CenterX; |
1144 |
|
|
ACanvas.MoveTo(X-2, Y-Dy); |
1145 |
|
|
ACanvas.LineTo(X+3, Y-Dy); |
1146 |
|
|
ACanvas.MoveTo(X, Y-Dy); |
1147 |
|
|
ACanvas.LineTo(X, Y+Dy); |
1148 |
|
|
ACanvas.MoveTo(X-2, Y+Dy); |
1149 |
|
|
ACanvas.LineTo(X+3, Y+Dy); |
1150 |
|
|
end; |
1151 |
|
|
procedure DrawBrowse; |
1152 |
|
|
begin |
1153 |
|
|
ACanvas.Brush.Color:=clBlack; |
1154 |
|
|
ACanvas.Pen.Color:=clBlack; |
1155 |
|
|
CenterY; |
1156 |
|
|
x:= R.Left+3; |
1157 |
|
|
if MultiSel then begin |
1158 |
|
|
if BiDiMode = bdRightToLeft then begin |
1159 |
|
|
ACanvas.Polyline([point(x+dx,y-dy), point(x,y),point(x+dx,y+dy), point(x+dx,y+dy-1)]); |
1160 |
|
|
ACanvas.Polyline([point(x+dx,y-dy+1), point(x+1,y),point(x+dx,y+dy-1), point(x+dx,y+dy-2)]); |
1161 |
|
|
CenterX; |
1162 |
|
|
Dec(X,3); |
1163 |
|
|
ACanvas.Ellipse(Rect(X+dx-2,Y-2,X+dx+2,Y+2)); |
1164 |
|
|
end else begin |
1165 |
|
|
ACanvas.Polyline([point(x,y-dy), point(x+dx,y),point(x,y+dy), point(x,y+dy-1)]); |
1166 |
|
|
ACanvas.Polyline([point(x,y-dy+1),point(x+dx-1,y),point(x, y+dy-1), point(x,y+dy-2)]); |
1167 |
|
|
CenterX; |
1168 |
|
|
Dec(X,3); |
1169 |
|
|
ACanvas.Ellipse(Rect(X-2,Y-2,X+2,Y+2)); |
1170 |
|
|
end; |
1171 |
|
|
end else begin |
1172 |
|
|
if BiDiMode = bdRightToLeft then |
1173 |
|
|
ACanvas.Polygon([point(x,y),point(x+dx,y-dy),point(x+dx, y+dy),point(x,y)]) |
1174 |
|
|
else |
1175 |
|
|
ACanvas.Polygon([point(x,y-dy),point(x+dx,y),point(x, y+dy),point(x,y-dy)]); |
1176 |
|
|
end; |
1177 |
|
|
end; |
1178 |
|
|
|
1179 |
|
|
begin |
1180 |
|
|
ACanvas.Brush.Color := FixedColor; |
1181 |
|
|
ACanvas.FillRect(R); |
1182 |
|
|
if aRow <> Row then Exit; |
1183 |
|
|
|
1184 |
|
|
dx := 6; |
1185 |
|
|
dy := 6; |
1186 |
|
|
case Opt of |
1187 |
|
|
dsBrowse: |
1188 |
|
|
DrawBrowse; |
1189 |
|
|
dsEdit: |
1190 |
|
|
if FDrawingActiveRecord then |
1191 |
|
|
DrawEdit(clBlack) |
1192 |
|
|
else |
1193 |
|
|
DrawBrowse; |
1194 |
|
|
dsInsert: |
1195 |
|
|
if FDrawingActiveRecord then |
1196 |
|
|
DrawEdit(clGreen) |
1197 |
|
|
else |
1198 |
|
|
DrawBrowse; |
1199 |
|
|
else |
1200 |
|
|
if MultiSel then begin |
1201 |
|
|
ACanvas.Brush.Color:=clBlack; |
1202 |
|
|
ACanvas.Pen.Color:=clBlack; |
1203 |
|
|
CenterX; |
1204 |
|
|
CenterY; |
1205 |
|
|
ACanvas.Ellipse(Rect(X-3,Y-3,X+3,Y+3)); |
1206 |
|
|
end; |
1207 |
|
|
end; end; |
1208 |
|
|
|
1209 |
|
|
procedure TDBControlGrid.GridMouseWheel(shift: TShiftState; Delta: Integer); |
1210 |
|
|
begin |
1211 |
|
|
inherited GridMouseWheel(shift, Delta); |
1212 |
|
|
self.SetFocus; |
1213 |
|
|
if ValidDataSet then |
1214 |
|
|
FDataLink.DataSet.MoveBy(Delta); |
1215 |
|
|
end; |
1216 |
|
|
|
1217 |
|
|
procedure TDBControlGrid.KeyDown(var Key: Word; Shift: TShiftState); |
1218 |
|
|
type |
1219 |
|
|
TOperation=(opMoveBy,opCancel,opAppend,opInsert,opDelete); |
1220 |
|
|
var |
1221 |
|
|
DeltaCol,DeltaRow: Integer; |
1222 |
|
|
|
1223 |
|
|
procedure DoOnKeyDown; |
1224 |
|
|
begin |
1225 |
|
|
if Assigned(OnKeyDown) then |
1226 |
|
|
OnKeyDown(Self, Key, Shift); |
1227 |
|
|
end; |
1228 |
|
|
|
1229 |
|
|
procedure DoOperation(AOper: TOperation; Arg: Integer = 0); |
1230 |
|
|
begin |
1231 |
|
|
self.SetFocus; |
1232 |
|
|
case AOper of |
1233 |
|
|
opMoveBy: |
1234 |
|
|
FDatalink.DataSet.MoveBy(Arg); |
1235 |
|
|
opCancel: |
1236 |
|
|
begin |
1237 |
|
|
FDatalink.Dataset.Cancel; |
1238 |
|
|
end; |
1239 |
|
|
opAppend: |
1240 |
|
|
FDatalink.Dataset.Append; |
1241 |
|
|
opInsert: |
1242 |
|
|
FDatalink.Dataset.Insert; |
1243 |
|
|
opDelete: |
1244 |
|
|
FDatalink.Dataset.Delete; |
1245 |
|
|
end; |
1246 |
|
|
end; |
1247 |
|
|
|
1248 |
|
|
function doVKDown: boolean; |
1249 |
|
|
begin |
1250 |
|
|
if InsertCancelable then |
1251 |
|
|
begin |
1252 |
|
|
if IsEOF then |
1253 |
|
|
result:=true |
1254 |
|
|
else begin |
1255 |
|
|
doOperation(opCancel); |
1256 |
|
|
result := false; |
1257 |
|
|
end; |
1258 |
|
|
end else begin |
1259 |
|
|
result:=false; |
1260 |
|
|
doOperation(opMoveBy, 1); |
1261 |
|
|
if GridCanModify and FDataLink.EOF then begin |
1262 |
|
|
if not (dgpDisableInsert in Options) then |
1263 |
|
|
doOperation(opAppend); |
1264 |
|
|
end |
1265 |
|
|
end; |
1266 |
|
|
end; |
1267 |
|
|
|
1268 |
|
|
function DoVKUP: boolean; |
1269 |
|
|
begin |
1270 |
|
|
if InsertCancelable then |
1271 |
|
|
doOperation(opCancel) |
1272 |
|
|
else begin |
1273 |
|
|
doOperation(opMoveBy, -1); |
1274 |
|
|
end; |
1275 |
|
|
result := FDatalink.DataSet.BOF; |
1276 |
|
|
end; |
1277 |
|
|
|
1278 |
|
|
|
1279 |
|
|
|
1280 |
|
|
begin |
1281 |
|
|
case Key of |
1282 |
|
|
VK_DOWN: |
1283 |
|
|
begin |
1284 |
|
|
DoOnKeyDown; |
1285 |
|
|
if (Key<>0) and ValidDataset then begin |
1286 |
|
|
doVKDown; |
1287 |
|
|
Key := 0; |
1288 |
|
|
end; |
1289 |
|
|
end; |
1290 |
|
|
|
1291 |
|
|
VK_UP: |
1292 |
|
|
begin |
1293 |
|
|
doOnKeyDown; |
1294 |
|
|
if (Key<>0) and ValidDataset then begin |
1295 |
|
|
doVKUp; |
1296 |
|
|
key := 0; |
1297 |
|
|
end; |
1298 |
|
|
end; |
1299 |
|
|
|
1300 |
|
|
VK_NEXT: |
1301 |
|
|
begin |
1302 |
|
|
doOnKeyDown; |
1303 |
|
|
if (Key<>0) and ValidDataset then begin |
1304 |
|
|
doOperation(opMoveBy, VisibleRowCount); |
1305 |
|
|
Key := 0; |
1306 |
|
|
end; |
1307 |
|
|
end; |
1308 |
|
|
|
1309 |
|
|
VK_PRIOR: |
1310 |
|
|
begin |
1311 |
|
|
doOnKeyDown; |
1312 |
|
|
if (Key<>0) and ValidDataset then begin |
1313 |
|
|
doOperation(opMoveBy, -VisibleRowCount); |
1314 |
|
|
key := 0; |
1315 |
|
|
end; |
1316 |
|
|
end; |
1317 |
|
|
|
1318 |
|
|
VK_ESCAPE: |
1319 |
|
|
begin |
1320 |
|
|
doOnKeyDown; |
1321 |
|
|
if ValidDataSet then |
1322 |
|
|
doOperation(opCancel); |
1323 |
|
|
end; |
1324 |
|
|
|
1325 |
|
|
VK_HOME: |
1326 |
|
|
begin |
1327 |
|
|
doOnKeyDown; |
1328 |
|
|
if (Key<>0) and ValidDataSet then |
1329 |
|
|
begin |
1330 |
|
|
if ssCTRL in Shift then |
1331 |
|
|
begin |
1332 |
|
|
FDataLink.DataSet.First; |
1333 |
|
|
Key:=0; |
1334 |
|
|
end; |
1335 |
|
|
end; |
1336 |
|
|
end; |
1337 |
|
|
|
1338 |
|
|
VK_END: |
1339 |
|
|
begin |
1340 |
|
|
doOnKeyDown; |
1341 |
|
|
if Key<>0 then begin |
1342 |
|
|
if ValidDataSet then |
1343 |
|
|
begin |
1344 |
|
|
if ssCTRL in shift then |
1345 |
|
|
begin |
1346 |
|
|
FDatalink.DataSet.Last; |
1347 |
|
|
Key:=0; |
1348 |
|
|
end; |
1349 |
|
|
end; |
1350 |
|
|
end; |
1351 |
|
|
end; |
1352 |
|
|
|
1353 |
|
|
end; |
1354 |
|
|
end; |
1355 |
|
|
|
1356 |
|
|
procedure TDBControlGrid.LinkActive(Value: Boolean); |
1357 |
|
|
begin |
1358 |
|
|
if not Value then |
1359 |
|
|
begin |
1360 |
|
|
FRowCache.ClearCache; |
1361 |
|
|
FInCacheRefresh := false; |
1362 |
|
|
FCacheRefreshQueued := false; |
1363 |
|
|
Row := FixedRows; |
1364 |
|
|
end; |
1365 |
|
|
FRowCache.UseAlternateColors := AlternateColor <> Color; |
1366 |
|
|
FRowCache.AltColorStartNormal := AltColorStartNormal; |
1367 |
|
|
FLastRecordCount := 0; |
1368 |
|
|
LayoutChanged; |
1369 |
|
|
if Value then |
1370 |
|
|
begin |
1371 |
|
|
{ The problem being solved here is that TDataSet does not readily tell us |
1372 |
|
|
when a record is deleted. We get a DataSetChanged event - but this can |
1373 |
|
|
occur for many reasons. Only by monitoring the record count accurately |
1374 |
|
|
can be determine when a record is deleted. To do this we need to scroll |
1375 |
|
|
the whole dataset to the end when the dataset is activated. Not desirable |
1376 |
|
|
with large datasets - but a fix to TDataSet is needed to avoid this. |
1377 |
|
|
} |
1378 |
|
|
FDataLink.DataSet.DisableControls; |
1379 |
|
|
try |
1380 |
|
|
FDataLink.DataSet.Last; |
1381 |
|
|
FLastRecordCount := FDataLink.DataSet.RecordCount; |
1382 |
|
|
if not FDefaultPositionAtEnd then |
1383 |
|
|
FDataLink.DataSet.First; |
1384 |
|
|
FRequiredRecNo := FDataLink.DataSet.RecNo; |
1385 |
|
|
finally |
1386 |
|
|
FDataLink.DataSet.EnableControls; |
1387 |
|
|
end; |
1388 |
|
|
end; |
1389 |
|
|
end; |
1390 |
|
|
|
1391 |
|
|
procedure TDBControlGrid.LayoutChanged; |
1392 |
|
|
begin |
1393 |
|
|
if csDestroying in ComponentState then |
1394 |
|
|
exit; |
1395 |
|
|
BeginUpdate; |
1396 |
|
|
try |
1397 |
|
|
if UpdateGridCounts=0 then |
1398 |
|
|
EmptyGrid; |
1399 |
|
|
finally |
1400 |
|
|
EndUpdate; |
1401 |
|
|
end; |
1402 |
|
|
UpdateScrollbarRange; |
1403 |
|
|
end; |
1404 |
|
|
|
1405 |
|
|
procedure TDBControlGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, |
1406 |
|
|
Y: Integer); |
1407 |
|
|
var |
1408 |
|
|
Gz: TGridZone; |
1409 |
|
|
P: TPoint; |
1410 |
|
|
procedure doMouseDown; |
1411 |
|
|
begin |
1412 |
|
|
// if not Focused then |
1413 |
|
|
// SetFocus; |
1414 |
|
|
if assigned(OnMouseDown) then |
1415 |
|
|
OnMouseDown(Self, Button, Shift, X, Y); |
1416 |
|
|
end; |
1417 |
|
|
procedure doInherited; |
1418 |
|
|
begin |
1419 |
|
|
inherited MouseDown(Button, Shift, X, Y); |
1420 |
|
|
end; |
1421 |
|
|
procedure doMoveBy; |
1422 |
|
|
begin |
1423 |
|
|
FDatalink.DataSet.MoveBy(P.Y - Row); |
1424 |
|
|
end; |
1425 |
|
|
procedure doMoveToColumn; |
1426 |
|
|
begin |
1427 |
|
|
Col := P.X; |
1428 |
|
|
end; |
1429 |
|
|
procedure DoCancel; |
1430 |
|
|
begin |
1431 |
|
|
FDatalink.Dataset.cancel; |
1432 |
|
|
end; |
1433 |
|
|
begin |
1434 |
|
|
if (csDesigning in componentState) or not ValidDataSet then begin |
1435 |
|
|
exit; |
1436 |
|
|
end; |
1437 |
|
|
self.SetFocus; |
1438 |
|
|
|
1439 |
|
|
{ if not MouseButtonAllowed(Button) then begin |
1440 |
|
|
doInherited; |
1441 |
|
|
exit; |
1442 |
|
|
end;} |
1443 |
|
|
|
1444 |
|
|
Gz:=MouseToGridZone(X,Y); |
1445 |
|
|
CacheMouseDown(X,Y); |
1446 |
|
|
case Gz of |
1447 |
|
|
gzInvalid: |
1448 |
|
|
doMouseDown; |
1449 |
|
|
|
1450 |
|
|
gzFixedCells, gzFixedCols: |
1451 |
|
|
doInherited; |
1452 |
|
|
else |
1453 |
|
|
begin |
1454 |
|
|
|
1455 |
|
|
P:=MouseToCell(Point(X,Y)); |
1456 |
|
|
if Gz=gzFixedRows then |
1457 |
|
|
P.X := Col; |
1458 |
|
|
|
1459 |
|
|
if P.Y=Row then begin |
1460 |
|
|
//doAcceptValue; |
1461 |
|
|
|
1462 |
|
|
if not (ssCtrl in Shift) then |
1463 |
|
|
begin |
1464 |
|
|
if gz=gzFixedRows then |
1465 |
|
|
doMouseDown |
1466 |
|
|
else |
1467 |
|
|
doInherited; |
1468 |
|
|
end; |
1469 |
|
|
|
1470 |
|
|
end else begin |
1471 |
|
|
doMouseDown; |
1472 |
|
|
if ValidDataSet then begin |
1473 |
|
|
if InsertCancelable and IsEOF then |
1474 |
|
|
doCancel; |
1475 |
|
|
doMoveBy; |
1476 |
|
|
end; |
1477 |
|
|
end; |
1478 |
|
|
end; |
1479 |
|
|
end; |
1480 |
|
|
end; |
1481 |
|
|
|
1482 |
|
|
procedure TDBControlGrid.MouseUp(Button: TMouseButton; Shift: TShiftState; X, |
1483 |
|
|
Y: Integer); |
1484 |
|
|
begin |
1485 |
|
|
inherited MouseUp(Button, Shift, X, Y); |
1486 |
|
|
FLastMouse.X := X; |
1487 |
|
|
FLastMouse.Y := Y; |
1488 |
|
|
FLastMouseButton := Button; |
1489 |
|
|
FLastMouseShiftState := Shift; |
1490 |
|
|
Application.QueueAsyncCall(@DoSendMouseClicks,0); |
1491 |
|
|
end; |
1492 |
|
|
|
1493 |
|
|
procedure TDBControlGrid.MoveSelection; |
1494 |
|
|
begin |
1495 |
|
|
inherited MoveSelection; |
1496 |
|
|
InvalidateRow(Row); |
1497 |
|
|
end; |
1498 |
|
|
|
1499 |
|
|
procedure TDBControlGrid.Notification(AComponent: TComponent; |
1500 |
|
|
Operation: TOperation); |
1501 |
|
|
begin |
1502 |
|
|
inherited Notification(AComponent, Operation); |
1503 |
|
|
if (Operation = opRemove) and |
1504 |
|
|
(AComponent = FDrawPanel) then FDrawPanel := nil; |
1505 |
|
|
end; |
1506 |
|
|
|
1507 |
|
|
procedure TDBControlGrid.PrepareCanvas(aCol, aRow: Integer; aState: TGridDrawState |
1508 |
|
|
); |
1509 |
|
|
begin |
1510 |
|
|
inherited PrepareCanvas(aCol, aRow, aState); |
1511 |
|
|
|
1512 |
|
|
if gdFixed in aState then |
1513 |
|
|
begin |
1514 |
|
|
if gdHot in aState then |
1515 |
|
|
Canvas.Brush.Color := FixedHotColor |
1516 |
|
|
else |
1517 |
|
|
Canvas.Brush.Color := GetColumnColor(aCol, gdFixed in AState); |
1518 |
|
|
end; |
1519 |
|
|
|
1520 |
|
|
if (not FDatalink.Active) and ((gdSelected in aState) or (gdFocused in aState)) then |
1521 |
|
|
Canvas.Brush.Color := Self.Color; |
1522 |
|
|
|
1523 |
|
|
end; |
1524 |
|
|
|
1525 |
|
|
procedure TDBControlGrid.ResetSizes; |
1526 |
|
|
begin |
1527 |
|
|
LayoutChanged; |
1528 |
|
|
inherited ResetSizes; |
1529 |
|
|
DoGridResize; |
1530 |
|
|
end; |
1531 |
|
|
|
1532 |
|
|
procedure TDBControlGrid.SetColor(Value: TColor); |
1533 |
|
|
begin |
1534 |
|
|
inherited SetColor(Value); |
1535 |
|
|
if (csDesigning in ComponentState) and assigned(FDrawPaneL) then |
1536 |
|
|
FDrawPanel.Color := Value; |
1537 |
|
|
end; |
1538 |
|
|
|
1539 |
|
|
procedure TDBControlGrid.UpdateActive; |
1540 |
|
|
var |
1541 |
|
|
PrevRow: Integer; |
1542 |
|
|
begin |
1543 |
|
|
if (csDestroying in ComponentState) or |
1544 |
|
|
(FDatalink=nil) or (not FDatalink.Active) or |
1545 |
|
|
(FDatalink.ActiveRecord<0) then |
1546 |
|
|
exit; |
1547 |
|
|
|
1548 |
|
|
FDrawRow := FixedRows + FDataLink.ActiveRecord; |
1549 |
|
|
FSelectedRecNo := FDataLink.DataSet.RecNo; |
1550 |
|
|
PrevRow := Row; |
1551 |
|
|
Row := FDrawRow; |
1552 |
|
|
if not FInCacheRefresh then |
1553 |
|
|
FSelectedRow := FDrawRow; |
1554 |
|
|
InvalidateRow(PrevRow); |
1555 |
|
|
SetupDrawPanel(FDrawRow); |
1556 |
|
|
end; |
1557 |
|
|
|
1558 |
|
|
procedure TDBControlGrid.UpdateData; |
1559 |
|
|
begin |
1560 |
|
|
FModified := false; |
1561 |
|
|
end; |
1562 |
|
|
|
1563 |
|
|
procedure TDBControlGrid.UpdateShowing; |
1564 |
|
|
begin |
1565 |
|
|
inherited UpdateShowing; |
1566 |
|
|
DoGridResize |
1567 |
|
|
end; |
1568 |
|
|
|
1569 |
|
|
procedure TDBControlGrid.UpdateVertScrollbar(const aVisible: boolean; |
1570 |
|
|
const aRange, aPage, aPos: Integer); |
1571 |
|
|
begin |
1572 |
|
|
UpdateScrollbarRange; |
1573 |
|
|
end; |
1574 |
|
|
|
1575 |
|
|
constructor TDBControlGrid.Create(AOwner: TComponent); |
1576 |
|
|
begin |
1577 |
|
|
inherited Create(AOwner); |
1578 |
|
|
FDataLink := TDBControlGridDataLink.Create;//(Self); |
1579 |
|
|
FRowCache := TRowCache.Create; |
1580 |
|
|
FDataLink.OnRecordChanged:=@OnRecordChanged; |
1581 |
|
|
FDataLink.OnDatasetChanged:=@OnDataSetChanged; |
1582 |
|
|
FDataLink.OnDataSetOpen:=@OnDataSetOpen; |
1583 |
|
|
FDataLink.OnDataSetClose:=@OnDataSetClose; |
1584 |
|
|
FDataLink.OnNewDataSet:=@OnNewDataSet; |
1585 |
|
|
FDataLink.OnInvalidDataSet:=@OnInvalidDataset; |
1586 |
|
|
FDataLink.OnInvalidDataSource:=@OnInvalidDataSource; |
1587 |
|
|
FDataLink.OnDataSetScrolled:=@OnDataSetScrolled; |
1588 |
|
|
FDataLink.OnLayoutChanged:=@OnLayoutChanged; |
1589 |
|
|
FDataLink.OnEditingChanged:=@OnEditingChanged; |
1590 |
|
|
FDataLink.OnUpdateData:=@OnUpdateData; |
1591 |
|
|
FDataLink.OnCheckBrowseMode := @OnCheckBrowseMode; |
1592 |
|
|
FDataLink.VisualControl:= True; |
1593 |
|
|
ScrollBars := ssAutoVertical; |
1594 |
|
|
FOptions := [dgpIndicator]; |
1595 |
|
|
FixedCols := 1; |
1596 |
|
|
ColCount := 1; |
1597 |
|
|
FixedRows := 0; |
1598 |
|
|
RowCount := 1; |
1599 |
|
|
ColWidths[0] := 12; |
1600 |
|
|
Columns.Add.ReadOnly := true; {Add Dummy Column for Panel} |
1601 |
|
|
DoGridResize; |
1602 |
|
|
if not (csDesigning in ComponentState) then |
1603 |
|
|
Application.AddOnKeyDownBeforeHandler(@KeyDownHandler,false); |
1604 |
|
|
end; |
1605 |
|
|
|
1606 |
|
|
destructor TDBControlGrid.Destroy; |
1607 |
|
|
begin |
1608 |
|
|
if assigned(FDataLink) then |
1609 |
|
|
begin |
1610 |
|
|
FDataLink.OnDataSetChanged:=nil; |
1611 |
|
|
FDataLink.OnRecordChanged:=nil; |
1612 |
|
|
FDataLink.Free; |
1613 |
|
|
end; |
1614 |
|
|
if assigned(FRowCache) then FRowCache.Free; |
1615 |
|
|
inherited Destroy; |
1616 |
|
|
end; |
1617 |
|
|
|
1618 |
|
|
function TDBControlGrid.MouseToRecordOffset(const x, y: Integer; |
1619 |
|
|
out RecordOffset: Integer): TGridZone; |
1620 |
|
|
var |
1621 |
|
|
aCol,aRow: Integer; |
1622 |
|
|
begin |
1623 |
|
|
Result := MouseToGridZone(x, y); |
1624 |
|
|
|
1625 |
|
|
RecordOffset := 0; |
1626 |
|
|
|
1627 |
|
|
if (Result=gzInvalid) or (Result=gzFixedCells) then |
1628 |
|
|
exit; |
1629 |
|
|
|
1630 |
|
|
MouseToCell(x, y, aCol, aRow); |
1631 |
|
|
|
1632 |
|
|
if (Result=gzFixedRows) or (Result=gzNormal) then |
1633 |
|
|
RecordOffset := aRow - Row; |
1634 |
|
|
|
1635 |
|
|
if (Result=gzFixedCols) or (Result=gzNormal) then begin |
1636 |
|
|
aRow := ColumnIndexFromGridColumn(aCol); |
1637 |
|
|
end; |
1638 |
|
|
end; |
1639 |
|
|
|
1640 |
|
|
function TDBControlGrid.ExecuteAction(AAction: TBasicAction): Boolean; |
1641 |
|
|
begin |
1642 |
|
|
Result := (DataLink <> nil) |
1643 |
|
|
and DataLink.ExecuteAction(AAction); |
1644 |
|
|
end; |
1645 |
|
|
|
1646 |
|
|
function TDBControlGrid.UpdateAction(AAction: TBasicAction): Boolean; |
1647 |
|
|
begin |
1648 |
|
|
Result := (DataLink <> nil) |
1649 |
|
|
and DataLink.UpdateAction(AAction); |
1650 |
|
|
end; |
1651 |
|
|
|
1652 |
|
|
end. |