ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/ibcontrols/DBControlGrid.pas
Revision: 217
Committed: Fri Mar 16 10:27:26 2018 UTC (6 years, 9 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/ibcontrols/DBControlGrid.pas
File size: 46508 byte(s)
Log Message:
Fixes Merged

File Contents

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