ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/ibcontrols/DBControlGrid.pas
Revision: 80
Committed: Mon Jan 1 11:31:07 2018 UTC (6 years, 10 months ago) by tony
Content type: text/x-pascal
File size: 46549 byte(s)
Log Message:
Fixes merged into public release

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