ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/ibcontrols/DBControlGrid.pas
Revision: 23
Committed: Fri Mar 13 10:26:52 2015 UTC (9 years, 6 months ago) by tony
Content type: text/x-pascal
File size: 43977 byte(s)
Log Message:
Committing updates for Release R1-2-1

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