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