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, 8 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

# Content
1 {
2 /***************************************************************************
3 DBControlGrid.pas
4 -----------
5 An interface to DB aware Controls
6 Initial Revision : Sun Mar 8 2015
7
8
9 ***************************************************************************/
10
11 Unashameably hacked from DBGrid.Pas (Copyright (C) 2003 Jesus Reyes Aguilar.)
12 by Tony Whyman (tony@mwasoftware.co.uk) .Additional source code is
13 Copyright (c) McCallum Whyman Associates Ltd (trading as MWA Software) 2015.
14
15 This unit defines TDBControlGrid: a lookalike rather than a clone for the Delphi
16 TDBCrtlGrid. TDBControlGrid is a single column grid that replicates a TWinControl
17 - typically a TPanel or a TFrame in each row. Each row corresponding to the rows
18 of the linked DataSource. Any data aware control on the replicated (e.g.) TPanel
19 will then appear to have the appropriate value for the row.
20
21 The replicated control is not part of this control but must be added by the
22 programmer at design time, and linked to the "DrawPanel" property.
23
24 Rows can be edited, inserted (append only) or deleted.
25
26 Distributed and licensed under the Library GNU General Public License
27 see https://www.gnu.org/licenses/lgpl.html with the following modification:
28
29 As a special exception, the copyright holders of this library give you
30 permission to link this library with independent modules to produce an
31 executable, regardless of the license terms of these independent modules,
32 and to copy and distribute the resulting executable under terms of your choice,
33 provided that you also meet, for each linked independent module, the terms
34 and conditions of the license of that module. An independent module is a
35 module which is not derived from or based on this library. If you modify this
36 library, you may extend this exception to your version of the library, but
37 you are not obligated to do so. If you do not wish to do so, delete this
38 exception statement from your version.
39
40 }
41 unit DBControlGrid;
42
43 {$mode objfpc}{$H+}
44
45 interface
46
47 uses
48 Classes, Controls, SysUtils, DB, Grids, DBGrids, Graphics, StdCtrls,
49 LMessages;
50
51 {
52 The TRowCache is where we keep track of the DataSet and cache images of each row.
53 TDBControlGrid is really a slight of hand. Only the active record is shown in
54 the panel and the others are cached and displayed as images.
55
56 The image cache is indexed by TDataSet.RecNo and accessed by current active
57 record number (the data being displayed on the panel) and row offset from this
58 record number.
59
60 This is efficient but gives us a problem as the TDataSet model does not remove
61 deleted records. Instead it simply marks them as deleted. Likewise, we need to
62 keep track of deleted rows and skip over them when accessing the cache.
63
64 When alternate row colours are in use, the cache is also used to keep track of the
65 correct row colour as we must similarly ignore delete rows when calculating the
66 correct colour. Odd and Even row numbers is not good enough here.
67 }
68
69 type
70 TRowCacheState = (rcEmpty,rcPresent,rcDeleted);
71 TRowDetails = record
72 FState: TRowCacheState;
73 FAlternateColor: boolean;
74 FBitmap: TBitmap;
75 end;
76
77 { TRowCache }
78
79 TRowCache = class
80 private
81 FAltColorStartNormal: boolean;
82 FHeight: integer;
83 FList: array of TRowDetails;
84 FUseAlternateColors: boolean;
85 FWidth: integer;
86 procedure FreeImages(Reset: boolean);
87 function GetAlternateColor(RecNo: integer): boolean;
88 function Render(Control: TWinControl): TBitmap;
89 procedure ExtendCache(aMaxIndex: integer);
90 procedure OnWidthChange(Sender: TObject);
91 procedure SetHeight(AValue: integer);
92 procedure SetUseAlternateColors(AValue: boolean);
93 procedure SetWidth(AValue: integer);
94 public
95 constructor Create;
96 destructor Destroy; override;
97 procedure ClearCache;
98 function Add2Cache(RecNo: Longint; Control: TWinControl): TBitmap;
99 function GetRowImage(RecNo, Offset: integer): TBitmap;
100 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.