ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/ibcontrols/DBControlGrid.pas
Revision: 29
Committed: Sat May 9 11:37:49 2015 UTC (9 years, 7 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/ibcontrols/DBControlGrid.pas
File size: 44737 byte(s)
Log Message:
Committing updates for Release R1-2-4

File Contents

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