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

File Contents

# User Rev Content
1 tony 143
2 tony 23 {
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 tony 29 procedure InvalidateRowImage(RecNo: integer);
102 tony 23 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 tony 31 function ActiveControl: TControl;
157 tony 23 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 tony 27 procedure DoSelectNext(Data: PtrInt);
165 tony 23 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 tony 45 uses LCLType, Math, LCLIntf, Forms, LCLMessageGlue, EditBtn, MaskEdit;
290 tony 23
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 tony 45 FList[i].FBitmap := nil;
370 tony 23 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 tony 35 SetLength(FList,0);
418 tony 23 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 tony 45 if FList[RecNo].FBitmap <> nil then
426     FList[RecNo].FBitmap.Free;
427 tony 23 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 tony 29 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 tony 45 FList[RecNo].FBitmap := nil;
484 tony 29 FList[RecNo].FState := rcEmpty;
485     end;
486     end;
487    
488 tony 23 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 tony 31 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 tony 23 procedure TDBControlGrid.EmptyGrid;
542     var
543     OldFixedRows: Integer;
544     begin
545     OldFixedRows := FixedRows;
546     Clear;
547 tony 35 FRowCache.ClearCache;
548 tony 23 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 tony 143 end;
613     Canvas.FillRect(aRect);
614 tony 23 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 tony 35 FDatalink.DataSet.MoveBy(aRow - FDrawRow);
629 tony 23 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 tony 31 AControl: TControl;
665 tony 23 begin
666     if Visible and assigned(FDrawPanel) and FDrawPanel.Visible and FWeHaveFocus then
667     begin
668 tony 31 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 tony 35 and (Key in [VK_RETURN,VK_UP,VK_DOWN]) then Exit; {Ignore Return in a CustomMemo}
677 tony 31
678 tony 45 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 tony 23 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 tony 45 FRowCache.Add2Cache(RecNo,FDrawPanel);
708 tony 23 end;
709     end;
710    
711     procedure TDBControlGrid.OnDataSetChanged(aDataSet: TDataSet);
712     begin
713 tony 35 if aDataSet.State = dsBrowse then
714 tony 23 begin
715 tony 35 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 tony 23 LayoutChanged;
729     end;
730     FLastRecordCount := GetRecordCount;
731     if aDataSet.State = dsInsert then
732 tony 27 begin
733 tony 23 FRequiredRecNo := aDataSet.RecNo + 1;
734 tony 27 Application.QueueAsyncCall(@DoSelectNext,0);
735     end;
736 tony 23 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 tony 29 while not ((theForm is TCustomForm) or (theForm is TCustomFrame))
825     and (theForm.Parent <> nil) do
826 tony 23 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 tony 29 FDrawPanel.AddHandlerOnResize(@OnDrawPanelResize);
843 tony 23 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 tony 45 if FDrawPanel = nil then Exit;
867 tony 23 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 tony 27 procedure TDBControlGrid.DoSelectNext(Data: PtrInt);
1132     begin
1133     FDataLink.DataSet.MoveBy(1);
1134     end;
1135    
1136 tony 23 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 tony 45 if (FDrawPanel = nil) or not FDataLink.Active then
1185     DrawFillRect(Canvas,aRect)
1186     else
1187 tony 23 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 tony 35 FDrawingActiveRecord := false;
1431     FSelectedRecNo := 0;
1432     FSelectedRow := 0;
1433     FRequiredRecNo := 0;
1434 tony 23 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 tony 29 begin
1624 tony 23 FSelectedRow := FDrawRow;
1625 tony 29 if FDatalink.DataSet.State <> dsInsert then
1626     FRowCache.InvalidateRowImage(FSelectedRecNo);
1627     end;
1628 tony 23 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 tony 80 Application.RemoveAsyncCalls(self);
1690 tony 23 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 tony 45