ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/ibcontrols/DBControlGrid.pas
Revision: 45
Committed: Tue Dec 6 10:33:46 2016 UTC (8 years ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/ibcontrols/DBControlGrid.pas
File size: 46511 byte(s)
Log Message:
Committing updates for Release R2-0-0

File Contents

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