1
2 { $Id: dbgrids.pas 58953 2018-09-11 17:46:07Z jesus $}
3 {
4 /***************************************************************************
5 DBGrids.pas
6 -----------
7 An interface to DB aware Controls
8 Initial Revision : Sun Sep 14 2003
9
10
11 ***************************************************************************/
12
13 *****************************************************************************
14 This file is part of the Lazarus Component Library (LCL)
15
16 See the file COPYING.modifiedLGPL.txt, included in this distribution,
17 for details about the license.
18 *****************************************************************************
19 }
20 {
21 TDBGrid and TComponentDataLink for Lazarus
22 Copyright (C) 2003 Jesus Reyes Aguilar.
23 email: jesusrmx@yahoo.com.mx
24
25 TComponentDatalink idea was taken from Joanna Carter's article
26 "The Ultimate Datalink?" Delphi Magazine Issue #30 February 1998
27 }
28 unit DBGrids;
29
30 {$mode objfpc}{$H+}
31
32 interface
33
34 uses
35 Classes, SysUtils, Math, FileUtil, DB, LazUTF8, LazLoggerBase, LCLStrConsts,
36 LCLIntf, LCLType, LMessages, LResources, Controls, StdCtrls, Graphics, Grids,
37 Dialogs, Themes, Variants, Clipbrd, ImgList, Laz2_XMLCfg;
38
39 {$if FPC_FULLVERSION<20701}
40 {$DEFINE noautomatedbookmark}
41 {$endif}
42
43 const
44 DEFINDICATORCOLWIDTH = 12;
45
46 type
47 TCustomDbGrid = class;
48 TColumn = class;
49 EInvalidGridOperation = class(Exception);
50
51
52 TDBGridOption = (
53 dgEditing, // Enable or disable editing data
54 dgTitles, // Show column titles
55 dgIndicator, // Show current row indicator
56 dgColumnResize,
57 dgColumnMove,
58 dgColLines, // Show vertical lines between columns
59 dgRowLines, // Show horizontal lines between rows
60 dgTabs, // Allow using TAB key to navigate grid
61 dgAlwaysShowEditor,
62 dgRowSelect,
63 dgAlwaysShowSelection,
64 dgConfirmDelete,
65 dgCancelOnExit,
66 dgMultiselect, // Allow selection of multiple nonadjacent rows
67 dgHeaderHotTracking,
68 dgHeaderPushedLook,
69 dgPersistentMultiSelect,
70 dgAutoSizeColumns,
71 dgAnyButtonCanSelect, // any mouse button can move selection
72 dgDisableDelete, // disable deleting records with Ctrl+Delete
73 dgDisableInsert, // disable inserting (or append) records
74 dgCellHints, // show individual cell hints
75 dgTruncCellHints, // show cell hints if cell text is too long
76 dgCellEllipsis, // show ... if cell text is truncated
77 dgRowHighlight, // Highlight current row
78 dgThumbTracking,
79 dgDblClickAutoSize, // dblclicking columns borders (on hdrs) resize col.
80 dgDisplayMemoText // show memo content instead of (memo) for ftMemo fields
81 );
82 TDbGridOptions = set of TDbGridOption;
83
84 TDbGridExtraOption = (
85 dgeAutoColumns, // if uncustomized columns, add them anyway?
86 dgeCheckboxColumn // enable the use of checkbox in columns
87 );
88 TDbGridExtraOptions = set of TDbGridExtraOption;
89
90 TDbGridStatusItem = (gsUpdatingData, gsAddingAutoColumns, gsRemovingAutoColumns,
91 gsAutoSized, gsStartEditing, gsLoadingGrid);
92 TDbGridStatus = set of TDbGridStatusItem;
93
94 TDataSetScrolledEvent =
95 procedure(DataSet: TDataSet; Distance: Integer) of object;
96
97 TFocusControlEvent =
98 procedure(aField: TFieldRef) of object;
99
100 TDBGridClickEvent =
101 procedure(Column: TColumn) of object;
102
103 TMovedEvent =
104 procedure(Sender: TObject; FromIndex, ToIndex: Integer) of object;
105
106 TDrawColumnCellEvent =
107 procedure(Sender: TObject; const Rect: TRect; DataCol: Integer;
108 Column: TColumn; State: TGridDrawState) of object;
109
110 TGetDbEditMaskEvent =
111 procedure (Sender: TObject; const Field: TField;
112 var Value: string) of object;
113
114 TDbGridSelEditorEvent =
115 procedure(Sender: TObject; Column: TColumn;
116 var Editor: TWinControl) of object;
117
118 TPrepareDbGridCanvasEvent =
119 procedure(sender: TObject; DataCol: Integer;
120 Column: TColumn; AState: TGridDrawState) of object;
121
122 TDbGridCheckBoxBitmapEvent =
123 procedure(Sender: TObject; const CheckedState: TCheckboxState;
124 var ABitmap: TBitmap) of object;
125
126 TDbGridCheckboxStateEvent =
127 procedure(Sender: TObject; Column: TColumn;
128 var AState: TCheckboxState) of object;
129
130 TDbGridCellHintEvent =
131 procedure(Sender: TObject; Column: TColumn; var AText: String) of object;
132
133 type
134
135 TBookmarkList = class;
136 TBookmarkedRecordEnumeratorOptions = set of
137 (
138 breDisableDataset,
139 breStopOnInvalidBookmark,
140 breRestoreCurrent
141 );
142
143 { TBookmarkedRecordEnumerator }
144
145 TBookmarkedRecordEnumerator = class
146 private
147 fBookmarkList: TBookmarkList;
148 fBookmarkIndex: Integer;
149 fCurrent, fBook: TBookmark;
150 fDataset: TDataset;
151 fOptions: TBookmarkedRecordEnumeratorOptions;
152 public
153 constructor Create(bookList: TBookmarkList; aGrid: TCustomDbGrid;
154 anOptions: TBookmarkedRecordEnumeratorOptions);
155 destructor Destroy; override;
MoveNextnull156 function MoveNext: boolean;
GetEnumeratornull157 function GetEnumerator: TBookmarkedRecordEnumerator;
158 property Current: TBookmark read fCurrent;
159 property Options: TBookmarkedRecordEnumeratorOptions read fOptions write fOptions;
160 end;
161
162 { TBookmarkList }
163
164 TBookmarkList = class
165 private
166 FList: TFPList; // list of TBookmark
167 FGrid: TCustomDbGrid;
168 FDataset: TDataset;
169 FUseCompareBookmarks: boolean;
170 FCanDoBinarySearch: boolean;
GetCountnull171 function GetCount: integer;
GetCurrentRowSelectednull172 function GetCurrentRowSelected: boolean;
GetItemnull173 function GetItem(AIndex: Integer): TBookmark;
174 procedure SetCurrentRowSelected(const AValue: boolean);
175 procedure CheckActive;
176 public
177 constructor Create(AGrid: TCustomDbGrid);
178 destructor Destroy; override;
179
180 procedure Clear;
181 procedure Delete;
Findnull182 function Find(const Item: TBookmark; var AIndex: Integer): boolean;
IndexOfnull183 function IndexOf(const Item: TBookmark): Integer;
Refreshnull184 function Refresh: boolean;
GetEnumeratornull185 function GetEnumerator(opt: TBookmarkedRecordEnumeratorOptions =
186 [breDisableDataset, breRestoreCurrent]): TBookmarkedRecordEnumerator;
187
188 property Count: integer read GetCount;
189 property CurrentRowSelected: boolean
190 read GetCurrentRowSelected write SetCurrentRowSelected;
191 property Items[AIndex: Integer]: TBookmark read GetItem; default;
192 end;
193
194 { TComponentDataLink }
195
196 TComponentDataLink=class(TDatalink)
197 private
198 FDataSet: TDataSet;
199 FDataSetName: string;
200 FModified: Boolean;
201 FOnDatasetChanged: TDatasetNotifyEvent;
202 fOnDataSetClose: TDataSetNotifyEvent;
203 fOnDataSetOpen: TDataSetNotifyEvent;
204 FOnDataSetScrolled: TDataSetScrolledEvent;
205 FOnEditingChanged: TDataSetNotifyEvent;
206 fOnFocusControl: TFocusControlEvent;
207 fOnInvalidDataSet: TDataSetNotifyEvent;
208 fOnInvalidDataSource: TDataSetNotifyEvent;
209 FOnLayoutChanged: TDataSetNotifyEvent;
210 fOnNewDataSet: TDataSetNotifyEvent;
211 FOnRecordChanged: TFieldNotifyEvent;
212 FOnUpdateData: TDataSetNotifyEvent;
213
GetDataSetNamenull214 function GetDataSetName: string;
GetFieldsnull215 function GetFields(Index: Integer): TField;
216 procedure SetDataSetName(const AValue: string);
217 protected
218 procedure RecordChanged(Field: TField); override;
219 procedure DataSetChanged; override;
220 procedure ActiveChanged; override;
221 procedure LayoutChanged; override;
222 procedure DataSetScrolled(Distance: Integer); override;
223 procedure FocusControl(Field: TFieldRef); override;
224 // Testing Events
225 procedure CheckBrowseMode; override;
226 procedure EditingChanged; override;
227 procedure UpdateData; override;
MoveBynull228 function MoveBy(Distance: Integer): Integer; override;
229 property Modified: Boolean read FModified write FModified;
230 public
231 property OnRecordChanged: TFieldNotifyEvent read FOnRecordChanged write FOnRecordChanged;
232 property OnDataSetChanged: TDatasetNotifyEvent read FOnDatasetChanged write FOnDataSetChanged;
233 property OnNewDataSet: TDataSetNotifyEvent read fOnNewDataSet write fOnNewDataSet;
234 property OnDataSetOpen: TDataSetNotifyEvent read fOnDataSetOpen write fOnDataSetOpen;
235 property OnInvalidDataSet: TDataSetNotifyEvent read fOnInvalidDataSet write fOnInvalidDataSet;
236 property OnInvalidDataSource: TDataSetNotifyEvent read fOnInvalidDataSource write fOnInvalidDataSource;
237 property OnFocusControl: TFocusControlEvent read fOnFocusControl write fOnFocusControl;
238 property OnLayoutChanged: TDataSetNotifyEvent read FOnLayoutChanged write FOnLayoutChanged;
239 property OnDataSetClose: TDataSetNotifyEvent read fOnDataSetClose write fOnDataSetClose;
240 property OnDataSetScrolled: TDataSetScrolledEvent read FOnDataSetScrolled write FOnDataSetScrolled;
241 property OnEditingChanged: TDataSetNotifyEvent read FOnEditingChanged write FOnEditingChanged;
242 property OnUpdateData: TDataSetNotifyEvent read FOnUpdateData write FOnUpdateData;
243 property DataSetName:string read GetDataSetName write SetDataSetName;
244 property Fields[Index: Integer]: TField read GetFields;
245 property VisualControl;
246 end;
247
248 { TColumn }
249
250 TColumnTitle = class(TGridColumnTitle)
251 protected
GetDefaultCaptionnull252 function GetDefaultCaption: string; override;
253 end;
254
255 { TColumn }
256
257 TColumn = class(TGridColumn)
258 private
259 FDisplayFormat: String;
260 FDisplayFormatChanged: boolean;
261 FFieldName: String;
262 FField: TField;
263 FIsAutomaticColumn: boolean;
264 FDesignIndex: Integer;
265 procedure ApplyDisplayFormat;
GetDataSetnull266 function GetDataSet: TDataSet;
GetDisplayFormatnull267 function GetDisplayFormat: string;
GetFieldnull268 function GetField: TField;
GetIsDesignColumnnull269 function GetIsDesignColumn: boolean;
IsDisplayFormatStorednull270 function IsDisplayFormatStored: boolean;
271 procedure SetDisplayFormat(const AValue: string);
272 procedure SetField(const AValue: TField);
273 procedure SetFieldName(const AValue: String);
274 protected
CreateTitlenull275 function CreateTitle: TGridColumnTitle; override;
GetDefaultAlignmentnull276 function GetDefaultAlignment: TAlignment; override;
GetDefaultDisplayFormatnull277 function GetDefaultDisplayFormat: string;
GetDefaultValueCheckednull278 function GetDefaultValueChecked: string; override;
GetDefaultValueUncheckednull279 function GetDefaultValueUnchecked: string; override;
GetDefaultVisiblenull280 function GetDefaultVisible: boolean; override;
GetDisplayNamenull281 function GetDisplayName: string; override;
GetDefaultReadOnlynull282 function GetDefaultReadOnly: boolean; override;
GetDefaultWidthnull283 function GetDefaultWidth: Integer; override;
GetPickListnull284 function GetPickList: TStrings; override;
285 property IsAutomaticColumn: boolean read FIsAutomaticColumn;
286 property IsDesignColumn: boolean read GetIsDesignColumn;
287 procedure LinkField;
288 public
289 constructor Create(ACollection: TCollection); override;
290 procedure Assign(Source: TPersistent); override;
IsDefaultnull291 function IsDefault: boolean; override;
292 property DesignIndex: integer read FDesignIndex;
293 property Field: TField read GetField write SetField;
294 published
295 property FieldName: String read FFieldName write SetFieldName;
296 property DisplayFormat: string read GetDisplayFormat write SetDisplayFormat
297 stored IsDisplayFormatStored;
298 end;
299
300 TColumnOrder = (coDesignOrder, coFieldIndexOrder);
301
302 { TDBGridColumns }
303 TDBGridColumns = class(TGridColumns)
304 private
GetColumnnull305 function GetColumn(Index: Integer): TColumn;
306 procedure SetColumn(Index: Integer; Value: TColumn);
307 protected
308 procedure Update(Item: TCollectionItem); override;
ColumnFromFieldnull309 function ColumnFromField(Field: TField): TColumn;
HasAutomaticColumnsnull310 function HasAutomaticColumns: boolean;
HasDesignColumnsnull311 function HasDesignColumns: boolean;
312 procedure RemoveAutoColumns;
313 public
Addnull314 function Add: TColumn;
315 procedure LinkFields;
316 procedure ResetColumnsOrder(ColumnOrder: TColumnOrder);
317 property Items[Index: Integer]: TColumn read GetColumn write SetColumn; default;
318 end;
319
320 { TCustomDBGrid }
321
322 TCustomDBGrid=class(TCustomGrid)
323 private
324 FDataLink: TComponentDataLink;
325 FExtraOptions: TDBGridExtraOptions;
326 FOnCellClick: TDBGridClickEvent;
327 FOnColEnter,FOnColExit: TNotifyEvent;
328 FOnColumnMoved: TMovedEvent;
329 FOnColumnSized: TNotifyEvent;
330 FOnDrawColumnCell: TDrawColumnCellEvent;
331 FOnDrawColumnTitle: TDrawColumnCellEvent;
332 FOnFieldEditMask: TGetDbEditMaskEvent;
333 FOnTitleClick: TDBGridClickEvent;
334 FOnSelectEditor: TDbGridSelEditorEvent;
335 FOnCheckboxBitmap: TDbGridCheckBoxBitmapEvent;
336 FOnCheckboxState: TDbGridCheckboxStateEvent;
337 FOptions: TDBGridOptions;
338 FReadOnly: Boolean;
339 FColEnterPending: Boolean;
340 FLayoutChangedCount: integer;
341 FTempText : string;
342 FDrawingActiveRecord: Boolean;
343 FDrawingMultiSelRecord: Boolean;
344 FDrawingEmptyDataset: Boolean;
345 FEditingColumn: Integer;
346 FOldPosition: Integer;
347 FDefaultColWidths: boolean;
348 FGridStatus: TDBGridStatus;
349 FOldControlStyle: TControlStyle;
350 FSelectedRows: TBookmarkList;
351 FOnPrepareCanvas: TPrepareDbGridCanvasEvent;
352 FKeyBookmark: TBookmark;
353 FKeySign: Integer;
354 FSavedRecord: Integer;
355 FOnGetCellHint: TDbGridCellHintEvent;
356 FOnRowMoved: TMovedEvent;
357 procedure EmptyGrid;
GetColumnsnull358 function GetColumns: TDBGridColumns;
GetCurrentColumnnull359 function GetCurrentColumn: TColumn;
GetCurrentFieldnull360 function GetCurrentField: TField;
GetDataSourcenull361 function GetDataSource: TDataSource;
GetFirstColumnnull362 function GetFirstColumn: TColumn;
GetLastColumnnull363 function GetLastColumn: TColumn;
GetRecordCountnull364 function GetRecordCount: Integer;
GetSelectedFieldRectnull365 function GetSelectedFieldRect: TRect;
GetSelectedIndexnull366 function GetSelectedIndex: Integer;
367 procedure OnRecordChanged(Field:TField);
368 procedure OnDataSetChanged(aDataSet: TDataSet);
369 procedure OnDataSetOpen(aDataSet: TDataSet);
370 procedure OnDataSetClose(aDataSet: TDataSet);
371 procedure OnEditingChanged(aDataSet: TDataSet);
372 procedure OnInvalidDataSet(aDataSet: TDataSet);
373 procedure OnInvalidDataSource(aDataSet: TDataset);
374 procedure OnFocusControl(aField: TFieldRef);
375 procedure OnLayoutChanged(aDataSet: TDataSet);
376 procedure OnNewDataSet(aDataSet: TDataset);
377 procedure OnDataSetScrolled(aDataSet:TDataSet; Distance: Integer);
378 procedure OnUpdateData(aDataSet: TDataSet);
379 procedure SetColumns(const AValue: TDBGridColumns);
380 //procedure ReadColumns(Reader: TReader);
381 //procedure SetColumns(const AValue: TDBGridColumns);
382 procedure SetCurrentField(const AValue: TField);
383 procedure SetDataSource(const AValue: TDataSource);
384 procedure SetExtraOptions(const AValue: TDBGridExtraOptions);
385 procedure SetOptions(const AValue: TDBGridOptions);
386 procedure SetRowMoved(AValue: TMovedEvent);
387 procedure SetSelectedIndex(const AValue: Integer);
388 procedure UpdateBufferCount;
389
390 // Temporal
GetColumnCountnull391 function GetColumnCount: Integer;
392
DefaultFieldColWidthnull393 function DefaultFieldColWidth(F: TField): Integer;
394
395 procedure UpdateGridColumnSizes;
396 procedure UpdateScrollbarRange;
397 procedure DoLayoutChanged;
398 //procedure WriteColumns(Writer: TWriter);
399
400 procedure RestoreEditor;
ISEOFnull401 function ISEOF: boolean;
ValidDataSetnull402 function ValidDataSet: boolean;
InsertCancelablenull403 function InsertCancelable: boolean;
404 procedure StartUpdating;
405 procedure EndUpdating;
UpdatingDatanull406 function UpdatingData: boolean;
407 procedure SwapCheckBox;
408 procedure ToggleSelectedRow;
409 procedure SelectRecord(AValue: boolean);
410 procedure GetScrollbarParams(out aRange, aPage, aPos: Integer);
411 procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
412 procedure ClearSelection(selCurrent:boolean=false);
NeedAutoSizeColumnsnull413 function NeedAutoSizeColumns: boolean;
414 procedure RenewColWidths;
415 procedure InternalAutoSizeColumn(aCol: Integer; aCanvas: TCanvas; aDatalinkActive: Boolean);
416 procedure DoHeaderClick(Index: Integer);
417 protected
418 procedure AddAutomaticColumns;
419 procedure AssignTo(Dest: TPersistent); override;
420 procedure AutoAdjustColumn(aCol: Integer); override;
421 procedure BeforeMoveSelection(const DCol,DRow: Integer); override;
422 procedure BeginLayout;
423 procedure CellClick(const aCol,aRow: Integer; const Button:TMouseButton); override;
CheckDisplayMemonull424 function CheckDisplayMemo(aField: TField): boolean;
425 procedure InvalidateSizes;
426 procedure ColRowMoved(IsColumn: Boolean; FromIndex,ToIndex: Integer); override;
ColumnEditorStylenull427 function ColumnEditorStyle(aCol: Integer; F: TField): TColumnButtonStyle;
CreateColumnsnull428 function CreateColumns: TGridColumns; override;
429 procedure CreateWnd; override;
430 procedure DefineProperties(Filer: TFiler); override;
431 procedure DefaultDrawCell(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState);
DefaultEditorStylenull432 function DefaultEditorStyle(const Style:TColumnButtonStyle; const F:TField): TColumnButtonStyle;
433 procedure DoCopyToClipboard; override;
434 procedure DoExit; override;
DoMouseWheelDownnull435 function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
DoMouseWheelUpnull436 function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
437 procedure DoOnChangeBounds; override;
438 procedure DoPrepareCanvas(aCol,aRow:Integer; aState: TGridDrawState); override;
439 procedure DoLoadColumn(sender: TCustomGrid; aColumn: TGridColumn; aColIndex: Integer;
440 aCfg: TXMLConfig; aVersion: Integer; aPath: string); override;
441 procedure DoSaveColumn(sender: TCustomGrid; aColumn: TGridColumn; aColIndex: Integer;
442 aCfg: TXMLConfig; aVersion: Integer; aPath: string); override;
443 procedure DrawAllRows; override;
444 procedure DrawFocusRect(aCol,aRow:Integer; ARect:TRect); override;
445 procedure DrawRow(ARow: Integer); override;
446 procedure DrawCell(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState); override;
447 procedure DrawCellBackground(aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState);
448 procedure DrawCheckboxBitmaps(aCol: Integer; aRect: TRect; F: TField);
449 procedure DrawFixedText(aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState);
450 procedure DrawColumnText(aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState); override;
451 procedure DrawIndicator(ACanvas: TCanvas; R: TRect; Opt: TDataSetState; MultiSel: boolean); virtual;
452 procedure EditingColumn(aCol: Integer; Ok: boolean);
453 procedure EditorCancelEditing;
454 procedure EditorDoGetValue; override;
EditorCanAcceptKeynull455 function EditorCanAcceptKey(const ch: TUTF8Char): boolean; override;
EditorIsReadOnlynull456 function EditorIsReadOnly: boolean; override;
457 procedure EditorTextChanged(const aCol,aRow: Integer; const aText:string); override;
458 procedure EndLayout;
FieldIndexFromGridColumnnull459 function FieldIndexFromGridColumn(AGridCol: Integer): Integer;
FirstGridColumnnull460 function FirstGridColumn: Integer; override;
GetBufferCountnull461 function GetBufferCount: integer; virtual;
GetCellHintTextnull462 function GetCellHintText(aCol, aRow: Integer): String; override;
GetDefaultColumnAlignmentnull463 function GetDefaultColumnAlignment(Column: Integer): TAlignment; override;
GetDefaultColumnWidthnull464 function GetDefaultColumnWidth(Column: Integer): Integer; override;
GetDefaultColumnReadOnlynull465 function GetDefaultColumnReadOnly(Column: Integer): boolean; override;
GetDefaultColumnTitlenull466 function GetDefaultColumnTitle(Column: Integer): string; override;
GetDefaultRowHeightnull467 function GetDefaultRowHeight: integer; override;
GetDsFieldFromGridColumnnull468 function GetDsFieldFromGridColumn(Column: Integer): TField;
GetEditMasknull469 function GetEditMask(aCol, aRow: Longint): string; override;
GetEditTextnull470 function GetEditText(aCol, aRow: Longint): string; override;
GetFieldFromGridColumnnull471 function GetFieldFromGridColumn(Column: Integer): TField;
GetGridColumnFromFieldnull472 function GetGridColumnFromField(F: TField): Integer;
473 procedure GetImageForCheckBox(const aCol, aRow: Integer;
474 CheckBoxView: TCheckBoxState; var ImageList: TCustomImageList;
475 var ImageIndex: TImageIndex; var Bitmap: TBitmap); override;
GetIsCellSelectednull476 function GetIsCellSelected(aCol, aRow: Integer): boolean; override;
GetIsCellTitlenull477 function GetIsCellTitle(aCol,aRow: Integer): boolean; override;
478 procedure GetSelectedState(AState: TGridDrawState; out IsSelected:boolean); override;
GetSmoothScrollnull479 function GetSmoothScroll(Which: Integer): Boolean; override;
GetTruncCellHintTextnull480 function GetTruncCellHintText(aCol, aRow: Integer): string; override;
GridCanModifynull481 function GridCanModify: boolean;
482 procedure GetSBVisibility(out HsbVisible,VsbVisible:boolean);override;
483 procedure GetSBRanges(const HsbVisible,VsbVisible: boolean;
484 out HsbRange,VsbRange,HsbPage,VsbPage,HsbPos,VsbPos:Integer); override;
485 procedure HeaderClick(IsColumn: Boolean; index: Integer); override;
486 procedure HeaderSized(IsColumn: Boolean; Index: Integer); override;
IsColumnVisiblenull487 function IsColumnVisible(aCol: Integer): boolean;
IsValidCharnull488 function IsValidChar(AField: TField; AChar: TUTF8Char): boolean;
489 procedure KeyDown(var Key : Word; Shift : TShiftState); override;
490 procedure LinkActive(Value: Boolean); virtual;
491 procedure LayoutChanged; virtual;
492 procedure Loaded; override;
493 procedure LoadGridOptions(cfg: TXMLConfig; Version: Integer); override;
494 procedure MoveSelection; override;
MouseButtonAllowednull495 function MouseButtonAllowed(Button: TMouseButton): boolean; override;
496 procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
497 procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
498 procedure PrepareCanvas(aCol,aRow: Integer; aState:TGridDrawState); override;
499 procedure PrepareCellHints(aCol,aRow: Integer); override;
500 procedure RemoveAutomaticColumns;
501 procedure ResetSizes; override;
502 procedure SaveGridOptions(Cfg: TXMLConfig); override;
503 procedure SelectEditor; override;
504 procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
505 procedure SetFixedCols(const AValue: Integer); override;
SelectCellnull506 function SelectCell(aCol, aRow: Integer): boolean; override;
507 procedure UnprepareCellHints; override;
508 procedure UpdateActive; virtual;
509 procedure UpdateAutoSizeColumns;
510 procedure UpdateData; virtual;
UpdateGridCountsnull511 function UpdateGridCounts: Integer;
512 procedure WMVScroll(var Message : TLMVScroll); message LM_VScroll;
513 procedure WndProc(var TheMessage : TLMessage); override;
514
515 property Columns: TDBGridColumns read GetColumns write SetColumns;
516 property GridStatus: TDBGridStatus read FGridStatus write FGridStatus;
517 property Datalink: TComponentDataLink read FDatalink;
518 property Options: TDBGridOptions read FOptions write SetOptions default
519 [dgColumnResize, dgColumnMove, dgTitles, dgIndicator, dgRowLines,
520 dgColLines, dgConfirmDelete, dgCancelOnExit, dgTabs, dgEditing,
521 dgAlwaysShowSelection];
522 property OptionsExtra: TDBGridExtraOptions read FExtraOptions
523 write SetExtraOptions default [dgeAutoColumns, dgeCheckboxColumn];
524 property ReadOnly: Boolean read FReadOnly write FReadOnly default false;
525 property SelectedRows: TBookmarkList read FSelectedRows;
526
527 property OnCellClick: TDBGridClickEvent read FOnCellClick write FOnCellClick;
528 property OnColEnter: TNotifyEvent read FOnColEnter write FOnColEnter;
529 property OnColExit: TNotifyEvent read FOnColExit write FOnColExit;
530 property OnColumnMoved: TMovedEvent read FOnColumnMoved write FOnColumnMoved;
531 property OnColumnSized: TNotifyEvent read FOnColumnSized write FOnColumnSized;
532 property OnDrawColumnCell: TDrawColumnCellEvent read FOnDrawColumnCell write FOnDrawColumnCell;
533 property OnDrawColumnTitle: TDrawColumnCellEvent read FOnDrawColumnTitle write FOnDrawColumnTitle;
534 property OnFieldEditMask: TGetDbEditMaskEvent read FOnFieldEditMask write FOnFieldEditMask;
535 property OnGetCellHint: TDbGridCellHintEvent read FOnGetCellHint write FOnGetCellHint;
536 property OnPrepareCanvas: TPrepareDbGridCanvasEvent read FOnPrepareCanvas write FOnPrepareCanvas;
537 property OnSelectEditor: TDbGridSelEditorEvent read FOnSelectEditor write FOnSelectEditor;
538 property OnTitleClick: TDBGridClickEvent read FOnTitleClick write FOnTitleClick;
539 property OnUserCheckboxBitmap: TDbGridCheckboxBitmapEvent read FOnCheckboxBitmap write FOnCheckboxBitmap;
540 property OnUserCheckboxState: TDbGridCheckboxStateEvent read FOnCheckboxState write FOnCheckboxState;
541 property OnRowMoved: TMovedEvent read FOnRowMoved write SetRowMoved;
542 public
543 constructor Create(AOwner: TComponent); override;
544 procedure AutoAdjustColumns; override;
545 procedure InitiateAction; override;
546 procedure DefaultDrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
EditorByStylenull547 function EditorByStyle(Style: TColumnButtonStyle): TWinControl; override;
548 procedure ResetColWidths;
549 destructor Destroy; override;
MouseToRecordOffsetnull550 function MouseToRecordOffset(const x,y: Integer; out Column: TColumn; out RecordOffset: Integer): TGridZone;
ExecuteActionnull551 function ExecuteAction(AAction: TBasicAction): Boolean; override;
UpdateActionnull552 function UpdateAction(AAction: TBasicAction): Boolean; override;
553
554 procedure SaveToFile(FileName: string); override;
555 procedure SaveToStream(AStream: TStream); override;
556 procedure LoadFromFile(FileName: string); override;
557 procedure LoadFromStream(AStream: TStream); override;
558
559 property AllowOutboundEvents;
560 property SelectedField: TField read GetCurrentField write SetCurrentField;
561 property SelectedIndex: Integer read GetSelectedIndex write SetSelectedIndex;
562 property SelectedColumn: TColumn read GetCurrentColumn;
563 property SelectedFieldRect: TRect read GetSelectedFieldRect;
564 property LastColumn: TColumn read GetLastColumn;
565 property FirstColumn: TColumn read GetFirstColumn;
566 property DataSource: TDataSource read GetDataSource write SetDataSource;
567 end;
568
569 TDBGrid=class(TCustomDBGrid)
570 public
571 property BorderColor;
572 property Canvas;
573 property DefaultTextStyle;
574 property EditorBorderStyle;
575 property EditorMode;
576 property ExtendedColSizing;
577 property FastEditing;
578 property FocusColor;
579 property FocusRectVisible;
580 property GridLineColor;
581 property GridLineStyle;
582 property InplaceEditor;
583 property SelectedColor;
584 property SelectedRows;
585 property OnRowMoved;
586 published
587 property Align;
588 property AlternateColor;
589 property Anchors;
590 property AutoAdvance default aaRightDown;
591 property AutoEdit;
592 property AutoFillColumns;
593 property BiDiMode;
594 property BorderSpacing;
595 property BorderStyle;
596 property CellHintPriority;
597 property Color;
598 property Columns; // stored false;
599 property Constraints;
600 property DataSource;
601 property DefaultDrawing;
602 property DefaultRowHeight;
603 property DoubleBuffered;
604 property DragCursor;
605 //property DragKind;
606 property DragMode;
607 property Enabled;
608 property FixedColor;
609 property FixedCols;
610 property FixedHotColor;
611 property Flat;
612 property Font;
613 property HeaderHotZones;
614 property HeaderPushZones;
615 //property ImeMode;
616 //property ImeName;
617 property Options;
618 property Options2;
619 property OptionsExtra;
620 property ParentBiDiMode;
621 property ParentColor default false;
622 property ParentDoubleBuffered;
623 property ParentFont;
624 //property ParentShowHint;
625 property PopupMenu;
626 property ReadOnly;
627 property Scrollbars default ssBoth;
628 property ShowHint;
629 property TabAdvance;
630 property TabOrder;
631 property TabStop;
632 property TitleFont;
633 property TitleImageList;
634 property TitleStyle;
635 property UseXORFeatures;
636 property Visible;
637 property OnCellClick;
638 property OnColEnter;
639 property OnColExit;
640 property OnColumnMoved;
641 property OnColumnSized;
642 property OnContextPopup;
643 property OnDrawColumnCell;
644 property OnDrawColumnTitle;
645 property OnDblClick;
646 property OnDragDrop;
647 property OnDragOver;
648 property OnEditButtonClick;
649 property OnEditingDone;
650 //property OnEndDock;
651 property OnEndDrag;
652 property OnEnter;
653 property OnExit;
654 property OnFieldEditMask;
655 property OnGetCellHint;
656 property OnKeyDown;
657 property OnKeyPress;
658 property OnKeyUp;
659 property OnMouseDown;
660 property OnMouseEnter;
661 property OnMouseLeave;
662 property OnMouseMove;
663 property OnMouseUp;
664 property OnMouseWheel;
665 property OnMouseWheelDown;
666 property OnMouseWheelUp;
667 property OnPrepareCanvas;
668 property OnSelectEditor;
669 //property OnStartDock;
670 property OnStartDrag;
671 property OnTitleClick;
672 property OnUserCheckboxBitmap;
673 property OnUserCheckboxState;
674 property OnUTF8KeyPress;
675 end;
676
677 procedure Register;
678
679 implementation
680
681 procedure Register;
682 begin
683 RegisterComponents('Data Controls',[TDBGrid]);
684 end;
685
CalcCanvasCharWidthnull686 function CalcCanvasCharWidth(Canvas:TCanvas): integer;
687 begin
688 {$ifdef dbgDBGridExtra}
689 DebugLnEnter('CalcCanvasCharWidth INIT');
690 {$endif}
691 if Canvas.HandleAllocated then
692 result := Canvas.TextWidth('MX') div 2
693 else
694 result := 8;
695 {$ifdef dbgDBGridExtra}
696 DebugLnExit('CalcCanvasCharWidth DONE result=%d', [result]);
697 {$endif}
698 end;
699
CalcColumnFieldWidthnull700 function CalcColumnFieldWidth(Canvas: TCanvas; hasTitle: boolean;
701 aTitle: String; aTitleFont: TFont; Field: TField): Integer;
702 var
703 aCharWidth, aTitleWidth: Integer;
704 aFont: TFont;
705 UseTitleFont: boolean;
706 begin
707 {$ifdef dbgDBGridExtra}
708 DebugLnEnter('CalcColumnFieldWidth INIT');
709 {$endif}
710 if (Field=nil) or (Field.DisplayWidth=0) then
711 Result := DEFCOLWIDTH
712 else begin
713
714 aCharWidth := CalcCanvasCharWidth(Canvas);
715 aTitleWidth := UTF8Length(aTitle);
716 if Field.DisplayWidth > aTitleWidth then
717 result := aCharWidth * Field.DisplayWidth
718 else
719 result := aCharWidth * aTitleWidth;
720
721 if HasTitle then begin
722 UseTitleFont :=
723 (Canvas.Font.Size<>aTitleFont.Size) or
724 (Canvas.Font.Style<>aTitleFont.Style) or
725 (Canvas.Font.CharSet<>aTitleFont.CharSet) or
726 (Canvas.Font.Name<>aTitleFont.Name);
727 if UseTitleFont then begin
728 aFont := TFont.Create;
729 aFont.Assign(Canvas.Font);
730 Canvas.Font := aTitleFont;
731 end;
732 try
733 aCharWidth := Canvas.TextWidth(ATitle)+6;
734 if aCharWidth>Result then
735 Result := aCharWidth;
736 finally
737 if UseTitleFont then begin
738 Canvas.Font := aFont;
739 aFont.Free;
740 end;
741 end;
742 end; // if HasTitle ...
743 end; // if (Field=nil) or (Field.DisplayWidth=0)
744 {$ifdef dbgDBGridExtra}
745 DebugLnExit('CalcColumnFieldWidth DONE result=%d', [result]);
746 {$endif}
747 end;
748
749 var
750 LookupTmpSetActive: Boolean;
751 LookupBookMark: TBookmark;
752
753 procedure LookupGetBookMark(ALookupField: TField);
754 begin
755 {$ifdef dbgDBGrid}
756 DebugLn('LookupGetBookMark');
757 {$endif}
758 LookupTmpSetActive := not ALookupField.LookupDataSet.Active;
759 if LookupTmpSetActive then
760 ALookupField.LookupDataSet.Active := True
761 else
762 begin
763 LookupBookMark := ALookupField.LookupDataSet.GetBookmark;
764 ALookupField.LookupDataSet.DisableControls;
765 end;
766 end;
767
768 procedure LookupGotoBookMark(ALookupField: TField);
769 begin
770 {$ifdef dbgDBGrid}
771 DebugLn('LookupGotoBookMark');
772 {$endif}
773 if LookupTmpSetActive then
774 begin
775 ALookupField.LookupDataSet.Active := False;
776 LookupTmpSetActive := False;
777 end
778 else
779 try
780 ALookupField.LookupDataSet.GotoBookmark(LookupBookMark);
781 ALookupField.LookupDataSet.FreeBookmark(LookupBookMark);
782 finally
783 ALookupField.LookupDataSet.EnableControls;
784 end;
785 end;
786
787 { TBookmarkedRecordEnumerator }
788
789 constructor TBookmarkedRecordEnumerator.Create(bookList: TBookmarkList;
790 aGrid: TCustomDbGrid; anOptions: TBookmarkedRecordEnumeratorOptions);
791 begin
792 inherited Create;
793 fBookmarkList := bookList;
794 fBookmarkIndex := -1;
795 fDataset := aGrid.Datasource.dataset;
796 fOptions := anOptions;
797 end;
798
799 destructor TBookmarkedRecordEnumerator.Destroy;
800 begin
801 if breRestoreCurrent in fOptions then begin
802 if fDataset.BookmarkValid(fBook) then
803 fDataset.GotoBookmark(fBook);
804 fDataset.FreeBookmark(fBook);
805 end;
806 if breDisableDataset in fOptions then
807 fDataset.EnableControls;
808 inherited Destroy;
809 end;
810
TBookmarkedRecordEnumerator.MoveNextnull811 function TBookmarkedRecordEnumerator.MoveNext: boolean;
812 begin
813 inc(fBookmarkIndex);
814
815 if fBookmarkIndex=0 then begin
816 if breDisableDataset in fOptions then
817 fDataset.DisableControls;
818 if breRestoreCurrent in fOptions then
819 fBook := fDataset.GetBookmark;
820 end;
821
822 result := fBookmarkIndex<fBookmarkList.Count;
823 if result then begin
824 fCurrent := fBookmarkList[fBookmarkIndex];
825 if fDataset.BookmarkValid(fCurrent) then
826 fDataSet.GotoBookmark(fCurrent)
827 else if breStopOnInvalidBookmark in fOptions then
828 result := false;
829 end;
830 end;
831
GetEnumeratornull832 function TBookmarkedRecordEnumerator.GetEnumerator: TBookmarkedRecordEnumerator;
833 begin
834 result := self;
835 end;
836
837 { TCustomDBGrid }
838
839 procedure TCustomDBGrid.OnRecordChanged(Field: TField);
840 var
841 c: Integer;
842 begin
843 {$ifdef dbgDBGrid}
844 DbgOut(ClassName,'.OnRecordChanged(Field=');
845 if Field=nil then DebugLn('nil)')
846 else DebugLn(Field.FieldName,')');
847 {$endif}
848 if Field=nil then
849 UpdateActive
850 else begin
851 c := GetGridColumnFromField(Field);
852 if c>0 then begin
853 if EditorMode and (Field=SelectedField) then
854 EditorDoSetValue
855 else
856 InvalidateCell(C, Row)
857 end else
858 UpdateActive;
859 end;
860 end;
861
TCustomDBGrid.GetDataSourcenull862 function TCustomDBGrid.GetDataSource: TDataSource;
863 begin
864 {$ifdef dbgDBGrid}
865 DebugLn('%s.GetDataSource', [ClassName]);
866 {$endif}
867 Result:= FDataLink.DataSource;
868 end;
869
GetFirstColumnnull870 function TCustomDBGrid.GetFirstColumn: TColumn;
871 var
872 i: Integer;
873 begin
874 i := ColumnIndexFromGridColumn(GetFirstVisibleColumn);
875 if i>=0 then
876 Result := Columns[i]
877 else
878 Result := nil;
879 end;
880
GetLastColumnnull881 function TCustomDBGrid.GetLastColumn: TColumn;
882 var
883 i: Integer;
884 begin
885 i := ColumnIndexFromGridColumn(GetLastVisibleColumn);
886 if i>=0 then
887 Result := Columns[i]
888 else
889 Result := nil;
890 end;
891
TCustomDBGrid.GetRecordCountnull892 function TCustomDBGrid.GetRecordCount: Integer;
893 begin
894 {$ifdef dbgDBGrid}
895 DebugLnEnter('%s.GetRecordCount INIT', [ClassName]);
896 {$endif}
897 result := FDataLink.DataSet.RecordCount;
898 {$ifdef dbgDBGrid}
899 DebugLnExit('%s.GetRecordCount DONE RecordCount=%d', [ClassName, result]);
900 {$endif}
901 end;
902
TCustomDBGrid.GetSelectedFieldRectnull903 function TCustomDBGrid.GetSelectedFieldRect: TRect;
904 begin
905 result := CellRect(Col,Row);
906 end;
907
TCustomDBGrid.GetSelectedIndexnull908 function TCustomDBGrid.GetSelectedIndex: Integer;
909 begin
910 if Columns.Enabled then
911 Result := ColumnIndexFromGridColumn( Col )
912 else
913 Result := FieldIndexFromGridColumn( Col );
914 end;
915
916 procedure TCustomDBGrid.EmptyGrid;
917 var
918 OldFixedCols, OldFixedRows: Integer;
919 begin
920 {$ifdef dbgDBGrid}
921 DebugLn('%s.EmptyGrid', [ClassName]);
922 {$endif}
923 OldFixedCols := FixedCols;
924 OldFixedRows := FixedRows;
925 Clear;
926 RowCount := OldFixedRows + 1;
927 ColCount := OldFixedCols + 1;
928 if dgIndicator in Options then
929 ColWidths[0]:=Scale96ToFont(DEFINDICATORCOLWIDTH);
930 end;
931
932 procedure TCustomDBGrid.DoHeaderClick(Index: Integer);
933 var
934 Column: TColumn;
935 begin
936 if Assigned(OnTitleClick) then begin
937 Column := TColumn(ColumnFromGridColumn(Index));
938 if Column <> nil then
939 OnTitleClick(Column);
940 end;
941 end;
942
GetColumnsnull943 function TCustomDBGrid.GetColumns: TDBGridColumns;
944 begin
945 result := TDBGridColumns( inherited Columns );
946 end;
947
948 procedure TCustomDBGrid.InvalidateSizes;
949 begin
950 {$ifdef dbgDBGrid}
951 DebugLn('%s.InvalidateSizes', [ClassName]);
952 {$endif}
953 GridFlags := GridFlags + [gfVisualChange];
954 end;
955
GetCurrentColumnnull956 function TCustomDBGrid.GetCurrentColumn: TColumn;
957 begin
958 if Columns.Enabled then
959 Result := TColumn(Columns[SelectedIndex])
960 else
961 Result := nil;
962 end;
963
TCustomDBGrid.GetCurrentFieldnull964 function TCustomDBGrid.GetCurrentField: TField;
965 begin
966 result := GetFieldFromGridColumn( Col );
967 end;
968
969 procedure TCustomDBGrid.OnDataSetChanged(aDataSet: TDataSet);
970 begin
971 {$ifdef dbgDBGrid}
972 DebugLnEnter('%s.OnDataSetChanged INIT name=%s aDataSet=%s',
973 [ClassName,name,dbgsname(ADataset)]);
974 {$endif}
975 if not (gsStartEditing in FGridStatus) then begin
976 GridFlags := GridFlags + [gfEditingDone];
977 if EditorMode then
978 EditorMode := False;
979 GridFlags := GridFlags - [gfEditingDone];
980 LayoutChanged;
981 end;
982 UpdateActive;
983 if not (gsStartEditing in FGridStatus) then begin
984 SelectEditor;
985 if (dgAlwaysShowEditor in Options) and not EditorMode then
986 EditorMode := true;
987 end;
988 {$ifdef dbgDBGrid}
989 DebugLnExit('%s.OnDataSetChanged DONE name=%s aDataSet=%s',
990 [ClassName,name,dbgsname(ADataset)]);
991 {$endif}
992 end;
993
994 procedure TCustomDBGrid.OnDataSetOpen(aDataSet: TDataSet);
995 begin
996 {$ifdef dbgDBGrid}
997 DebugLnEnter('%s.OnDataSetOpen INIT', [ClassName]);
998 {$endif}
999 RenewColWidths;
1000 LinkActive(True);
1001 UpdateActive;
1002 SelectEditor;
1003 {$ifdef dbgDBGrid}
1004 DebugLnExit('%s.OnDataSetOpen DONE', [ClassName]);
1005 {$endif}
1006 end;
1007
1008 procedure TCustomDBGrid.OnDataSetClose(aDataSet: TDataSet);
1009 begin
1010 {$ifdef dbgDBGrid}
1011 DebugLn('%s.OnDataSetClose', [ClassName]);
1012 {$endif}
1013 LinkActive(False);
1014 end;
1015
1016 procedure TCustomDBGrid.OnEditingChanged(aDataSet: TDataSet);
1017 begin
1018 {$ifdef dbgDBGrid}
1019 DebugLn('%s.OnEditingChanged', [ClassName]);
1020 if aDataSet<>nil then begin
1021 DebugLn(['Editing=', dsEdit = aDataSet.State]);
1022 DebugLn(['Inserting=',dsInsert = aDataSet.State]);
1023 end else
1024 DebugLn('Dataset=nil');
1025 {$endif}
1026 FDataLink.Modified := False;
1027 UpdateActive;
1028 end;
1029
1030 procedure TCustomDBGrid.OnInvalidDataSet(aDataSet: TDataSet);
1031 begin
1032 {$ifdef dbgDBGrid}
1033 DebugLn('%s.OnInvalidDataSet', [ClassName]);
1034 {$endif}
1035 LinkActive(False);
1036 end;
1037
1038 procedure TCustomDBGrid.OnInvalidDataSource(aDataSet: TDataset);
1039 begin
1040 {$ifdef dbgDBGrid}
1041 DebugLn('%s.OnInvalidDataSource', [ClassName]);
1042 {$endif}
1043 LinkActive(False);
1044 end;
1045
1046 procedure TCustomDBGrid.OnFocusControl(aField: TFieldRef);
1047 var
1048 aIndex: Integer;
1049 begin
1050 if CanFocus and (aField<>nil) and (aField^<>nil) then begin
1051 aIndex := GetGridColumnFromField(aField^);
1052 if aIndex>=FirstGridColumn then begin
1053 SelectedField := aField^;
1054 aField^ := nil;
1055 SetFocus;
1056 end;
1057 end;
1058 end;
1059
1060 procedure TCustomDBGrid.OnLayoutChanged(aDataSet: TDataSet);
1061 begin
1062 {$ifdef dbgDBGrid}
1063 DebugLn('%s.OnLayoutChanged', [ClassName]);
1064 {$endif}
1065 LayoutChanged;
1066 end;
1067
1068 procedure TCustomDBGrid.OnNewDataSet(aDataSet: TDataset);
1069 begin
1070 {$ifdef dbgDBGrid}
1071 DebugLnEnter('%s.OnNewDataSet INIT', [ClassName]);
1072 {$endif}
1073 RenewColWidths;
1074 LinkActive(True);
1075 UpdateActive;
1076 SelectEditor;
1077 {$ifdef dbgDBGrid}
1078 DebugLnExit('%s.OnNewDataSet DONE', [ClassName]);
1079 {$endif}
1080 end;
1081
1082 procedure TCustomDBGrid.OnDataSetScrolled(aDataSet: TDataSet; Distance: Integer
1083 );
1084 var
1085 OldEditorMode: boolean;
1086 OldRow: Integer;
1087 begin
1088 {$ifdef dbgDBGrid}
1089 DebugLn('%s.OnDataSetScrolled Distance=%d ds.RecordCount=%d',[ClassName, Distance, aDataSet.RecordCount]);
1090 {$endif}
1091 UpdateScrollBarRange;
1092 // todo: Use a fast interface method to scroll a rectangular section of window
1093 // if distance=+, Row[Distance] to Row[RowCount-2] UP
1094 // if distance=-, Row[FixedRows+1] to Row[RowCount+Distance] DOWN
1095
1096 OldEditorMode := EditorMode;
1097 if OldEditorMode then
1098 EditorMode := False;
1099
1100 if Distance<>0 then begin
1101
1102 OldRow := Row;
1103 Row := FixedRows + FDataLink.ActiveRecord;
1104 if OldRow=Row then // if OldRow<>NewRow SelectEditor will be called by MoveExtend
1105 SelectEditor; // if OldRow=NewRow we need to manually call SelectEditor
1106
1107 Invalidate;
1108 end else
1109 UpdateActive;
1110
1111 if OldEditorMode and (dgAlwaysShowEditor in Options) then
1112 EditorMode := True;
1113 end;
1114
1115 procedure TCustomDBGrid.OnUpdateData(aDataSet: TDataSet);
1116 begin
1117 {$ifdef dbgDBGrid}
1118 DebugLn('%s.OnUpdateData', [ClassName]);
1119 {$endif}
1120 UpdateData;
1121 end;
1122
1123 procedure TCustomDBGrid.SetColumns(const AValue: TDBGridColumns);
1124 begin
1125 {$ifdef dbgDBGrid}
1126 DebugLn('%s.SetColumns', [ClassName]);
1127 {$endif}
1128 inherited Columns := TGridColumns(AValue);
1129 end;
1130
1131 {
1132 procedure TCustomDBGrid.ReadColumns(Reader: TReader);
1133 begin
1134 Columns.Clear;
1135 Reader.ReadValue;
1136 Reader.ReadCollection(Columns);
1137 end;
1138 procedure TCustomDBGrid.SetColumns(const AValue: TDBGridColumns);
1139 begin
1140 Columns.Assign(AValue);
1141 end;
1142 }
1143 procedure TCustomDBGrid.SetCurrentField(const AValue: TField);
1144 var
1145 i: Integer;
1146 begin
1147 if Avalue<>SelectedField then begin
1148 i := GetGridColumnFromField( AValue );
1149 if (i>=FirstGridColumn) and (i>=FixedCols) then
1150 Col := i;
1151 end;
1152 end;
1153
1154 procedure TCustomDBGrid.SetDataSource(const AValue: TDataSource);
1155 begin
1156 {$ifdef dbgDBGrid}
1157 DebugLn('%s.SetDataSource', [ClassName]);
1158 {$endif}
1159 if AValue = FDatalink.Datasource then Exit;
1160 RenewColWidths;
1161 FDataLink.DataSource := AValue;
1162 UpdateActive;
1163 end;
1164
1165 procedure TCustomDBGrid.SetExtraOptions(const AValue: TDBGridExtraOptions);
1166 var
1167 OldOptions: TDBGridExtraOptions;
IsOptionChangednull1168 function IsOptionChanged(Op: TDBGridExtraOption): boolean;
1169 begin
1170 result := ((op in OldOptions) and not (op in AValue)) or
1171 (not (op in OldOptions) and (op in AValue));
1172 end;
1173 begin
1174 {$ifdef dbgDBGrid}
1175 DebugLn('%s.SetExtraOptions', [ClassName]);
1176 {$endif}
1177 if FExtraOptions=AValue then exit;
1178 OldOptions := FExtraOptions;
1179 FExtraOptions := AValue;
1180
1181 if IsOptionChanged(dgeCheckboxColumn) then
1182 Invalidate;
1183
1184 if IsOptionChanged(dgeAutoColumns) then begin
1185 if dgeAutoColumns in aValue then
1186 AddAutomaticColumns
1187 else if TDBGridColumns(Columns).HasAutomaticColumns then
1188 RemoveAutomaticColumns;
1189 UpdateActive;
1190 end;
1191
1192 end;
1193
1194 procedure TCustomDBGrid.SetOptions(const AValue: TDBGridOptions);
1195 var
1196 OldOptions: TGridOptions;
1197 ChangedOptions: TDbGridOptions;
1198 MultiSel: boolean;
1199 begin
1200 {$ifdef dbgDBGrid}
1201 DebugLnEnter('%s.SetOptions INIT', [ClassName]);
1202 {$endif}
1203 if FOptions<>AValue then begin
1204 MultiSel := dgMultiSelect in FOptions;
1205 ChangedOptions := (FOptions-AValue) + (AValue-FOptions);
1206 FOptions:=AValue;
1207 OldOptions := inherited Options;
1208
1209 if dgRowSelect in FOptions then
1210 FOptions := FOptions - [dgEditing, dgAlwaysShowEditor, dgRowHighlight];
1211
1212 BeginLayout;
1213
1214 if dgRowLines in fOptions then
1215 Include(OldOptions, goHorzLine)
1216 else
1217 Exclude(OldOptions, goHorzLine);
1218
1219 if dgColLines in fOptions then
1220 Include(OldOptions, goVertLine)
1221 else
1222 Exclude(OldOptions, goVertLine);
1223
1224 if dgColumnResize in fOptions then
1225 Include(OldOptions, goColSizing)
1226 else
1227 Exclude(OldOptions, goColSizing);
1228
1229 if dgColumnMove in fOptions then
1230 Include(OldOptions, goColMoving)
1231 else
1232 Exclude(OldOptions, goColMoving);
1233
1234 if dgAlwaysShowEditor in FOptions then
1235 Include(OldOptions, goAlwaysShowEditor)
1236 else
1237 Exclude(OldOptions, goAlwaysShowEditor);
1238
1239 if dgRowSelect in FOptions then
1240 Include(OldOptions, goRowSelect)
1241 else
1242 Exclude(OldOptions, goRowSelect);
1243
1244 if dgEditing in FOptions then
1245 Include(OldOptions, goEditing)
1246 else
1247 Exclude(OldOptions, goediting);
1248
1249 if dgTabs in FOptions then
1250 Include(OldOptions, goTabs)
1251 else
1252 Exclude(OldOptions, goTabs);
1253
1254 if dgHeaderHotTracking in FOptions then
1255 Include(OldOptions, goHeaderHotTracking)
1256 else
1257 Exclude(OldOptions, goHeaderHotTracking);
1258
1259 if dgHeaderPushedLook in FOptions then
1260 Include(OldOptions, goHeaderPushedLook)
1261 else
1262 Exclude(OldOptions, goHeaderPushedLook);
1263
1264 if dgCellHints in FOptions then
1265 Include(OldOptions, goCellHints)
1266 else
1267 Exclude(OldOptions, goCellHints);
1268
1269 if dgTruncCellHints in FOptions then
1270 Include(OldOptions, goTruncCellHints)
1271 else
1272 Exclude(OldOptions, goTruncCellHints);
1273
1274 if dgCellEllipsis in FOptions then
1275 Include(OldOptions, goCellEllipsis)
1276 else
1277 Exclude(OldOptions, goCellEllipsis);
1278
1279 if dgRowHighlight in FOptions then
1280 Include(OldOptions, goRowHighlight)
1281 else
1282 Exclude(OldOptions, goRowHighlight);
1283
1284 if dgDblClickAutoSize in FOptions then
1285 Include(OldOptions, goDblClickAutoSize)
1286 else
1287 Exclude(OldOptions, goDblClickAutoSize);
1288
1289 if (dgIndicator in ChangedOptions) then begin
1290 if (dgIndicator in FOptions) then
1291 FixedCols := FixedCols + 1
1292 else
1293 FixedCols := Max(FixedCols - 1, 0);
1294 end;
1295
1296 if (dgTitles in ChangedOptions) then begin
1297 if dgTitles in FOptions then
1298 FixedRows := FixedRows + 1
1299 else
1300 FixedRows := Max(FixedRows - 1, 0);
1301 end;
1302
1303 if (dgAutoSizeColumns in ChangedOptions) then begin
1304 Exclude(FGridStatus, gsAutoSized);
1305 end;
1306
1307 if dgThumbTracking in ChangedOptions then begin
1308 if dgThumbTracking in FOptions then
1309 Include(OldOptions, goThumbTracking)
1310 else
1311 Exclude(OldOptions, goThumbTracking);
1312 end;
1313
1314 inherited Options := OldOptions;
1315
1316 if MultiSel and not (dgMultiSelect in FOptions) then begin
1317 FSelectedRows.Clear;
1318 if FKeyBookmark<>nil then begin
1319 FDatalink.DataSet.FreeBookmark(FKeyBookmark);
1320 FKeyBookmark:=nil;
1321 end;
1322 end;
1323
1324 EndLayout;
1325 end;
1326 {$ifdef dbgDBGrid}
1327 DebugLnExit('%s.SetOptions DONE', [ClassName]);
1328 {$endif}
1329 end;
1330
1331 procedure TCustomDBGrid.SetRowMoved(AValue: TMovedEvent);
1332 begin
1333 if FOnRowMoved = AValue then
1334 Exit;
1335 FOnRowMoved := AValue;
1336 if assigned(OnRowMoved) then
1337 inherited Options := inherited Options + [goRowMoving]
1338 else
1339 inherited Options := inherited Options - [goRowMoving];
1340 end;
1341
1342 procedure TCustomDBGrid.SetSelectedIndex(const AValue: Integer);
1343 begin
1344 Col := FirstGridColumn + AValue;
1345 end;
1346
1347 procedure TCustomDBGrid.UpdateBufferCount;
1348 var
1349 BCount: Integer;
1350 begin
1351 {$ifdef dbgDBGrid}
1352 DebugLnEnter('%s.UpdateBufferCount INIT', [ClassName]);
1353 {$endif}
1354 if FDataLink.Active then begin
1355 BCount := GetBufferCount;
1356 if BCount<1 then
1357 BCount := 1;
1358 FDataLink.BufferCount:= BCount;
1359 end;
1360 {$ifdef dbgDBGrid}
1361 DebugLnExit('%s.UpdateBufferCount DONE BufferCount=%d', [ClassName, FDataLink.BufferCount]);
1362 {$endif}
1363 end;
1364
1365 procedure TCustomDBGrid.UpdateData;
1366 var
1367 selField,edField: TField;
1368 LookupKeyValues: Variant;
1369 begin
1370 // get Editor text and update field content
1371 if not UpdatingData and (FEditingColumn>-1) and FDatalink.Editing then begin
1372 SelField := SelectedField;
1373 edField := GetFieldFromGridColumn(FEditingColumn);
1374
1375 if (edField<>nil) and (edField = SelField) then begin
1376 {$ifdef dbgDBGrid}
1377 DebugLnEnter('%s.UpdateData INIT Field[%s(%s)]=%s',
1378 [ClassName, edField.Fieldname ,edField.AsString, FTempText]);
1379 {$endif}
1380
1381 StartUpdating;
1382 try
1383 edField.Text := FTempText;
1384 if edField.FieldKind = fkLookup then
1385 begin
1386 LookupKeyValues := Null;
1387 if edField.LookupCache then
1388 LookupKeyValues := edField.LookupList.FirstKeyByValue(FTempText)
1389 else
1390 begin
1391 LookupGetBookMark(edField);
1392 try
1393 if edField.LookupDataSet.Locate(edField.LookupResultField,
1394 VarArrayOf([FTempText]), []) then
1395 LookupKeyValues :=
1396 edField.LookupDataSet.FieldValues[edField.LookupKeyFields];
1397 finally
1398 LookupGotoBookMark(edField);
1399 end;
1400 end;
1401 edField.DataSet.FieldValues[edField.KeyFields] := LookupKeyValues;
1402 end;
1403 finally
1404 EndUpdating;
1405 end;
1406 EditingColumn(FEditingColumn, False);
1407 {$ifdef dbgDBGrid}
1408 DebugLnExit('%s.UpdateData DONE Field=%s',[ClassName, edField.ASString]);
1409 {$endif}
1410 end;
1411
1412 end;
1413 end;
1414
1415 {$ifdef dbgDBGrid}
SBCodeToStrnull1416 function SBCodeToStr(Code: Integer): String;
1417 begin
1418 Case Code of
1419 SB_LINEUP : result := 'SB_LINEUP';
1420 SB_LINEDOWN: result := 'SB_LINEDOWN';
1421 SB_PAGEUP: result := 'SB_PAGEUP';
1422 SB_PAGEDOWN: result := 'SB_PAGEDOWN';
1423 SB_THUMBTRACK: result := 'SB_THUMBTRACK';
1424 SB_THUMBPOSITION: result := 'SB_THUMBPOSITION';
1425 SB_ENDSCROLL: result := 'SB_SCROLLEND';
1426 SB_TOP: result := 'SB_TOP';
1427 SB_BOTTOM: result := 'SB_BOTTOM';
1428 else result :=IntToStr(Code)+ ' -> ?';
1429 end;
1430 end;
1431 {$endif}
1432
1433 procedure TCustomDBGrid.WMVScroll(var Message: TLMVScroll);
1434 var
1435 IsSeq: boolean;
1436 aPos, aRange, aPage: Integer;
1437 DeltaRec: integer;
1438
MaxPosnull1439 function MaxPos: Integer;
1440 begin
1441 if IsSeq then
1442 result := GetRecordCount - 1
1443 else
1444 result := 4;
1445 end;
1446
1447 procedure DsMoveBy(Delta: Integer);
1448 begin
1449 FDataLink.MoveBy(Delta);
1450 GetScrollbarParams(aRange, aPage, aPos);
1451 end;
1452
1453 procedure DsGoto(BOF: boolean);
1454 begin
1455 if BOF then FDatalink.DataSet.First
1456 else FDataLink.DataSet.Last;
1457 GetScrollbarParams(aRange, aPage, aPos);
1458 end;
1459
DsPosnull1460 function DsPos: boolean;
1461 var
1462 oldMaxPos: Integer;
1463 begin
1464 result := false;
1465 aPos := Message.Pos;
1466 if aPos=FOldPosition then begin
1467 result := true;
1468 exit;
1469 end;
1470 oldMaxPos := MaxPos;
1471 if aPos>=oldMaxPos then
1472 dsGoto(False)
1473 else if aPos<=0 then
1474 dsGoto(True)
1475 else if IsSeq then begin
1476 FDatalink.DataSet.RecNo := aPos + 1;
1477 {$IFDEF MSWINDOWS}
1478 // Workaround for scrollbar range not being updated
1479 // probably only needed under windows, issue 33799
1480 if oldMaxPos<>MaxPos then begin
1481 ScrollBarShow(SB_VERT, false);
1482 ScrollBarShow(SB_VERT, true);
1483 end;
1484 {$ENDIF}
1485 end
1486 else begin
1487 DeltaRec := Message.Pos - FOldPosition;
1488 if DeltaRec=0 then begin
1489 result := true;
1490 exit
1491 end
1492 else if DeltaRec<-1 then
1493 DsMoveBy(-VisibleRowCount)
1494 else if DeltaRec>1 then
1495 DsMoveBy(VisibleRowCount)
1496 else
1497 DsMoveBy(DeltaRec);
1498 end;
1499 end;
1500
1501 begin
1502 if not FDatalink.Active then exit;
1503
1504 {$ifdef dbgDBGrid}
1505 DebugLnEnter('%s.WMVScroll INIT Code=%s Position=%s OldPos=%s',
1506 [ClassName, SbCodeToStr(Message.ScrollCode), dbgs(Message.Pos), Dbgs(FOldPosition)]);
1507 {$endif}
1508
1509 aPos := 0;
1510 IsSeq := FDatalink.DataSet.IsSequenced and not FDataLink.DataSet.Filtered;
1511 case Message.ScrollCode of
1512 SB_TOP:
1513 DsGoto(True);
1514 SB_BOTTOM:
1515 DsGoto(False);
1516 SB_PAGEUP:
1517 DsMoveBy(-VisibleRowCount);
1518 SB_LINEUP:
1519 DsMoveBy(-1);
1520 SB_LINEDOWN:
1521 DsMoveBy(1);
1522 SB_PAGEDOWN:
1523 DsMoveBy(VisibleRowCount);
1524 SB_THUMBPOSITION:
1525 if DsPos then
1526 exit;
1527 SB_THUMBTRACK:
1528 if dgThumbTracking in Options then begin
1529 if not (FDatalink.DataSet.IsSequenced) or DsPos then begin
1530 {$ifdef dbgDBGrid}
1531 DebugLnExit('%s.WMVScroll EXIT: SB_THUMBTRACK: DsPos or not sequenced', [ClassName]);
1532 {$endif}
1533 exit;
1534 end;
1535 end else begin
1536 {$ifdef dbgDBGrid}
1537 DebugLnExit('%s.WMVScroll EXIT: SB_THUMBTRACK: not using dgThumbTracking', [ClassName]);
1538 {$endif}
1539 Exit;
1540 end;
1541 else begin
1542 {$ifdef dbgDBGrid}
1543 DebugLnExit('%s.WMVScroll EXIT: invalid ScrollCode: %d', [ClassName, message.ScrollCode]);
1544 {$endif}
1545 Exit;
1546 end;
1547 end;
1548
1549 ScrollBarPosition(SB_VERT, aPos);
1550 FOldPosition:=aPos;
1551
1552 if EditorMode then
1553 RestoreEditor;
1554 {$ifdef dbgDBGrid}
1555 DebugLnExit('%s.WMVScroll DONE Diff=%s FinalPos=%s', [ClassName, dbgs(DeltaRec), dbgs(aPos)]);
1556 {$endif}
1557 end;
1558
1559 procedure TCustomDBGrid.WndProc(var TheMessage: TLMessage);
1560 begin
1561 if (TheMessage.Msg=LM_SETFOCUS) and (gsUpdatingData in FGridStatus) then begin
1562 {$ifdef dbgGrid}DebugLn('%s.LM_SETFOCUS while updating', [ClassName]);{$endif}
1563 if EditorMode then begin
1564 LCLIntf.SetFocus(Editor.Handle);
1565 EditorSelectAll;
1566 end;
1567 exit;
1568 end;
1569 inherited WndProc(TheMessage);
1570 end;
1571
1572
TCustomDBGrid.DefaultFieldColWidthnull1573 function TCustomDBGrid.DefaultFieldColWidth(F: TField): Integer;
1574 begin
1575 if not HandleAllocated or (F=nil) then
1576 result:=DefaultColWidth
1577 else begin
1578 if F.DisplayWidth = 0 then
1579 if Canvas.HandleAllocated then
1580 result := Canvas.TextWidth( F.DisplayName ) + 3
1581 else
1582 Result := DefaultColWidth
1583 else
1584 result := F.DisplayWidth * CalcCanvasCharWidth(Canvas);
1585 end;
1586 end;
1587
TCustomDBGrid.GetColumnCountnull1588 function TCustomDBGrid.GetColumnCount: Integer;
1589 var
1590 i: integer;
1591 F: TField;
1592 begin
1593 result := 0;
1594 if Columns.Enabled then
1595 result := Columns.VisibleCount
1596 else
1597 if (dgeAutoColumns in OptionsExtra) and FDataLink.Active then
1598 for i:=0 to FDataLink.DataSet.FieldCount-1 do begin
1599 F:= FDataLink.DataSet.Fields[i];
1600 if (F<>nil) and F.Visible then
1601 Inc(Result);
1602 end;
1603 end;
1604
1605 // Get the visible field (from dataset fields) that corresponds to given column
GetDsFieldFromGridColumnnull1606 function TCustomDBGrid.GetDsFieldFromGridColumn(Column: Integer): TField;
1607 var
1608 i: Integer;
1609 begin
1610 i := FieldIndexFromGridColumn( Column );
1611 if i>=0 then
1612 Result := FDataLink.DataSet.Fields[i]
1613 else
1614 Result := nil;
1615 end;
1616
FirstGridColumnnull1617 function TCustomDBGrid.FirstGridColumn: Integer;
1618 begin
1619 if (dgIndicator in Options) then
1620 Result := 1
1621 else
1622 Result := 0;
1623 end;
1624
1625 procedure TCustomDBGrid.PrepareCellHints(aCol, aRow: Integer);
1626 begin
1627 if not DataLink.Active then Exit;
1628 FSavedRecord := DataLink.ActiveRecord;
1629 DataLink.ActiveRecord := ARow - FixedRows;
1630 end;
1631
1632 procedure TCustomDBGrid.UnprepareCellHints;
1633 begin
1634 if not DataLink.Active then Exit;
1635 DataLink.ActiveRecord := FSavedRecord;
1636 end;
1637
GetCellHintTextnull1638 function TCustomDBGrid.GetCellHintText(aCol, aRow: Integer): String;
1639 var
1640 C: TColumn;
1641 begin
1642 Result := '';
1643 if (ARow < FixedRows) then
1644 exit;
1645 if Assigned(FOnGetCellHint) then begin
1646 C := ColumnFromGridColumn(ACol) as TColumn;
1647 FOnGetCellHint(self, C, Result);
1648 end;
1649 end;
1650
GetTruncCellHintTextnull1651 function TCustomDBGrid.GetTruncCellHintText(aCol, aRow: Integer): string;
1652 var
1653 F: TField;
1654 C: TColumn;
1655 begin
1656 Result := '';
1657 if ARow < FixedRows then
1658 exit;
1659 F := GetFieldFromGridColumn(ACol);
1660 if (F <> nil) then
1661 if CheckDisplayMemo(f) then
1662 result := F.AsString
1663 else
1664 if (F.DataType <> ftBlob) then
1665 Result := F.DisplayText
1666 else
1667 Result := '(blob)';
1668 if Assigned(OnGetCellHint) then begin
1669 C := ColumnFromGridColumn(ACol) as TColumn;
1670 FOnGetCellHint(self, C, Result);
1671 end;
1672 end;
1673
1674 // obtain the field either from a Db column or directly from dataset fields
TCustomDBGrid.GetFieldFromGridColumnnull1675 function TCustomDBGrid.GetFieldFromGridColumn(Column: Integer): TField;
1676 var
1677 i: integer;
1678 begin
1679 if Columns.Enabled then begin
1680 i := ColumnIndexFromGridColumn( Column );
1681 if i>=0 then
1682 result := TDBGridColumns(Columns)[i].FField
1683 else
1684 result := nil;
1685 end else
1686 result := GetDsFieldFromGridColumn(Column);
1687 end;
1688
1689 // obtain the corresponding grid column for the given field
GetGridColumnFromFieldnull1690 function TCustomDBGrid.GetGridColumnFromField(F: TField): Integer;
1691 var
1692 i: Integer;
1693 begin
1694 result := -1;
1695 for i:=FirstGridColumn to ColCount-1 do begin
1696 if GetFieldFromGridColumn(i) = F then begin
1697 result := i;
1698 break;
1699 end;
1700 end;
1701 end;
1702
1703 procedure TCustomDBGrid.GetImageForCheckBox(const aCol, aRow: Integer;
1704 CheckBoxView: TCheckBoxState; var ImageList: TCustomImageList;
1705 var ImageIndex: TImageIndex; var Bitmap: TBitmap);
1706 begin
1707 inherited GetImageForCheckBox(aCol, aRow, CheckBoxView, ImageList, ImageIndex, Bitmap);
1708 if Assigned(OnUserCheckboxBitmap) then
1709 OnUserCheckboxBitmap(Self, CheckBoxView, Bitmap);
1710 end;
1711
1712 // obtain the visible field index corresponding to the grid column index
TCustomDBGrid.FieldIndexFromGridColumnnull1713 function TCustomDBGrid.FieldIndexFromGridColumn(AGridCol: Integer): Integer;
1714 var
1715 i: Integer;
1716 Column: TColumn;
1717 begin
1718 result := -1;
1719 if not FDatalink.Active then
1720 exit;
1721
1722 if Columns.Enabled then begin
1723 Column := TColumn(ColumnFromGridColumn(AGridCol));
1724 if (Column<>nil) and (Column.Field<>nil) and Column.Field.Visible then
1725 Result := FDatalink.Dataset.Fields.IndexOf(Column.Field)
1726 end else begin
1727 AGridCol := AGridCol - FirstGridColumn;
1728 i := 0;
1729 while (AGridCol>=0) and (i<FDatalink.DataSet.FieldCount) do begin
1730 if FDatalink.Fields[i].Visible then begin
1731 Dec(AGridCol);
1732 if AGridCol<0 then begin
1733 Result := i;
1734 break;
1735 end;
1736 end;
1737 inc(i);
1738 end;
1739 end;
1740 end;
1741
GetBufferCountnull1742 function TCustomDBGrid.GetBufferCount: integer;
1743 begin
1744 {$ifdef dbgDBGrid}
1745 DebugLn('%s.GetBufferCount', [ClassName]);
1746 {$endif}
1747 Result := ClientHeight div DefaultRowHeight;
1748 if dgTitles in Options then
1749 Dec(Result, 1);
1750 end;
1751
1752 procedure TCustomDBGrid.UpdateGridColumnSizes;
1753 var
1754 i: Integer;
1755 begin
1756 {$ifdef dbgDBGrid}
1757 DebugLn('%s.UpdateGridColumnSizes', [ClassName]);
1758 {$endif}
1759 if FDefaultColWidths then begin
1760 if dgIndicator in Options then
1761 ColWidths[0]:=Scale96ToFont(12);
1762 if NeedAutoSizeColumns then
1763 UpdateAutoSizeColumns;
1764 end;
1765 end;
1766
1767 procedure TCustomDBGrid.UpdateScrollbarRange;
1768 var
1769 aRange, aPage, aPos: Integer;
1770 ScrollInfo: TScrollInfo;
1771 begin
1772 if not HandleAllocated then exit;
1773
1774 {$ifdef dbgDBGrid}
1775 DebugLnEnter('%s.UpdateScrollbarRange INIT', [ClassName]);
1776 {$endif}
1777
1778 GetScrollBarParams(aRange, aPage, aPos);
1779
1780 if (ScrollBars in [ssBoth, ssVertical])
1781 or ((Scrollbars in [ssAutoVertical, ssAutoBoth]) and (aRange>aPage)) then
1782 begin
1783 FillChar(ScrollInfo, SizeOf(ScrollInfo), 0);
1784 ScrollInfo.cbSize := SizeOf(ScrollInfo);
1785
1786 {TODO: try to move this out}
1787 {$ifdef WINDOWS}
1788 ScrollInfo.fMask := SIF_ALL or SIF_DISABLENOSCROLL;
1789 ScrollInfo.ntrackPos := 0;
1790 {$else}
1791 ScrollInfo.fMask := SIF_ALL or SIF_UPDATEPOLICY;
1792 //ScrollInfo.ntrackPos := SB_POLICY_CONTINUOUS;
1793 ScrollInfo.ntrackPos := SB_POLICY_DISCONTINUOUS;
1794 {$endif}
1795 ScrollInfo.nMin := 0;
1796 ScrollInfo.nMax := aRange;
1797 ScrollInfo.nPos := Min(aPos,aRange-aPage);
1798 ScrollInfo.nPage := aPage;
1799 SetScrollInfo(Handle, SB_VERT, ScrollInfo, True);
1800 end;
1801
1802 FOldPosition := aPos;
1803 {$ifdef dbgDBGrid}
1804 DebugLnExit('%s.UpdateScrollBarRange DONE Handle=%d aRange=%d aPage=%d aPos=%d',
1805 [ClassName, Handle, aRange, aPage, aPos]);
1806 {$endif}
1807 end;
1808
1809 procedure TCustomDBGrid.DoLayoutChanged;
1810 begin
1811 if csDestroying in ComponentState then
1812 exit;
1813 {$ifdef dbgDBGrid}DebugLnEnter('%s.doLayoutChanged INIT', [ClassName]);{$endif}
1814 BeginUpdate;
1815 if UpdateGridCounts=0 then
1816 EmptyGrid;
1817 EndUpdate;
1818 UpdateScrollbarRange;
1819 {$ifdef dbgDBGrid}DebugLnExit('%s.doLayoutChanged DONE', [ClassName]);{$endif}
1820 end;
1821 {
1822 procedure TCustomDBGrid.WriteColumns(Writer: TWriter);
1823 begin
1824 if Columns.IsDefault then
1825 Writer.WriteCollection(nil)
1826 else
1827 Writer.WriteCollection(Columns);
1828 end;
1829 }
1830 procedure TCustomDBGrid.RestoreEditor;
1831 begin
1832 if EditorMode then begin
1833 EditorMode := False;
1834 EditorMode := True;
1835 end;
1836 end;
1837
ISEOFnull1838 function TCustomDBGrid.ISEOF: boolean;
1839 begin
1840 {$ifdef dbgDBGrid}
1841 DebugLn('%s.IsEOF', [ClassName]);
1842 {$endif}
1843 Result := FDatalink.Active and FDatalink.DataSet.EOF;
1844 end;
1845
TCustomDBGrid.ValidDataSetnull1846 function TCustomDBGrid.ValidDataSet: boolean;
1847 begin
1848 {$ifdef dbgDBGrid}
1849 DebugLn('%s.ValidDataSet', [ClassName]);
1850 {$endif}
1851 Result := FDatalink.Active And (FDatalink.DataSet<>nil)
1852 end;
1853
InsertCancelablenull1854 function TCustomDBGrid.InsertCancelable: boolean;
1855 begin
1856 with FDatalink.DataSet do
1857 Result := (State=dsInsert) and not (Modified or FDataLink.FModified);
1858 end;
1859
1860 procedure TCustomDBGrid.StartUpdating;
1861 begin
1862 if not UpdatingData then begin
1863 {$ifdef dbgDBGrid}DebugLn('%s.StartUpdating', [ClassName]);{$endif}
1864 Include(FGridStatus, gsUpdatingData);
1865 FOldControlStyle := ControlStyle;
1866 ControlStyle := ControlStyle + [csActionClient];
1867 LockEditor;
1868 end
1869 else
1870 {$ifdef dbgDBGrid}DebugLn('WARNING: multiple calls to StartUpdating');{$endif}
1871 end;
1872
1873 procedure TCustomDBGrid.EndUpdating;
1874 begin
1875 {$ifdef dbgDBGrid}DebugLn('%s.EndUpdating', [ClassName]);{$endif}
1876 Exclude(FGridStatus, gsUpdatingData);
1877 ControlStyle := FOldControlStyle;
1878 UnLockEditor;
1879 if csActionClient in ControlStyle then
1880 DebugLn('WARNING: still got csActionClient');
1881 end;
1882
TCustomDBGrid.UpdatingDatanull1883 function TCustomDBGrid.UpdatingData: boolean;
1884 begin
1885 result := gsUpdatingData in FGridStatus;
1886 end;
1887
1888 procedure TCustomDBGrid.AddAutomaticColumns;
1889 var
1890 i: Integer;
1891 F: TField;
1892 begin
1893 // add as many columns as there are fields in the dataset
1894 // do this only at runtime.
1895 if (csDesigning in ComponentState) or not FDatalink.Active or
1896 (gsRemovingAutoColumns in FGridStatus) or (gsLoadingGrid in FGridStatus) or
1897 not (dgeAutoColumns in OptionsExtra)
1898 then
1899 exit;
1900 Include(FGridStatus, gsAddingAutoColumns);
1901 try
1902 for i:=0 to FDataLink.DataSet.FieldCount-1 do begin
1903
1904 F:= FDataLink.DataSet.Fields[i];
1905
1906 if TDBGridColumns(Columns).ColumnFromField(F) <> nil then
1907 // this field is already in the collection. This could only happen
1908 // if AddAutomaticColumns was called out of LayoutChanged.
1909 // to avoid duplicate columns skip this field.
1910 continue;
1911
1912 if (F<>nil) then begin
1913 with TDBGridColumns(Columns).Add do begin
1914 FIsAutomaticColumn := True;
1915 Field := F;
1916 Visible := F.Visible;
1917 end;
1918 end;
1919
1920 end;
1921 // honor the field.index
1922 TDBGridColumns(Columns).ResetColumnsOrder(coFieldIndexOrder);
1923 finally
1924 Exclude(FGridStatus, gsAddingAutoColumns);
1925 end;
1926 end;
1927
1928 procedure TCustomDBGrid.AssignTo(Dest: TPersistent);
1929 begin
1930 if Dest is TCustomDbGrid then begin
1931 // TODO
1932 end else
1933 inherited AssignTo(Dest);
1934 end;
1935
1936 procedure TCustomDBGrid.AutoAdjustColumn(aCol: Integer);
1937 var
1938 DatalinkActive: Boolean;
1939 CurActiveRecord: Integer;
1940 tmpCanvas: TCanvas;
1941 begin
1942 BeginLayout;
1943
1944 DatalinkActive := FDatalink.Active;
1945 if DatalinkActive then
1946 CurActiveRecord := FDatalink.ActiveRecord;
1947
1948 tmpCanvas := GetWorkingCanvas(Canvas);
1949 try
1950
1951 InternalAutoSizeColumn(aCol,tmpCanvas,DatalinkActive);
1952
1953 finally
1954 if TmpCanvas<>Canvas then
1955 FreeWorkingCanvas(tmpCanvas);
1956
1957 if DatalinkActive then
1958 FDatalink.ActiveRecord := CurActiveRecord;
1959
1960 EndLayout;
1961 end;
1962 end;
1963
1964 procedure TCustomDBGrid.UpdateAutoSizeColumns;
1965 var
1966 ACol: Integer;
1967 DatalinkActive: boolean;
1968 CurActiveRecord: Integer;
1969 tmpCanvas: TCanvas;
1970 begin
1971 if gsAutoSized in GridStatus then
1972 exit;
1973
1974 BeginLayout;
1975
1976 DatalinkActive := FDatalink.Active;
1977 if DatalinkActive then
1978 CurActiveRecord := FDatalink.ActiveRecord;
1979
1980 tmpCanvas := GetWorkingCanvas(Canvas);
1981 try
1982
1983 for aCol:=FixedCols to ColCount-1 do
1984 InternalAutoSizeColumn(ACol,tmpCanvas,DatalinkActive);
1985
1986 finally
1987 if TmpCanvas<>Canvas then
1988 FreeWorkingCanvas(tmpCanvas);
1989
1990 if DatalinkActive then
1991 FDatalink.ActiveRecord := CurActiveRecord;
1992
1993 include(FGridStatus, gsAutoSized);
1994
1995 EndLayout;
1996 end;
1997
1998 end;
1999
2000 procedure TCustomDBGrid.SwapCheckBox;
2001 var
2002 SelField: TField;
2003 TempColumn: TColumn;
2004 begin
2005 if not GridCanModify then
2006 exit;
2007
2008 SelField := SelectedField;
2009 TempColumn := TColumn(ColumnFromGridColumn(Col));
2010 if (SelField<>nil) and (TempColumn<>nil) and not TempColumn.ReadOnly and
2011 FDatalink.Edit then
2012 begin
2013 if SelField.DataType=ftBoolean then
2014 SelField.AsBoolean := not SelField.AsBoolean
2015 else
2016 begin
2017 if TempColumn.ValueChecked=SelField.AsString then
2018 SelField.AsString := TempColumn.ValueUnchecked
2019 else
2020 SelField.AsString := TempColumn.ValueChecked;
2021 end;
2022 end;
2023 end;
2024
2025 procedure TCustomDBGrid.ToggleSelectedRow;
2026 begin
2027 SelectRecord(not FSelectedRows.CurrentRowSelected);
2028 end;
2029
2030 procedure TCustomDBGrid.LinkActive(Value: Boolean);
2031 begin
2032 {$ifdef dbgDBGrid}
2033 DebugLn('%s.LinkActive', [ClassName]);
2034 {$endif}
2035 if not Value then begin
2036 FSelectedRows.Clear;
2037 if FKeyBookmark<>nil then begin
2038 FDatalink.DataSet.FreeBookmark(FKeyBookmark);
2039 FKeyBookmark:=nil;
2040 end;
2041 RemoveAutomaticColumns;
2042 end;
2043 LayoutChanged;
2044 end;
2045
2046 procedure TCustomDBGrid.LayoutChanged;
2047 begin
2048 {$ifdef dbgDBGrid}
2049 DebugLn('%s.LayoutChanged', [ClassName]);
2050 {$endif}
2051 if csDestroying in ComponentState then
2052 exit;
2053 if FLayoutChangedCount=0 then begin
2054 BeginLayout;
2055 if Columns.Count>0 then
2056 TDBGridColumns(Columns).LinkFields
2057 else if not FDataLink.Active then
2058 FDataLink.BufferCount := 0
2059 else
2060 AddAutomaticColumns;
2061 EndLayout;
2062 end;
2063 end;
2064
2065 procedure TCustomDBGrid.Loaded;
2066 begin
2067 {$ifdef dbgDBGrid}
2068 DebugLn('%s.Loaded', [ClassName]);
2069 {$endif}
2070 LayoutChanged;
2071 inherited Loaded;
2072 end;
2073
2074 procedure TCustomDBGrid.LoadGridOptions(cfg: TXMLConfig; Version: Integer);
2075 var
2076 Opt: TDBGridOptions;
2077 Path: string;
2078 procedure GetValue(optStr:string; aOpt:TDBGridOption);
2079 begin
2080 if Cfg.GetValue(Path+OptStr+'/value', False) then Opt:=Opt+[aOpt];
2081 end;
2082 begin
2083 Opt:=[];
2084 Path:='grid/design/options/';
2085 GetValue('dgEditing', dgEditing);
2086 GetValue('dgTitles', dgTitles);
2087 GetValue('dgIndicator', dgIndicator);
2088 GetValue('dgColumnResize', dgColumnResize);
2089 GetValue('dgColumnMove', dgColumnMove);
2090 GetValue('dgColLines', dgColLines);
2091 GetValue('dgRowLines', dgRowLines);
2092 GetValue('dgTabs', dgTabs);
2093 GetValue('dgAlwaysShowEditor', dgAlwaysShowEditor);
2094 GetValue('dgRowSelect', dgRowSelect);
2095 GetValue('dgAlwaysShowSelection', dgAlwaysShowSelection);
2096 GetValue('dgConfirmDelete', dgConfirmDelete);
2097 GetValue('dgCancelOnExit', dgCancelOnExit);
2098 GetValue('dgMultiselect', dgMultiselect);
2099 GetValue('dgHeaderHotTracking', dgHeaderHotTracking);
2100 GetValue('dgHeaderPushedLook', dgHeaderPushedLook);
2101 GetValue('dgPersistentMultiSelect', dgPersistentMultiSelect);
2102 GetValue('dgAutoSizeColumns', dgAutoSizeColumns);
2103 GetValue('dgAnyButtonCanSelect', dgAnyButtonCanSelect);
2104 GetValue('dgDisableDelete', dgDisableDelete);
2105 GetValue('dgDisableInsert', dgDisableInsert);
2106 GetValue('dgCellHints', dgCellHints);
2107 GetValue('dgTruncCellHints', dgTruncCellHints);
2108 GetValue('dgCellEllipsis', dgCellEllipsis);
2109 GetValue('dgRowHighlight', dgRowHighlight);
2110 GetValue('dgThumbTracking', dgThumbTracking);
2111 Options:=Opt;
2112 end;
2113
2114 type
2115 TProtFields=class(TFields)
2116 end;
2117
2118 procedure TCustomDBGrid.ColRowMoved(IsColumn: Boolean; FromIndex,
2119 ToIndex: Integer);
2120 var
2121 F: TField;
2122 begin
2123 if IsColumn then begin
2124 if Columns.Enabled then
2125 inherited ColRowMoved(IsColumn, FromIndex, ToIndex)
2126 else if FDatalink.Active and (FDataLink.DataSet<>nil) then begin
2127 F := GetDsFieldFromGridColumn(FromIndex);
2128 if F<>nil then begin
2129 TProtFields(FDatalink.DataSet.Fields).SetFieldIndex( F, ToIndex - FirstGridColumn );
2130 end;
2131 end;
2132 if Assigned(OnColumnMoved) then
2133 OnColumnMoved(Self, FromIndex, ToIndex);
2134 end
2135 else if Assigned(OnRowMoved) then
2136 OnRowMoved(Self, FromIndex, ToIndex);
2137 end;
2138
ColumnEditorStylenull2139 function TCustomDBGrid.ColumnEditorStyle(aCol: Integer; F: TField): TColumnButtonStyle;
2140 var
2141 gridcol: TGridColumn;
2142 begin
2143 result := cbsAuto;
2144 gridcol := ColumnFromGridColumn(aCol);
2145 if Columns.Enabled and assigned(gridcol) then
2146 result := gridcol.ButtonStyle;
2147
2148 result := DefaultEditorStyle(result, F);
2149 end;
2150
CreateColumnsnull2151 function TCustomDBGrid.CreateColumns: TGridColumns;
2152 begin
2153 {$ifdef dbgDBGrid}
2154 DebugLn('%s.CreateColumns', [ClassName]);
2155 {$endif}
2156 result := TDBGridColumns.Create(Self, TColumn);
2157 end;
2158
2159 procedure TCustomDBGrid.CreateWnd;
2160 begin
2161 {$ifdef dbgDBGrid}
2162 DebugLn('%s.CreateWnd', [ClassName]);
2163 {$endif}
2164 inherited CreateWnd;
2165 LayoutChanged;
2166 if Scrollbars in [ssBoth, ssVertical, ssAutoBoth, ssAutoVertical] then
2167 ScrollBarShow(SB_VERT, True);
2168 end;
2169
2170 procedure TCustomDBGrid.DefineProperties(Filer: TFiler);
2171 {
2172 function HasColumns: boolean;
2173 var
2174 C: TGridColumns;
2175 begin
2176 if Filer.Ancestor <> nil then
2177 C := TCustomGrid(Filer.Ancestor).Columns
2178 else
2179 C := Columns;
2180 if C<>nil then
2181 result := not C.IsDefault
2182 else
2183 result := false;
2184 end;
2185 }
2186 begin
2187 // simply avoid to call TCustomGrid.DefineProperties method
2188 // which defines ColWidths,Rowheights,Cells
2189 //Filer.DefineProperty('Columns', @ReadColumns, @WriteColumns, HasColumns);
2190 end;
2191
2192 procedure TCustomDBGrid.DefaultDrawCell(aCol, aRow: Integer; aRect: TRect;
2193 aState: TGridDrawState);
2194
2195 var
2196 S: string;
2197 F: TField;
2198 cbs: TColumnButtonStyle;
2199 begin
2200
2201 DrawCellBackground(aCol, aRow, aRect, aState);
2202
2203 if gdFixed in aState then
2204 DrawFixedText(aCol, aRow, aRect, aState)
2205 else
2206 if not FDrawingEmptyDataset then begin
2207
2208 F := GetFieldFromGridColumn(aCol);
2209 cbs := ColumnEditorStyle(aCol, F);
2210 case cbs of
2211 cbsCheckBoxColumn:
2212 DrawCheckBoxBitmaps(aCol, aRect, F);
2213 else
2214 begin
2215
2216 if cbs=cbsButtonColumn then
2217 DrawButtonCell(aCol, aRow, aRect, aState);
2218
2219 {$ifdef dbggridpaint}
2220 DbgOut(' Col=%d',[ACol]);
2221 {$endif}
2222 if F<>nil then begin
2223 {$ifdef dbgGridPaint}
2224 DbgOut(' Field=%s',[F.FieldName]);
2225 {$endif}
2226 if CheckDisplayMemo(F) then
2227 S := F.AsString
2228 else
2229 S := F.DisplayText;
2230 end else
2231 S := '';
2232 {$ifdef dbggridpaint}
2233 DbgOut(' Value=%s ',[S]);
2234 {$endif}
2235 DrawCellText(aCol,aRow,aRect,aState,S);
2236 end;
2237 end;
2238 end;
2239 end;
2240
TCustomDBGrid.DefaultEditorStylenull2241 function TCustomDBGrid.DefaultEditorStyle(const Style: TColumnButtonStyle;
2242 const F: TField): TColumnButtonStyle;
2243 begin
2244 result := Style;
2245 if (Result=cbsAuto) and (F<>nil) then
2246 case F.DataType of
2247 ftBoolean: Result := cbsCheckboxColumn;
2248 end;
2249 if (result = cbsCheckBoxColumn) and not (dgeCheckboxColumn in FExtraOptions) then
2250 Result := cbsAuto;
2251 end;
2252
2253 procedure TCustomDBGrid.DoCopyToClipboard;
2254 var
2255 F: TField;
2256 begin
2257 // copy current field to clipboard
2258 if not FDatalink.Active then
2259 exit;
2260 F := GetFieldFromGridColumn(Col);
2261 if F<>nil then
2262 Clipboard.AsText := F.AsString;
2263 end;
2264
2265 procedure TCustomDBGrid.DoOnChangeBounds;
2266 begin
2267 BeginUpdate;
2268 inherited DoOnChangeBounds;
2269 if HandleAllocated then
2270 LayoutChanged;
2271 EndUpdate;
2272 end;
2273
2274 procedure TCustomDBGrid.DoPrepareCanvas(aCol, aRow: Integer;
2275 aState: TGridDrawState);
2276 var
2277 DataCol: Integer;
2278 IsSelected: boolean;
2279 begin
2280 if (ARow>=FixedRows) then begin
2281
2282 if not DefaultDrawing then begin
2283 GetSelectedState(aState, IsSelected);
2284 if IsSelected then begin
2285 Canvas.Brush.Color := SelectedColor;
2286 Canvas.Font.Color := clHighlightText;
2287 end;
2288 end;
2289
2290 if Assigned(OnPrepareCanvas) then begin
2291 DataCol := ColumnIndexFromGridColumn(aCol);
2292 if DataCol>=0 then
2293 OnPrepareCanvas(Self, DataCol, TColumn(Columns[DataCol]), aState);
2294 end;
2295
2296 end;
2297 end;
2298
2299 procedure TCustomDBGrid.DoLoadColumn(sender: TCustomGrid; aColumn: TGridColumn;
2300 aColIndex: Integer; aCfg: TXMLConfig; aVersion: Integer; aPath: string);
2301 var
2302 c: TColumn;
2303 s: string;
2304 begin
2305 c:=TColumn(aColumn);
2306 s := aCfg.GetValue(aPath + '/fieldname/value', '');
2307 if s<>'' then
2308 c.FieldName := s;
2309 s := aCfg.GetValue(aPath + '/displayformat/value', '');
2310 if s<>'' then
2311 c.DisplayFormat := s;
2312 inherited DoLoadColumn(sender, aColumn, aColIndex, aCfg, aVersion, aPath);
2313 end;
2314
2315 procedure TCustomDBGrid.DoSaveColumn(sender: TCustomGrid; aColumn: TGridColumn;
2316 aColIndex: Integer; aCfg: TXMLConfig; aVersion: Integer; aPath: string);
2317 var
2318 c: TColumn;
2319 begin
2320 c:=TColumn(aColumn);
2321 aCfg.SetValue(aPath + '/fieldname/value', c.FieldName);
2322 aCfg.SetValue(aPath + '/displayformat/value', c.DisplayFormat);
2323 inherited DoSaveColumn(sender, aColumn, aColIndex, aCfg, aVersion, aPath);
2324 end;
2325
2326 procedure TCustomDBGrid.BeforeMoveSelection(const DCol,DRow: Integer);
2327 begin
2328 {$ifdef dbgDBGrid}DebugLnEnter('%s.BeforeMoveSelection INIT', [ClassName]);{$endif}
2329 inherited BeforeMoveSelection(DCol, DRow);
2330 if DCol<>Col then begin
2331 if assigned(OnColExit) then
2332 OnColExit(Self);
2333 FColEnterPending:=True;
2334 end;
2335 {$ifdef dbgDBGrid}DebugLnExit('%s.BeforeMoveSelection DONE', [ClassName]);{$endif}
2336 end;
2337
2338 procedure TCustomDBGrid.HeaderClick(IsColumn: Boolean; index: Integer);
2339 begin
2340 {$ifdef dbgDBGrid}
2341 DebugLn('%s.HeaderClick', [ClassName]);
2342 {$endif}
2343 if IsColumn then
2344 DoHeaderClick(Index);
2345 end;
2346
2347 procedure TCustomDBGrid.KeyDown(var Key: Word; Shift: TShiftState);
2348 type
2349 TOperation=(opMoveBy,opCancel,opAppend,opInsert,opDelete);
2350 var
2351 DeltaCol,DeltaRow: Integer;
2352
2353 procedure DoOnKeyDown;
2354 begin
2355 {$ifdef dbgGrid}DebugLnEnter('DoOnKeyDown INIT');{$endif}
2356 if Assigned(OnKeyDown) then
2357 OnKeyDown(Self, Key, Shift);
2358 {$ifdef dbgGrid}DebugLnExit('DoOnKeyDown DONE');{$endif}
2359 end;
2360
2361 {$ifdef dbgGrid}
OperToStrnull2362 function OperToStr(AOper: TOperation): string;
2363 begin
2364 case AOper of
2365 opMoveBy: result := 'opMoveBy';
2366 opCancel: result := 'opCancel';
2367 opAppend: result := 'opAppend';
2368 opInsert: result := 'opInsert';
2369 opDelete: result := 'opDelete';
2370 end;
2371 end;
2372 {$endif}
2373
2374 procedure DoOperation(AOper: TOperation; Arg: Integer = 0);
2375 begin
2376 {$ifdef dbgGrid}DebugLnEnter('KeyDown.DoOperation(%s,%d) INIT',[OperToStr(AOper),arg]);{$endif}
2377 GridFlags := GridFlags + [gfEditingDone];
2378 case AOper of
2379 opMoveBy:
2380 FDatalink.MoveBy(Arg);
2381 opCancel:
2382 begin
2383 if EditorMode then
2384 EditorCancelEditing;
2385 FDatalink.Dataset.Cancel;
2386 end;
2387 opAppend:
2388 FDatalink.Dataset.Append;
2389 opInsert:
2390 FDatalink.Dataset.Insert;
2391 opDelete:
2392 FDatalink.Dataset.Delete;
2393 end;
2394 GridFlags := GridFlags - [gfEditingDone];
2395 {$ifdef dbgGrid}DebugLnExit('KeyDown.DoOperation(%s,%d) DONE',[OperToStr(AOper),arg]);{$endif}
2396 end;
2397
2398 procedure SelectNext(const AStart,ADown:Boolean);
2399 var
2400 N: Integer;
2401 CurBookmark: TBookmark;
2402 begin
2403 if dgPersistentMultiSelect in Options then
2404 exit;
2405
2406 if (ssShift in Shift) then begin
2407
2408 CurBookmark := FDatalink.DataSet.GetBookmark;
2409 if FKeyBookmark=nil then
2410 FKeyBookmark:=CurBookmark;
2411
2412 if (FKeyBookmark=CurBookmark) then begin
2413 if AStart then begin
2414 SelectRecord(true);
2415 if ADown then
2416 FKeySign := 1
2417 else
2418 FKeySign := -1;
2419 exit;
2420 end;
2421 FKeySign := 0;
2422 end else
2423 FDatalink.DataSet.FreeBookmark(CurBookmark);
2424
2425 n := 4*Ord(FKeySign>=0) + 2*Ord(ADown) + 1*Ord(AStart);
2426 case n of
2427 0,6,8..11:
2428 begin
2429 SelectRecord(True);
2430 end;
2431 3,5:
2432 begin
2433 SelectRecord(False);
2434 end;
2435 end;
2436 end else
2437 ClearSelection(true);
2438 end;
2439
doVKDownnull2440 function doVKDown: boolean;
2441 begin
2442 {$ifdef dbgGrid}DebugLnEnter('DoVKDown INIT');{$endif}
2443 if InsertCancelable then
2444 begin
2445 if IsEOF then
2446 result:=true
2447 else begin
2448 doOperation(opCancel);
2449 result := false;
2450 end;
2451 end else begin
2452 result:=false;
2453 SelectNext(true,true);
2454 doOperation(opMoveBy, 1);
2455 if GridCanModify and FDataLink.EOF then begin
2456 if not (dgDisableInsert in Options) then
2457 doOperation(opAppend);
2458 end else
2459 SelectNext(false,true);
2460 end;
2461 {$ifdef dbgGrid}DebugLnExit('DoVKDown DONE');{$endif}
2462 end;
2463
DoVKUPnull2464 function DoVKUP: boolean;
2465 begin
2466 {$ifdef dbgGrid}DebugLnEnter('DoVKUP INIT');{$endif}
2467 if InsertCancelable then
2468 doOperation(opCancel)
2469 else begin
2470 SelectNext(true, false);
2471 doOperation(opMoveBy, -1);
2472 SelectNext(false, false);
2473 end;
2474 result := FDatalink.DataSet.BOF;
2475 {$ifdef dbgGrid}DebugLnExit('DoVKUP DONE');{$endif}
2476 end;
2477
2478 procedure MoveSel(AReset: boolean);
2479 var
2480 ACol: Integer;
2481 begin
2482 if (DeltaCol<>0) or (DeltaRow<>0) then begin
2483 if DeltaRow > 0 then begin
2484 if doVKDown then
2485 //DeltaCol:=0; // tochk: strict? already in EOF, don't change column
2486 end else
2487 if DeltaRow < 0 then begin
2488 if doVKUP then
2489 //DeltaCol:=0; // tochk: strict? already in BOF, don't change column
2490 end;
2491 GridFlags := GridFlags + [gfEditingDone];
2492 if (DeltaCol<>0) then
2493 if Col + DeltaCol < FixedCols then
2494 Col := FixedCols
2495 else if Col + DeltaCol >= ColCount then
2496 Col := ColCount - 1
2497 else
2498 begin
2499 ACol := Col + DeltaCol;
2500 if ColWidths[ACol] > 0 then
2501 Col := ACol
2502 else
2503 if DeltaCol < 0 then
2504 Col := GetFirstVisibleColumn
2505 else
2506 Col := GetLastVisibleColumn;
2507 end;
2508 GridFlags := GridFlags - [gfEditingDone];
2509 end else
2510 if AReset then
2511 ResetEditor;
2512 end;
2513
2514 begin
2515 {$ifdef dbgGrid}DebugLnEnter('%s.KeyDown %s INIT Key=%d',[ClassName, Name,Key]);{$endif}
2516 case Key of
2517
2518 VK_TAB:
2519 begin
2520 doOnKeyDown;
2521 if (Key<>0) and ValidDataset then begin
2522 if (dgTabs in Options) then begin
2523
2524 if ((ssShift in shift) and
2525 (Col<=GetFirstVisibleColumn) and (Row<=GetFirstVisibleRow)) then begin
2526 if EditorKey then
2527 GridFlags := GridFlags + [gfRevEditorTab];
2528 {$ifdef dbgGrid}DebugLnExit('%s.KeyDown Exit: Tab: Shift',[ClassName]);{$endif}
2529 exit;
2530 end;
2531
2532 GetDeltaMoveNext(ssShift in Shift, DeltaCol, DeltaRow, TabAdvance);
2533
2534 if (not (ssShift in Shift)) and (Row>=GetLastVisibleRow) and
2535 (DeltaRow>0) and (Col=GetLastVisibleColumn) and
2536 (FDatalink.Editing or not GridCanModify) then begin
2537 {$ifdef dbgGrid}DebugLnExit('%s.KeyDown Exit: Tab: not shift',[ClassName]);{$endif}
2538 exit;
2539 end;
2540
2541 MoveSel(false);
2542 Key := 0;
2543 end;
2544 end;
2545 end;
2546
2547 VK_RETURN:
2548 begin
2549 doOnKeyDown;
2550 if (Key<>0) and ValidDataset then begin
2551 key:=0;
2552 if (dgEditing in Options) and not EditorMode then
2553 EditorMode:=true
2554 else begin
2555 GetDeltaMoveNext(ssShift in Shift, DeltaCol, DeltaRow, AutoAdvance);
2556 MoveSel(True);
2557 end;
2558 end;
2559 end;
2560
2561 VK_DELETE:
2562 begin
2563 doOnKeyDown;
2564 if (Key<>0) and (ssCtrl in Shift) and GridCanModify and
2565 (not (dgDisableDelete in Options)) and
2566 not FDataLink.DataSet.IsEmpty then begin
2567
2568 if not (dgConfirmDelete in Options) or
2569 (MessageDlg(rsDeleteRecord, mtConfirmation, mbOKCancel, 0 )<>mrCancel)
2570 then begin
2571 doOperation(opDelete);
2572 key := 0;
2573 end;
2574
2575 end;
2576 end;
2577
2578 VK_DOWN:
2579 begin
2580 DoOnKeyDown;
2581 if (Key<>0) and ValidDataset then begin
2582 doVKDown;
2583 Key := 0;
2584 end;
2585 end;
2586
2587 VK_UP:
2588 begin
2589 doOnKeyDown;
2590 if (Key<>0) and ValidDataset then begin
2591 doVKUp;
2592 key := 0;
2593 end;
2594 end;
2595
2596 VK_NEXT:
2597 begin
2598 doOnKeyDown;
2599 if (Key<>0) and ValidDataset then begin
2600 doOperation(opMoveBy, VisibleRowCount);
2601 ClearSelection(true);
2602 Key := 0;
2603 end;
2604 end;
2605
2606 VK_PRIOR:
2607 begin
2608 doOnKeyDown;
2609 if (Key<>0) and ValidDataset then begin
2610 doOperation(opMoveBy, -VisibleRowCount);
2611 ClearSelection(true);
2612 key := 0;
2613 end;
2614 end;
2615
2616 VK_ESCAPE:
2617 begin
2618 doOnKeyDown;
2619 if (Key<>0) and ValidDataset then begin
2620 if EditorMode then begin
2621 EditorCancelEditing;
2622 if FDatalink.Active and not FDatalink.Dataset.Modified then
2623 FDatalink.Modified := False;
2624 Key := 0;
2625 end else
2626 if FDataLink.Active then
2627 doOperation(opCancel);
2628 end;
2629 end;
2630
2631 VK_INSERT:
2632 begin
2633 doOnKeyDown;
2634 if Key<>0 then
2635 if not (dgDisableInsert in Options) and GridCanModify then begin
2636 doOperation(opInsert);
2637 Key:=0;
2638 end;
2639 end;
2640
2641 VK_HOME:
2642 begin
2643 doOnKeyDown;
2644 if Key<>0 then begin
2645 if FDatalink.Active then begin
2646 GridFlags := GridFlags + [gfEditingDone];
2647 if ssCTRL in Shift then
2648 FDataLink.DataSet.First
2649 else
2650 MoveNextSelectable(False, FixedCols, Row);
2651 GridFlags := GridFlags - [gfEditingDone];
2652 ClearSelection(true);
2653 Key:=0;
2654 end;
2655 end;
2656 end;
2657
2658 VK_END:
2659 begin
2660 doOnKeyDown;
2661 if Key<>0 then begin
2662 if FDatalink.Active then begin
2663 GridFlags := GridFlags + [gfEditingDone];
2664 if ssCTRL in shift then
2665 FDatalink.DataSet.Last
2666 else begin
2667 DeltaCol := GetLastVisibleColumn;
2668 if DeltaCol>=0 then
2669 MoveNextSelectable(False, DeltaCol, Row);
2670 end;
2671 GridFlags := GridFlags - [gfEditingDone];
2672 ClearSelection(true);
2673 Key:=0;
2674 end;
2675 end;
2676 end;
2677
2678 VK_SPACE:
2679 begin
2680 doOnKeyDown;
2681 if (Key<>0) and ValidDataset then begin
2682 if ColumnEditorStyle(Col, SelectedField) = cbsCheckboxColumn then begin
2683 SwapCheckBox;
2684 Key:=0;
2685 end;
2686 end;
2687 end;
2688
2689 VK_MULTIPLY:
2690 begin
2691 doOnKeyDown;
2692 if (Key<>0) and ValidDataset and (ssCtrl in Shift) then
2693 ToggleSelectedRow;
2694 end;
2695
2696 else
2697 inherited KeyDown(Key, Shift);
2698 end;
2699 {$ifdef dbgGrid}DebugLnExit('%s.KeyDown DONE Key= %d',[ClassName, Key]);{$endif}
2700 end;
2701
2702 procedure TCustomDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
2703 Y: Integer);
2704 var
2705 Gz: TGridZone;
2706 P: TPoint;
2707 aoe: Boolean;
2708 procedure doMouseDown;
2709 begin
2710 if not Focused and not(csNoFocus in ControlStyle) then
2711 SetFocus;
2712 if assigned(OnMouseDown) then
2713 OnMouseDown(Self, Button, Shift, X, Y);
2714 end;
2715 procedure doInherited;
2716 begin
2717 inherited MouseDown(Button, Shift, X, Y);
2718 end;
2719 procedure doMoveBy;
2720 begin
2721 {$ifdef dbgGrid}DebugLnEnter('%s.MouseDown MoveBy INIT', [ClassName]); {$endif}
2722 FDatalink.MoveBy(P.Y - Row);
2723 {$ifdef dbgGrid}DebugLnExit('%s.MouseDown MoveBy DONE', [ClassName]); {$endif}
2724 end;
2725 procedure doMoveToColumn;
2726 begin
2727 {$ifdef dbgGrid}DebugLnEnter('%s.MouseDown MoveToCol INIT Col=%d', [ClassName, P.X]); {$endif}
2728 Col := P.X;
2729 {$ifdef dbgGrid}DebugLnExit('%s.MouseDown MoveToCol DONE', [ClassName]); {$endif}
2730 end;
2731 procedure DoCancel;
2732 begin
2733 {$ifdef dbgGrid}DebugLnEnter('%s.MouseDown Dataset.CANCEL INIT', [ClassName]);{$endif}
2734 if EditorMode then
2735 EditorCancelEditing;
2736 FDatalink.Dataset.cancel;
2737 {$ifdef dbgGrid}DebugLnExit('%s.MouseDown Dataset.CANCEL DONE', [ClassName]);{$endif}
2738 end;
2739 procedure DoAcceptValue;
2740 begin
2741 if EditorMode and FDatalink.FModified then
2742 EditorMode := False;
2743 end;
2744 begin
2745
2746 if (csDesigning in componentState) {or not GCache.ValidGrid }then begin
2747 {$ifdef dbgDBGrid}DebugLn('%s.MouseDown - checkDesigning', [ClassName]);{$endif}
2748 exit;
2749 end;
2750
2751 if UpdatingData then begin
2752 {$ifdef dbgDBGrid}DebugLn('%s.MouseDown - UpdatingData', [ClassName]);{$endif}
2753 exit;
2754 end;
2755
2756 if not MouseButtonAllowed(Button) then begin
2757 {$ifdef dbgDBGrid}DebugLn('%s.MouseDown - no mouse allowed', [ClassName]);{$endif}
2758 doInherited;
2759 exit;
2760 end;
2761
2762 {$ifdef dbgGrid}DebugLnEnter('%s.MouseDown INIT', [ClassName]); {$endif}
2763 Gz:=MouseToGridZone(X,Y);
2764 CacheMouseDown(X,Y);
2765 case Gz of
2766 gzInvalid:
2767 begin
2768 if (cursor=crHSplit) and (dgColumnResize in Options) then begin
2769 // DBGrid normally doesn't allow outbound events and this is one of them
2770 // make GCache.HotGridZone valid for inherited mousedown. Issue #0034032
2771 aoe := AllowOutboundEvents;
2772 AllowOutboundEvents := true;
2773 inherited MouseMove(shift, x, y);
2774 AllowOutBoundEvents := aoe;
2775 doInherited;
2776 end else
2777 doMouseDown;
2778 end;
2779
2780 gzFixedCells, gzFixedCols:
2781 doInherited;
2782 else
2783 begin
2784
2785 if FKeyBookmark<>nil then begin
2786 FDatalink.DataSet.FreeBookmark(FKeyBookmark);
2787 FKeyBookmark:=nil; // force new keyboard selection start
2788 end;
2789
2790 P:=MouseToCell(Point(X,Y));
2791 if Gz=gzFixedRows then
2792 P.X := Col;
2793
2794 if P.Y=Row then begin // The current active row was clicked again.
2795 //doAcceptValue;
2796
2797 if ssCtrl in Shift then begin
2798 doMouseDown;
2799 // Don't unselect the row if Right-click was for PopupMenu.
2800 if (Button<>mbRight) or (PopupMenu=Nil) then
2801 ToggleSelectedRow;
2802 end
2803 else begin
2804 if Button=mbLeft then
2805 ClearSelection(true);
2806 if gz=gzFixedRows then begin
2807 fGridState:=gsRowMoving;
2808 ResetLastMove;
2809 doMouseDown;
2810 end
2811 else
2812 doInherited;
2813 end;
2814
2815 end else begin
2816 doMouseDown;
2817 if ValidDataSet then begin
2818 if InsertCancelable and IsEOF then
2819 doCancel;
2820 doMoveBy;
2821 if IsMouseOverCellButton(X, Y) then
2822 StartPushCell;
2823 end;
2824 if ssCtrl in Shift then
2825 ToggleSelectedRow
2826 else begin
2827 if Button=mbLeft then
2828 ClearSelection(true)
2829 // Select row before popupmenu
2830 else if (Button=mbRight) and Assigned(PopupMenu) and not FSelectedRows.CurrentRowSelected then
2831 ToggleSelectedRow;
2832 doMoveToColumn;
2833 end;
2834 end;
2835 end;
2836 end;
2837 {$ifdef dbgGrid}DebugLnExit('%s.MouseDown DONE', [ClassName]); {$endif}
2838 end;
2839
2840 procedure TCustomDBGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
2841 begin
2842 if (fGridState=gsSelecting) and not Dragging then
2843 exit
2844 else
2845 inherited MouseMove(Shift, X, Y);
2846 end;
2847
2848 procedure TCustomDBGrid.PrepareCanvas(aCol, aRow: Integer;
2849 aState: TGridDrawState);
2850 begin
2851 inherited PrepareCanvas(aCol, aRow, aState);
2852
2853 if gdFixed in aState then begin
2854 if gdHot in aState then
2855 Canvas.Brush.Color := FixedHotColor
2856 else
2857 Canvas.Brush.Color := GetColumnColor(aCol, gdFixed in AState);
2858 end;
2859
2860 if (not FDatalink.Active) and ((gdSelected in aState) or (gdFocused in aState)) then
2861 Canvas.Brush.Color := Self.Color;
2862 end;
2863
2864 procedure TCustomDBGrid.RemoveAutomaticColumns;
2865 begin
2866 if not (csDesigning in ComponentState) then
2867 TDBGridColumns(Columns).RemoveAutoColumns;
2868 end;
2869
2870 procedure TCustomDBGrid.ResetSizes;
2871 begin
2872 LayoutChanged;
2873 inherited ResetSizes;
2874 end;
2875
2876 procedure TCustomDBGrid.SaveGridOptions(Cfg: TXMLConfig);
2877 var
2878 Path: string;
2879 begin
2880 Path:='grid/design/options/';
2881 Cfg.SetValue(Path+'dgEditing/value', dgEditing in Options);
2882 Cfg.SetValue(Path+'dgTitles/value', dgTitles in Options);
2883 Cfg.SetValue(Path+'dgIndicator/value', dgIndicator in Options);
2884 Cfg.SetValue(Path+'dgColumnResize/value', dgColumnResize in Options);
2885 Cfg.SetValue(Path+'dgColumnMove/value', dgColumnMove in Options);
2886 Cfg.SetValue(Path+'dgColLines/value', dgColLines in Options);
2887 Cfg.SetValue(Path+'dgRowLines/value', dgRowLines in Options);
2888 Cfg.SetValue(Path+'dgTabs/value', dgTabs in Options);
2889 Cfg.SetValue(Path+'dgAlwaysShowEditor/value', dgAlwaysShowEditor in Options);
2890 Cfg.SetValue(Path+'dgRowSelect/value', dgRowSelect in Options);
2891 Cfg.SetValue(Path+'dgAlwaysShowSelection/value', dgAlwaysShowSelection in Options);
2892 Cfg.SetValue(Path+'dgConfirmDelete/value', dgConfirmDelete in Options);
2893 Cfg.SetValue(Path+'dgCancelOnExit/value', dgCancelOnExit in Options);
2894 Cfg.SetValue(Path+'dgMultiselect/value', dgMultiselect in Options);
2895 Cfg.SetValue(Path+'dgHeaderHotTracking/value', dgHeaderHotTracking in Options);
2896 Cfg.SetValue(Path+'dgHeaderPushedLook/value', dgHeaderPushedLook in Options);
2897 Cfg.SetValue(Path+'dgPersistentMultiSelect/value', dgPersistentMultiSelect in Options);
2898 cfg.SetValue(Path+'dgAutoSizeColumns/value', dgAutoSizeColumns in Options);
2899 cfg.SetValue(Path+'dgAnyButtonCanSelect/value', dgAnyButtonCanSelect in Options);
2900 Cfg.SetValue(Path+'dgDisableDelete/value', dgDisableDelete in Options);
2901 Cfg.SetValue(Path+'dgDisableInsert/value', dgDisableInsert in Options);
2902 Cfg.SetValue(Path+'dgCellHints/value', dgCellHints in Options);
2903 cfg.SetValue(Path+'dgTruncCellHints/value', dgTruncCellHints in Options);
2904 Cfg.SetValue(Path+'dgCellEllipsis/value', dgCellEllipsis in Options);
2905 Cfg.SetValue(Path+'dgRowHighlight/value', dgRowHighlight in Options);
2906 Cfg.SetValue(Path+'dgThumbTracking/value', dgThumbTracking in Options);
2907 end;
2908
2909 procedure TCustomDBGrid.SelectEditor;
2910 var
2911 aEditor: TWinControl;
2912 aMaxLen: integer;
2913 begin
2914 {$ifdef dbgDBGrid}
2915 DebugLnEnter('%s.SelectEditor INIT Editor=%s',[ClassName, dbgsname(editor)]);
2916 {$endif}
2917 if (FDatalink<>nil) and FDatalink.Active then begin
2918 inherited SelectEditor;
2919
2920 if (SelectedField is TStringField) then
2921 aMaxLen := SelectedField.Size
2922 else
2923 aMaxLen := 0;
2924
2925 if (Editor is TCustomEdit) then
2926 TCustomEdit(Editor).MaxLength := aMaxLen
2927 else
2928 if (Editor is TCompositeCellEditor) then
2929 TCompositeCellEditor(Editor).MaxLength := aMaxLen;
2930
2931 if Assigned(OnSelectEditor) then begin
2932 aEditor:=Editor;
2933 OnSelectEditor(Self, SelectedColumn, aEditor);
2934 Editor:=aEditor;
2935 end;
2936 end else
2937 Editor := nil;
2938 {$ifdef dbgDBGrid}
2939 DebugLnExit('%s.SelectEditor DONE Editor=%s',[ClassName, dbgsname(editor)]);
2940 {$endif}
2941 end;
2942
2943 procedure TCustomDBGrid.SetEditText(ACol, ARow: Longint; const Value: string);
2944 begin
2945 FTempText := Value;
2946 end;
2947
2948 procedure TCustomDBGrid.SetFixedCols(const AValue: Integer);
2949 begin
2950 if (FixedCols=AValue) or (AValue<FirstGridColumn) then
2951 exit;
2952 inherited SetFixedCols(AValue);
2953 end;
2954
SelectCellnull2955 function TCustomDBGrid.SelectCell(aCol, aRow: Integer): boolean;
2956 begin
2957 Result:= (ColWidths[aCol] > 0) and (RowHeights[aRow] > 0);
2958 end;
2959
2960 procedure TCustomDBGrid.BeginLayout;
2961 begin
2962 inc(FLayoutChangedCount);
2963 end;
2964
2965 procedure TCustomDBGrid.EditingColumn(aCol: Integer; Ok: boolean);
2966 begin
2967 {$ifdef dbgDBGrid}DebugLnEnter('%s.EditingColumn INIT aCol=%d Ok=%s',
2968 [ClassName, aCol, BoolToStr(ok, true)]); {$endif}
2969 if Ok then begin
2970 FEditingColumn := aCol;
2971 FDatalink.Modified := True;
2972 end
2973 else
2974 FEditingColumn := -1;
2975 {$ifdef dbgDBGrid} DebugLnExit('%s.EditingColumn DONE', [ClassName]); {$endif}
2976 end;
2977
2978 procedure TCustomDBGrid.EditorCancelEditing;
2979 begin
2980 EditingColumn(FEditingColumn, False); // prevents updating the value
2981 if EditorMode then begin
2982 EditorMode := False;
2983 if dgAlwaysShowEditor in Options then
2984 EditorMode := True;
2985 end;
2986 end;
2987
2988 procedure TCustomDBGrid.EditorDoGetValue;
2989 begin
2990 {$ifdef dbgDBGrid}DebugLnEnter('%s.EditorDoGetValue INIT', [ClassName]);{$endif}
2991 inherited EditordoGetValue;
2992 UpdateData;
2993 {$ifdef dbgDBGrid}DebugLnExit('%s.EditorDoGetValue DONE', [ClassName]);{$endif}
2994 end;
2995
2996 procedure TCustomDBGrid.CellClick(const aCol, aRow: Integer; const Button:TMouseButton);
2997 begin
2998 {$ifdef dbgGrid}DebugLn('%s.CellClick', [ClassName]); {$endif}
2999 if Button<>mbLeft then
3000 exit;
3001
3002 if (aCol>=FirstGridColumn) then begin
3003 if (aRow>=FixedRows) then begin
3004 if IsColumnVisible(aCol) and
3005 (ColumnEditorStyle(ACol, SelectedField) = cbsCheckboxColumn) then begin
3006 // react only if overriden editor is hidden
3007 if (Editor=nil) or not EditorMode then
3008 SwapCheckBox
3009 end;
3010 if Assigned(OnCellClick) then
3011 OnCellClick(TColumn(ColumnFromGridColumn(aCol)));
3012 end else
3013 DoHeaderClick(aCol)
3014 end;
3015 end;
3016
CheckDisplayMemonull3017 function TCustomDBGrid.CheckDisplayMemo(aField: TField): boolean;
3018 begin
3019 // note that this assumes that aField is not nil
3020 result := (aField.DataType=ftMemo) and (dgDisplayMemoText in Options);
3021 end;
3022
3023 procedure TCustomDBGrid.EndLayout;
3024 begin
3025 dec(FLayoutChangedCount);
3026 if FLayoutChangedCount = 0 then
3027 DoLayoutChanged;
3028 end;
3029
GetDefaultColumnAlignmentnull3030 function TCustomDBGrid.GetDefaultColumnAlignment(Column: Integer): TAlignment;
3031 var
3032 F: TField;
3033 begin
3034 F := GetDsFieldFromGridColumn(Column);
3035 if F<>nil then
3036 result := F.Alignment
3037 else
3038 result := taLeftJustify;
3039 end;
3040
GetDefaultColumnWidthnull3041 function TCustomDBGrid.GetDefaultColumnWidth(Column: Integer): Integer;
3042 begin
3043 Result := DefaultFieldColWidth(GetDsFieldFromGridColumn(Column));
3044 end;
3045
GetDefaultColumnReadOnlynull3046 function TCustomDBGrid.GetDefaultColumnReadOnly(Column: Integer): boolean;
3047 var
3048 F: Tfield;
3049 begin
3050 result := true;
3051 if not Self.ReadOnly and (FDataLink.Active and not FDatalink.ReadOnly) then begin
3052 F := GetDsFieldFromGridColumn(Column);
3053 result := (F=nil) or F.ReadOnly;
3054 end;
3055 end;
3056
GetDefaultColumnTitlenull3057 function TCustomDBGrid.GetDefaultColumnTitle(Column: Integer): string;
3058 var
3059 F: Tfield;
3060 begin
3061 F := GetDsFieldFromGridColumn(Column);
3062 if F<>nil then
3063 Result := F.DisplayName
3064 else
3065 Result := '';
3066 end;
3067
TCustomDBGrid.GetDefaultRowHeightnull3068 function TCustomDBGrid.GetDefaultRowHeight: integer;
3069 begin
3070 result := inherited GetDefaultRowHeight;
3071 Dec(Result, 2); // a litle smaller for dbgrid
3072 end;
3073
3074 procedure TCustomDBGrid.DoExit;
3075 begin
3076 {$ifdef dbgDBGrid}DebugLnEnter('%s.DoExit INIT', [ClassName]);{$endif}
3077 if ValidDataSet and (dgCancelOnExit in Options) and
3078 InsertCancelable then
3079 begin
3080 FDataLink.DataSet.Cancel;
3081 EditingColumn(FEditingColumn, False);
3082 end;
3083 inherited DoExit;
3084 {$ifdef dbgDBGrid}DebugLnExit('%s.DoExit DONE', [ClassName]);{$endif}
3085 end;
3086
TCustomDBGrid.DoMouseWheelDownnull3087 function TCustomDBGrid.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint
3088 ): Boolean;
3089 begin
3090 Result := False;
3091 if Assigned(OnMouseWheelDown) then
3092 OnMouseWheelDown(Self, Shift, MousePos, Result);
3093 if not Result and FDatalink.Active then begin
3094 FDatalink.MoveBy(1);
3095 Result := True;
3096 end;
3097 end;
3098
DoMouseWheelUpnull3099 function TCustomDBGrid.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint
3100 ): Boolean;
3101 begin
3102 Result := False;
3103 if Assigned(OnMouseWheelUp) then
3104 OnMouseWheelUp(Self, Shift, MousePos, Result);
3105 if not Result and FDatalink.Active then begin
3106 FDatalink.MoveBy(-1);
3107 Result := True;
3108 end;
3109 end;
3110
GetEditMasknull3111 function TCustomDBGrid.GetEditMask(aCol, aRow: Longint): string;
3112 var
3113 aField: TField;
3114 begin
3115 Result := '';
3116 if FDataLink.Active then begin
3117 aField := GetFieldFromGridColumn(aCol);
3118 if (aField<>nil) then begin
3119 Result := aField.EditMask;
3120 if assigned(OnFieldEditMask) then
3121 OnFieldEditMask(Self, AField, Result);
3122 end;
3123 end;
3124 end;
3125
TCustomDBGrid.GetEditTextnull3126 function TCustomDBGrid.GetEditText(aCol, aRow: Longint): string;
3127 var
3128 aField: TField;
3129 begin
3130 Result := '';
3131 if FDataLink.Active then begin
3132 aField := GetFieldFromGridColumn(aCol);
3133 if aField<>nil then begin
3134 if CheckDisplayMemo(aField) then
3135 Result := aField.AsString
3136 else
3137 Result := aField.Text;
3138 end;
3139 end;
3140 end;
3141
TCustomDBGrid.GetIsCellSelectednull3142 function TCustomDBGrid.GetIsCellSelected(aCol, aRow: Integer): boolean;
3143 begin
3144 Result:=inherited GetIsCellSelected(aCol, aRow) or
3145 FDrawingMultiSelRecord;
3146 end;
3147
GetIsCellTitlenull3148 function TCustomDBGrid.GetIsCellTitle(aCol, aRow: Integer): boolean;
3149 begin
3150 result := (FixedRows>0) and (aRow=0);
3151 if result and Columns.Enabled then
3152 result := (aCol>=FirstGridColumn);
3153 end;
3154
3155 procedure TCustomDBGrid.GetSelectedState(AState: TGridDrawState; out
3156 IsSelected: boolean);
3157 begin
3158 inherited GetSelectedState(AState, IsSelected);
3159 if IsSelected and not Self.Focused and not(dgAlwaysShowSelection in Options) then
3160 IsSelected := false;
3161 end;
3162
GetSmoothScrollnull3163 function TCustomDBGrid.GetSmoothScroll(Which: Integer): Boolean;
3164 begin
3165 if Which=SB_Vert then
3166 Result := False
3167 else
3168 Result := inherited GetSmoothScroll(Which);
3169 end;
3170
TCustomDBGrid.GridCanModifynull3171 function TCustomDBGrid.GridCanModify: boolean;
3172 begin
3173 result := not ReadOnly and (dgEditing in Options) and not FDataLink.ReadOnly
3174 and FDataLink.Active and FDatalink.DataSet.CanModify;
3175 end;
3176
3177 procedure TCustomDBGrid.GetSBVisibility(out HsbVisible, VsbVisible: boolean);
3178 var
3179 aRange,aPage,aPos: Integer;
3180 begin
3181 inherited GetSBVisibility(HsbVisible, VsbVisible);
3182 VSbVisible := (ScrollBars in [ssVertical, ssBoth]);
3183 if not VSbVisible and ScrollBarAutomatic(ssVertical) then begin
3184 GetScrollbarParams(aRange,aPage, aPos);
3185 if ARange>aPage then
3186 VSbVisible:=True;
3187 end;
3188 end;
3189
3190 procedure TCustomDBGrid.GetSBRanges(const HsbVisible, VsbVisible: boolean; out
3191 HsbRange, VsbRange, HsbPage, VsbPage, HsbPos, VsbPos: Integer);
3192 begin
3193 inherited GetSBRanges(HsbVisible, VsbVisible, HsbRange, VsbRange, HsbPage, VsbPage, HsbPos, VsbPos);
3194 if VSbVisible then
3195 GetScrollbarParams(VsbRange, VsbPage, VsbPos)
3196 else begin
3197 VsbRange := 0;
3198 VsbPage := 0;
3199 VsbPos := 0;
3200 end;
3201 end;
3202
3203 procedure TCustomDBGrid.MoveSelection;
3204 begin
3205 {$ifdef dbgDBGrid}DebugLnEnter('%s.MoveSelection INIT', [ClassName]);{$endif}
3206 inherited MoveSelection;
3207 if FColEnterPending and Assigned(OnColEnter) then begin
3208 OnColEnter(Self);
3209 end;
3210 FColEnterPending:=False;
3211 UpdateActive;
3212 {$ifdef dbgDBGrid}DebugLnExit('%s.MoveSelection DONE', [ClassName]);{$endif}
3213 end;
3214
MouseButtonAllowednull3215 function TCustomDBGrid.MouseButtonAllowed(Button: TMouseButton): boolean;
3216 begin
3217 Result:= FDataLink.Active and ((Button=mbLeft) or (dgAnyButtonCanSelect in Options));
3218 end;
3219
3220 procedure TCustomDBGrid.DrawAllRows;
3221 var
3222 CurActiveRecord: Integer;
3223 begin
3224 if FDataLink.Active then begin
3225 {$ifdef dbgGridPaint}
3226 DebugLnEnter('%s DrawAllRows INIT Link.ActiveRecord=%d, Row=%d',[Name, FDataLink.ActiveRecord, Row]);
3227 {$endif}
3228 CurActiveRecord:=FDataLink.ActiveRecord;
3229 FDrawingEmptyDataset:=FDatalink.DataSet.IsEmpty;
3230 end else
3231 FDrawingEmptyDataset:=True;
3232 try
3233 inherited DrawAllRows;
3234 finally
3235 if FDataLink.Active then begin
3236 FDataLink.ActiveRecord:=CurActiveRecord;
3237 {$ifdef dbgGridPaint}
3238 DebugLnExit('%s DrawAllRows DONE Link.ActiveRecord=%d, Row=%d',[Name, FDataLink.ActiveRecord, Row]);
3239 {$endif}
3240 end;
3241 end;
3242 end;
3243
3244 procedure TCustomDBGrid.DrawFocusRect(aCol, aRow: Integer; ARect: TRect);
3245 begin
3246 // Draw focused cell if we have the focus
3247 if Self.Focused and (dgAlwaysShowSelection in Options) and
3248 FDatalink.Active and DefaultDrawing then
3249 begin
3250 CalcFocusRect(aRect);
3251 DrawRubberRect(Canvas, aRect, FocusColor);
3252 end;
3253 end;
3254
3255 //
3256 procedure TCustomDBGrid.DrawRow(ARow: Integer);
3257 begin
3258 if (ARow>=FixedRows) and FDataLink.Active then begin
3259 //if (Arow>=FixedRows) and FCanBrowse then
3260 FDataLink.ActiveRecord:=ARow-FixedRows;
3261 FDrawingActiveRecord := ARow = Row;
3262 FDrawingMultiSelRecord := (dgMultiSelect in Options) and
3263 SelectedRows.CurrentRowSelected
3264 end else begin
3265 FDrawingActiveRecord := False;
3266 FDrawingMultiSelRecord := False;
3267 end;
3268 {$ifdef dbgGridPaint}
3269 DbgOut('DrawRow Row=', IntToStr(ARow), ' Act=', dbgs(FDrawingActiveRecord));
3270 {$endif}
3271 inherited DrawRow(ARow);
3272 {$ifdef dbgGridPaint}
3273 DebugLn('End Row')
3274 {$endif}
3275 end;
3276
3277 procedure TCustomDBGrid.DrawCell(aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState);
3278 var
3279 DataCol: Integer;
3280 begin
3281 PrepareCanvas(aCol, aRow, aState);
3282
3283 {$ifdef dbgGridPaint}
3284 DbgOut(' ',IntToStr(aCol));
3285 if gdSelected in aState then DbgOut('S');
3286 if gdFocused in aState then DbgOut('*');
3287 if gdFixed in aState then DbgOut('F');
3288 {$endif dbgGridPaint}
3289
3290 if (gdFixed in aState) or DefaultDrawing then
3291 DefaultDrawCell(aCol, aRow, aRect, aState)
3292 else
3293 if not DefaultDrawing then
3294 DrawCellBackground(aCol, aRow, aRect, aState);
3295
3296 if not (csDesigning in ComponentState) then
3297 begin
3298 if (ARow>=FixedRows) and Assigned(OnDrawColumnCell) then begin
3299 DataCol := ColumnIndexFromGridColumn(aCol);
3300 if DataCol>=0 then
3301 OnDrawColumnCell(Self, aRect, DataCol, TColumn(Columns[DataCol]), aState);
3302 end;
3303 if (ARow<FixedRows) and Assigned(OnDrawColumnTitle) then begin
3304 DataCol := ColumnIndexFromGridColumn(aCol);
3305 if DataCol>=0 then
3306 OnDrawColumnTitle(Self, aRect, DataCol, TColumn(Columns[DataCol]), aState);
3307 end;
3308 end;
3309
3310 DrawCellGrid(aCol, aRow, aRect, aState);
3311 end;
3312
3313 procedure TCustomDBGrid.DrawCellBackground(aCol, aRow: Integer; aRect: TRect;
3314 aState: TGridDrawState);
3315 begin
3316 // background
3317 if (gdFixed in aState) and (TitleStyle=tsNative) then
3318 DrawThemedCell(aCol, aRow, aRect, aState)
3319 else
3320 Canvas.FillRect(aRect);
3321 end;
3322
3323 procedure TCustomDBGrid.DrawCheckboxBitmaps(aCol: Integer; aRect: TRect;
3324 F: TField);
3325 var
3326 AState: TCheckboxState;
3327 begin
3328 if (aCol=Col) and FDrawingActiveRecord then begin
3329 // show checkbox only if overriden editor is hidden
3330 if EditorMode then
3331 exit;
3332 end;
3333
3334 // by SSY
3335 if (F<>nil) then
3336 if F.DataType=ftBoolean then
3337 if F.IsNull then
3338 AState := cbGrayed
3339 else
3340 if F.AsBoolean then
3341 AState := cbChecked
3342 else
3343 AState := cbUnChecked
3344 else
3345 if F.AsString=ColumnFromGridColumn(aCol).ValueChecked then
3346 AState := cbChecked
3347 else
3348
3349 if F.AsString=ColumnFromGridColumn(aCol).ValueUnChecked then
3350 AState := cbUnChecked
3351 else
3352 AState := cbGrayed
3353 else
3354 AState := cbGrayed;
3355
3356 if assigned(OnUserCheckboxState) then
3357 OnUserCheckboxState(Self, TColumn(ColumnFromGridColumn(aCol)), AState);
3358
3359 DrawGridCheckboxBitmaps(aCol, Row{dummy}, ARect, AState);
3360 end;
3361
3362 procedure TCustomDBGrid.DrawFixedText(aCol, aRow: Integer; aRect: TRect;
3363 aState: TGridDrawState);
3364
GetDatasetStatenull3365 function GetDatasetState: TDataSetState;
3366 begin
3367 if FDatalink.Active then
3368 result := FDataLink.DataSet.State
3369 else
3370 result := dsInactive;
3371 end;
3372
3373 begin
3374 if (ACol=0) and (dgIndicator in Options) and FDrawingActiveRecord then begin
3375 DrawIndicator(Canvas, aRect, GetDataSetState, FDrawingMultiSelRecord);
3376 {$ifdef dbgGridPaint}
3377 dbgOut('>');
3378 {$endif}
3379 end else
3380 if (ACol=0) and (dgIndicator in Options) and FDrawingMultiSelRecord then
3381 DrawIndicator(Canvas, aRect, dsCurValue{dummy}, True)
3382 else
3383 DrawColumnText(aCol, aRow, aRect, aState);
3384 end;
3385
3386 procedure TCustomDBGrid.DrawColumnText(aCol, aRow: Integer; aRect: TRect;
3387 aState: TGridDrawState);
3388 var
3389 F: TField;
3390 s: String;
3391 begin
3392 if GetIsCellTitle(aCol, aRow) then
3393 inherited DrawColumnText(aCol, aRow, aRect, aState)
3394 else begin
3395 F := GetFieldFromGridColumn(aCol);
3396 if F<>nil then begin
3397 if CheckDisplayMemo(F) then
3398 s := F.AsString
3399 else
3400 s := F.DisplayText;
3401 DrawCellText(aCol, aRow, aRect, aState, s)
3402 end;
3403 end;
3404 end;
3405
3406 procedure TCustomDBGrid.DrawIndicator(ACanvas: TCanvas; R: TRect;
3407 Opt: TDataSetState; MultiSel: boolean);
3408 var
3409 dx, dy, x, y: Integer;
3410
3411 procedure CenterY;
3412 begin
3413 y := R.Top + (R.Bottom-R.Top) div 2;
3414 end;
3415
3416 procedure CenterX;
3417 begin
3418 X := R.Left + (R.Right-R.Left) div 2;
3419 end;
3420
3421 procedure DrawEdit(clr: Tcolor);
3422 begin
3423 ACanvas.Pen.Color := clr;
3424 CenterY;
3425 CenterX;
3426 ACanvas.MoveTo(X-2, Y-Dy);
3427 ACanvas.LineTo(X+3, Y-Dy);
3428 ACanvas.MoveTo(X, Y-Dy);
3429 ACanvas.LineTo(X, Y+Dy);
3430 ACanvas.MoveTo(X-2, Y+Dy);
3431 ACanvas.LineTo(X+3, Y+Dy);
3432 end;
3433
3434 begin
3435 dx := 6;
3436 dy := 6;
3437 x := 0;
3438 y := 0;
3439 case Opt of
3440 dsBrowse:
3441 begin //
3442 ACanvas.Brush.Color:=clBlack;
3443 ACanvas.Pen.Color:=clBlack;
3444 CenterY;
3445 x:= R.Left+3;
3446 if MultiSel then begin
3447 if BiDiMode = bdRightToLeft then begin
3448 ACanvas.Polyline([point(x+dx,y-dy), point(x,y),point(x+dx,y+dy), point(x+dx,y+dy-1)]);
3449 ACanvas.Polyline([point(x+dx,y-dy+1), point(x+1,y),point(x+dx,y+dy-1), point(x+dx,y+dy-2)]);
3450 CenterX;
3451 Dec(X,3);
3452 ACanvas.Ellipse(Rect(X+dx-2,Y-2,X+dx+2,Y+2));
3453 end else begin
3454 ACanvas.Polyline([point(x,y-dy), point(x+dx,y),point(x,y+dy), point(x,y+dy-1)]);
3455 ACanvas.Polyline([point(x,y-dy+1),point(x+dx-1,y),point(x, y+dy-1), point(x,y+dy-2)]);
3456 CenterX;
3457 Dec(X,3);
3458 ACanvas.Ellipse(Rect(X-2,Y-2,X+2,Y+2));
3459 end;
3460 end else begin
3461 if BiDiMode = bdRightToLeft then
3462 ACanvas.Polygon([point(x,y),point(x+dx,y-dy),point(x+dx, y+dy),point(x,y)])
3463 else
3464 ACanvas.Polygon([point(x,y-dy),point(x+dx,y),point(x, y+dy),point(x,y-dy)]);
3465 end;
3466 end;
3467 dsEdit:
3468 DrawEdit(clBlack);
3469 dsInsert:
3470 DrawEdit(clGreen);
3471 else
3472 if MultiSel then begin
3473 ACanvas.Brush.Color:=clBlack;
3474 ACanvas.Pen.Color:=clBlack;
3475 CenterX;
3476 CenterY;
3477 ACanvas.Ellipse(Rect(X-3,Y-3,X+3,Y+3));
3478 end;
3479 end;
3480 end;
3481
TCustomDBGrid.EditorCanAcceptKeynull3482 function TCustomDBGrid.EditorCanAcceptKey(const ch: TUTF8Char): boolean;
3483 var
3484 aField: TField;
3485 begin
3486 result := False;
3487 if FDataLink.Active then begin
3488 aField := SelectedField;
3489 if aField<>nil then begin
3490 Result := IsValidChar(AField, Ch) and not aField.Calculated and
3491 (aField.DataType<>ftAutoInc) and (aField.FieldKind<>fkLookup) and
3492 (not aField.IsBlob or CheckDisplayMemo(aField));
3493 end;
3494 end;
3495 end;
3496
TCustomDBGrid.EditorIsReadOnlynull3497 function TCustomDBGrid.EditorIsReadOnly: boolean;
3498 var
3499 AField : TField;
3500 FieldList: TList;
3501 I: Integer;
3502 begin
3503 Result := inherited EditorIsReadOnly;
3504 if not Result then begin
3505
3506 AField := GetFieldFromGridColumn(Col);
3507 if assigned(AField) then begin
3508
3509 // if field can't be modified, it's assumed readonly
3510 result := not AField.CanModify;
3511
3512 // if field is readonly, check if it's a lookup field
3513 if result and (AField.FieldKind = fkLookup) then begin
3514 FieldList := TList.Create;
3515 try
3516 AField.DataSet.GetFieldList(FieldList, AField.KeyFields);
3517 // check if any keyfields are there
3518 result := (FieldList.Count=0); // if not simply is still readonly
3519 // if yes assumed keyfields are modifiable
3520 for I := 0 to FieldList.Count-1 do
3521 if not TField(FieldList[I]).CanModify then begin
3522 result := true; // at least one keyfield is readonly
3523 break;
3524 end;
3525 finally
3526 FieldList.Free;
3527 end;
3528 end;
3529
3530 // if it's not readonly and is not already editing, start editing.
3531 if not result and not FDatalink.Editing then begin
3532 Include(FGridStatus, gsStartEditing);
3533 Result := not FDataLink.Edit;
3534 Exclude(FGridStatus, gsStartEditing);
3535 end;
3536
3537 end
3538 else
3539 result := true; // field is nil so it's readonly
3540
3541 end;
3542 end;
3543
3544 procedure TCustomDBGrid.EditorTextChanged(const aCol, aRow: Integer;
3545 const aText: string);
3546 var
3547 isReadOnly: Boolean;
3548 begin
3549 isReadOnly := EditorIsReadonly;
3550 if not isReadOnly then
3551 SetEditText(aCol, aRow, aText);
3552 EditingColumn(Col, not isReadOnly);
3553 end;
3554
3555 procedure TCustomDBGrid.HeaderSized(IsColumn: Boolean; Index: Integer);
3556 var
3557 i: Integer;
3558 begin
3559 if IsColumn then begin
3560 if Columns.Enabled then begin
3561 i := ColumnIndexFromGridColumn(Index);
3562 if i>=0 then
3563 Columns[i].Width := ColWidths[Index];
3564 end;
3565 FDefaultColWidths := False;
3566 if Assigned(OnColumnSized) then
3567 OnColumnSized(Self);
3568 end;
3569 end;
3570
IsColumnVisiblenull3571 function TCustomDBGrid.IsColumnVisible(aCol: Integer): boolean;
3572 var
3573 gridcol: TGridColumn;
3574 begin
3575 if Columns.Enabled then begin
3576 gridcol := ColumnFromGridColumn(aCol);
3577 result := (gridcol<>nil) and gridCol.Visible;
3578 end else
3579 result := (aCol>=FirstGridColumn) and (ColWidths[aCol]>0);
3580 end;
3581
IsValidCharnull3582 function TCustomDBGrid.IsValidChar(AField: TField; AChar: TUTF8Char): boolean;
3583 begin
3584 result := False;
3585
3586 if Length(AChar)>1 then begin
3587 // problem: AField should validate a unicode char, but AField has no
3588 // such facility, ask the user, if user is not interested
3589 // do ansi convertion and try with field.
3590
3591 { TODO: is this really necessary?
3592 if Assigned(FOnValidateUTF8Char) then begin
3593 result := true;
3594 OnValidateUT8Char(Self, AField, AChar, Result)
3595 exit;
3596 end else
3597 }
3598 AChar := UTF8ToSys(AChar);
3599 end else
3600 if Length(AChar)=0 then
3601 exit;
3602
3603 Result := (AChar[1]=#8) or AField.IsValidChar(AChar[1])
3604 end;
3605
3606 procedure TCustomDBGrid.UpdateActive;
3607 var
3608 PrevRow: Integer;
3609 NewRow: Integer;
3610 begin
3611 if (csDestroying in ComponentState) or
3612 (FDatalink=nil) or (not FDatalink.Active) or
3613 (FDatalink.ActiveRecord<0) then
3614 exit;
3615 {$ifdef dbgDBGrid}
3616 DebugLn('%s.UpdateActive (%s): ActiveRecord=%d FixedRows=%d Row=%d',
3617 [ClassName, Name, FDataLink.ActiveRecord, FixedRows, Row]);
3618 {$endif}
3619 PrevRow := Row;
3620 NewRow:= FixedRows + FDataLink.ActiveRecord;
3621 if NewRow>RowCount-1 then
3622 NewRow := RowCount-1;
3623 Row := NewRow;
3624 if PrevRow<>Row then
3625 InvalidateCell(0, PrevRow);//(InvalidateRow(PrevRow);
3626 InvalidateRow(Row);
3627 end;
3628
UpdateGridCountsnull3629 function TCustomDBGrid.UpdateGridCounts: Integer;
3630 var
3631 RecCount: Integer;
3632 FRCount, FCCount: Integer;
3633 begin
3634 // find out the column count, if result=0 then
3635 // there are no visible columns defined or dataset is inactive
3636 // or there are no visible fields, ie the grid is blank
3637 {$ifdef dbgDBGrid}DebugLnEnter('%s.UpdateGridCounts INIT', [ClassName]);{$endif}
3638 BeginUpdate;
3639 try
3640 Result := GetColumnCount;
3641 if Result > 0 then begin
3642 if dgTitles in Options then FRCount := 1 else FRCount := 0;
3643 if dgIndicator in Options then FCCount := 1 else FCCount := 0;
3644 InternalSetColCount(Result + FCCount);
3645 if FDataLink.Active then begin
3646 UpdateBufferCount;
3647 RecCount := FDataLink.RecordCount;
3648 if RecCount<1 then
3649 RecCount := 1;
3650 end else begin
3651 RecCount := 0;
3652 if FRCount=0 then
3653 // need to be large enough to hold indicator
3654 // if there is one, and if there are no titles
3655 RecCount := FCCount;
3656 end;
3657 Inc(RecCount, FRCount);
3658 RowCount := RecCount;
3659 FixedRows := FRCount;
3660 UpdateGridColumnSizes;
3661 if FDatalink.Active and (FDatalink.ActiveRecord>=0) then
3662 AdjustEditorBounds(Col, FixedRows + FDatalink.ActiveRecord);
3663 end;
3664 finally
3665 EndUpdate;
3666 end;
3667 {$ifdef dbgDBGrid}DebugLnExit('%s.UpdateGridCounts DONE', [ClassName]);{$endif}
3668 end;
3669
3670 constructor TCustomDBGrid.Create(AOwner: TComponent);
3671 begin
3672 FEditingColumn:=-1;
3673 DragDx:=5;
3674 inherited Create(AOwner);
3675
3676 FDataLink := TComponentDataLink.Create;//(Self);
3677 FDataLink.OnRecordChanged:=@OnRecordChanged;
3678 FDataLink.OnDatasetChanged:=@OnDataSetChanged;
3679 FDataLink.OnDataSetOpen:=@OnDataSetOpen;
3680 FDataLink.OnDataSetClose:=@OnDataSetClose;
3681 FDataLink.OnNewDataSet:=@OnNewDataSet;
3682 FDataLink.OnInvalidDataSet:=@OnInvalidDataset;
3683 FDataLink.OnInvalidDataSource:=@OnInvalidDataSource;
3684 FDataLink.OnDataSetScrolled:=@OnDataSetScrolled;
3685 FDataLink.OnLayoutChanged:=@OnLayoutChanged;
3686 FDataLink.OnEditingChanged:=@OnEditingChanged;
3687 FDataLink.OnUpdateData:=@OnUpdateData;
3688 FDatalink.OnFocusControl := @OnFocusControl;
3689 FDataLink.VisualControl:= True;
3690
3691 FSelectedRows := TBookmarkList.Create(Self);
3692
3693 RenewColWidths;
3694
3695 FOptions := [dgColumnResize, dgColumnMove, dgTitles, dgIndicator, dgRowLines,
3696 dgColLines, dgConfirmDelete, dgCancelOnExit, dgTabs, dgEditing,
3697 dgAlwaysShowSelection];
3698
3699 inherited Options :=
3700 [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
3701 goSmoothScroll, goColMoving, goTabs, goEditing, goDrawFocusSelected,
3702 goColSizing ];
3703
3704 FExtraOptions := [dgeAutoColumns, dgeCheckboxColumn];
3705
3706 AutoAdvance := aaRightDown;
3707
3708 // What a dilema!, we need ssAutoHorizontal and ssVertical!!!
3709 ScrollBars:=ssBoth;
3710 AllowOutboundEvents := false;
3711 end;
3712
3713 procedure TCustomDBGrid.AutoAdjustColumns;
3714 begin
3715 Exclude(FGridStatus, gsAutoSized);
3716 UpdateAutoSizeColumns;
3717 end;
3718
3719 procedure TCustomDBGrid.InitiateAction;
3720 begin
3721 {$ifdef dbgDBGrid}DebugLnEnter('%s.InitiateAction INIT', [ClassName]);{$endif}
3722 inherited InitiateAction;
3723 if (gsUpdatingData in FGridStatus) then begin
3724 EndUpdating;
3725 {
3726 if EditorMode then begin
3727 Editor.SetFocus;
3728 EditorSelectAll;
3729 end;
3730 }
3731 end;
3732 {$ifdef dbgDBGrid}DebugLnExit('%s.InitiateAction DONE', [ClassName]);{$endif}
3733 end;
3734
3735 procedure TCustomDBGrid.DefaultDrawColumnCell(const Rect: TRect;
3736 DataCol: Integer; Column: TColumn; State: TGridDrawState);
3737 var
3738 S: string;
3739 F: TField;
3740 DataRow: Integer;
3741 begin
3742 F := Column.Field;
3743
3744 DataCol := GridColumnFromColumnIndex(DataCol);
3745 if FDataLink.Active then
3746 DataRow := FixedRows + FDataLink.ActiveRecord
3747 else
3748 DataRow := 0;
3749
3750 if DataCol>=FirstGridColumn then
3751 case ColumnEditorStyle(DataCol, F) of
3752
3753 cbsCheckBoxColumn:
3754 DrawCheckBoxBitmaps(DataCol, Rect, F);
3755
3756 else begin
3757 if F<>nil then begin
3758 if CheckDisplayMemo(F) then
3759 S := F.AsString
3760 else
3761 if F.dataType <> ftBlob then
3762 S := F.DisplayText
3763 else
3764 S := '(blob)';
3765 end else
3766 S := '';
3767 DrawCellText(DataCol, DataRow, Rect, State, S);
3768 end;
3769
3770 end;
3771 end;
3772
EditorByStylenull3773 function TCustomDBGrid.EditorByStyle(Style: TColumnButtonStyle): TWinControl;
3774 begin
3775 // we want override the editor style if it is cbsAuto because
3776 // field.datatype might be ftBoolean or some other cases
3777 if Style=cbsAuto then
3778 Style := ColumnEditorStyle(Col, SelectedField);
3779
3780 Result:=inherited EditorByStyle(Style);
3781 end;
3782
3783 procedure TCustomDBGrid.ResetColWidths;
3784 begin
3785 if not FDefaultColWidths then begin
3786 RenewColWidths;
3787 LayoutChanged;
3788 end;
3789 end;
3790
3791 procedure TCustomDBGrid.SelectRecord(AValue: boolean);
3792 begin
3793 {$ifdef dbgGrid}DebugLn('%s.SelectRecord', [ClassName]); {$endif}
3794 if dgMultiSelect in Options then
3795 FSelectedRows.CurrentRowSelected := AValue;
3796 end;
3797
3798 procedure TCustomDBGrid.GetScrollbarParams(out aRange, aPage, aPos: Integer);
3799 begin
3800 if (FDatalink<>nil) and FDatalink.Active then begin
3801 if FDatalink.dataset.IsSequenced then begin
3802 aRange := GetRecordCount + VisibleRowCount - 1;
3803 aPage := VisibleRowCount;
3804 if aPage<1 then aPage := 1;
3805 if FDatalink.BOF then aPos := 0 else
3806 if FDatalink.EOF then aPos := aRange
3807 else
3808 begin
3809 aPos := FDataLink.DataSet.RecNo - 1; // RecNo is 1 based
3810 FDataLink.DataSet.UpdateCursorPos; // FPC 3 bug #31532 workaround
3811 end;
3812 if aPos<0 then aPos:=0;
3813 if aRange=0 then aRange:=1; // there's always 1 (new) row
3814 end else begin
3815 aRange := 6;
3816 aPage := 2;
3817 if FDatalink.EOF then aPos := 4 else
3818 if FDatalink.BOF then aPos := 0
3819 else aPos := 2;
3820 end;
3821 end else begin
3822 aRange := 0;
3823 aPage := 0;
3824 aPos := 0;
3825 end;
3826 end;
3827
3828 procedure TCustomDBGrid.CMGetDataLink(var Message: TLMessage);
3829 begin
3830 Message.Result := PtrUInt(FDataLink);
3831 end;
3832
3833 procedure TCustomDBGrid.ClearSelection(selCurrent:boolean=false);
3834 begin
3835 if [dgMultiSelect,dgPersistentMultiSelect]*Options=[dgMultiSelect] then begin
3836 if SelectedRows.Count>0 then
3837 SelectedRows.Clear;
3838 if SelCurrent then
3839 SelectRecord(true);
3840 end;
3841 if FKeyBookmark<>nil then begin
3842 FDatalink.DataSet.FreeBookmark(FKeyBookmark);
3843 FKeyBookmark:=nil;
3844 end;
3845 end;
3846
TCustomDBGrid.NeedAutoSizeColumnsnull3847 function TCustomDBGrid.NeedAutoSizeColumns: boolean;
3848 begin
3849 result := (dgAutoSizeColumns in Options)
3850 //and (HandleAllocated)
3851 ;
3852 end;
3853
3854 procedure TCustomDBGrid.RenewColWidths;
3855 begin
3856 FDefaultColWidths := True;
3857 exclude(FGridStatus, gsAutoSized);
3858 end;
3859
3860 procedure TCustomDBGrid.InternalAutoSizeColumn(aCol: Integer; aCanvas: TCanvas; aDatalinkActive: Boolean);
3861 var
3862 Field: TField;
3863 C: TGridColumn;
3864 ColWidth: Integer;
3865 ARow,w: Integer;
3866 s: string;
3867
3868 begin
3869 Field := GetFieldFromGridColumn(ACol);
3870 C := ColumnFromGridColumn(ACol);
3871
3872 if (C<>nil) and (C.Title<>nil) then begin
3873 aCanvas.Font := C.Title.Font;
3874 ColWidth := aCanvas.TextWidth(trim(C.Title.Caption));
3875 aCanvas.Font := C.Font;
3876 end else begin
3877 if (Field<>nil) then begin
3878 aCanvas.Font := TitleFont;
3879 ColWidth := aCanvas.TextWidth(Field.FieldName);
3880 end
3881 else
3882 ColWidth := 0;
3883 aCanvas.Font := Font;
3884 end;
3885
3886 if (Field<>nil) and aDatalinkActive then
3887 for ARow := FixedRows to RowCount-1 do begin
3888
3889 FDatalink.ActiveRecord := ARow - FixedRows;
3890
3891 if Field.dataType<>ftBlob then
3892 s := trim(Field.DisplayText)
3893 else
3894 s := '(blob)';
3895 w := aCanvas.TextWidth(s);
3896 if w>ColWidth then
3897 ColWidth := w;
3898
3899 end;
3900
3901 if ColWidth=0 then
3902 ColWidth := GetColumnWidth(ACol);
3903
3904 ColWidths[ACol] := ColWidth + 15;
3905 end;
3906
3907 destructor TCustomDBGrid.Destroy;
3908 begin
3909 {$ifdef dbgGrid}DebugLn('%s.Destroy', [ClassName]); {$endif}
3910 FSelectedRows.Free;
3911 FDataLink.OnDataSetChanged:=nil;
3912 FDataLink.OnRecordChanged:=nil;
3913 FDataLink.Free;
3914 inherited Destroy;
3915 end;
3916
TCustomDBGrid.MouseToRecordOffsetnull3917 function TCustomDBGrid.MouseToRecordOffset(const x, y: Integer; out
3918 Column: TColumn; out RecordOffset: Integer): TGridZone;
3919 var
3920 aCol,aRow: Integer;
3921 begin
3922 Result := MouseToGridZone(x, y);
3923
3924 Column := nil;
3925 RecordOffset := 0;
3926
3927 if (Result=gzInvalid) or (Result=gzFixedCells) then
3928 exit;
3929
3930 MouseToCell(x, y, aCol, aRow);
3931
3932 if (Result=gzFixedRows) or (Result=gzNormal) then
3933 RecordOffset := aRow - Row;
3934
3935 if (Result=gzFixedCols) or (Result=gzNormal) then begin
3936 aRow := ColumnIndexFromGridColumn(aCol);
3937 if aRow>=0 then
3938 Column := Columns[aRow];
3939 end;
3940 end;
3941
TCustomDBGrid.ExecuteActionnull3942 function TCustomDBGrid.ExecuteAction(AAction: TBasicAction): Boolean;
3943 begin
3944 Result := (DataLink <> nil)
3945 and DataLink.ExecuteAction(AAction);
3946 end;
3947
UpdateActionnull3948 function TCustomDBGrid.UpdateAction(AAction: TBasicAction): Boolean;
3949 begin
3950 Result := (DataLink <> nil)
3951 and DataLink.UpdateAction(AAction);
3952 end;
3953
3954 procedure TCustomDBGrid.SaveToFile(FileName: string);
3955 begin
3956 SaveOptions:=[ soDesign ];
3957 inherited SaveToFile(Filename);
3958 end;
3959
3960 procedure TCustomDBGrid.SaveToStream(AStream: TStream);
3961 begin
3962 SaveOptions:=[ soDesign ];
3963 inherited SaveToStream(AStream);
3964 end;
3965
3966 procedure TCustomDBGrid.LoadFromFile(FileName: string);
3967 begin
3968 SaveOptions:=[ soDesign ];
3969 Include(FGridStatus, gsLoadingGrid);
3970 inherited LoadFromFile(Filename);
3971 Exclude(FGridStatus, gsLoadingGrid);
3972 end;
3973
3974 procedure TCustomDBGrid.LoadFromStream(AStream: TStream);
3975 begin
3976 SaveOptions:=[ soDesign ];
3977 Include(FGridStatus, gsLoadingGrid);
3978 inherited LoadFromStream(AStream);
3979 Exclude(FGridStatus, gsLoadingGrid);
3980 end;
3981
3982 { TComponentDataLink }
3983
GetFieldsnull3984 function TComponentDataLink.GetFields(Index: Integer): TField;
3985 begin
3986 {$ifdef dbgGrid}DebugLn('%s.GetFields Index=%d',[ClassName, Index]); {$endif}
3987 if (index>=0) and (index<DataSet.FieldCount) then
3988 result:=DataSet.Fields[index]
3989 else
3990 result:=nil;
3991 end;
3992
TComponentDataLink.GetDataSetNamenull3993 function TComponentDataLink.GetDataSetName: string;
3994 begin
3995 {$ifdef dbgDBGrid}
3996 DebugLn('%s.GetDataSetName', [ClassName]);
3997 {$endif}
3998 Result:=FDataSetName;
3999 if DataSet<>nil then Result:=DataSet.Name;
4000 end;
4001
4002 procedure TComponentDataLink.SetDataSetName(const AValue: string);
4003 begin
4004 {$ifdef dbgDBGrid}
4005 DebugLn('%s.SetDataSetName', [ClassName]);
4006 {$endif}
4007 if FDataSetName<>AValue then FDataSetName:=AValue;
4008 end;
4009
4010 procedure TComponentDataLink.RecordChanged(Field: TField);
4011 begin
4012 {$ifdef dbgDBGrid}
4013 DebugLn('%s.RecordChanged', [ClassName]);
4014 {$endif}
4015 if Assigned(OnRecordChanged) then
4016 OnRecordChanged(Field);
4017 end;
4018
4019 procedure TComponentDataLink.DataSetChanged;
4020 begin
4021 {$ifdef dbgDBGrid}
4022 DebugLn('%s.DataSetChanged FirstRecord=%d', [ClassName, FirstRecord]);
4023 {$endif}
4024 if Assigned(OnDataSetChanged) then
4025 OnDataSetChanged(DataSet);
4026 end;
4027
4028 procedure TComponentDataLink.ActiveChanged;
4029 begin
4030 {$ifdef dbgDBGrid}
4031 DebugLnEnter('%s.ActiveChanged INIT', [ClassName]);
4032 {$endif}
4033 if Active then begin
4034 fDataSet := DataSet;
4035 if DataSetName <> fDataSetName then begin
4036 fDataSetName := DataSetName;
4037 if Assigned(fOnNewDataSet) then fOnNewDataSet(DataSet);
4038 end else
4039 if Assigned(fOnDataSetOpen) then fOnDataSetOpen(DataSet);
4040 end else begin
4041 BufferCount := 0;
4042 if (DataSource = nil)then begin
4043 if Assigned(fOnInvalidDataSource) then fOnInvalidDataSource(fDataSet);
4044 fDataSet := nil;
4045 fDataSetName := '[???]';
4046 end else begin
4047 if (DataSet=nil)or(csDestroying in DataSet.ComponentState) then begin
4048 if Assigned(fOnInvalidDataSet) then fOnInvalidDataSet(fDataSet);
4049 fDataSet := nil;
4050 fDataSetName := '[???]';
4051 end else begin
4052 if Assigned(FOnDataSetClose) then begin
4053 FOnDataSetClose(DataSet);
4054 {$ifdef dbgDBGrid} DebugLn('%s.ActiveChanged OnDataSetClose Called', [ClassName]); {$endif}
4055 end;
4056 if DataSet <> nil then FDataSetName := DataSetName;
4057 end;
4058 end;
4059 end;
4060 {$ifdef dbgDBGrid}
4061 DebugLnExit('%s.ActiveChanged DONE', [ClassName]);
4062 {$endif}
4063 end;
4064
4065 procedure TComponentDataLink.LayoutChanged;
4066 begin
4067 {$ifdef dbgDBGrid}
4068 DebugLnEnter('%s.LayoutChanged INIT', [ClassName]);
4069 {$endif}
4070 if Assigned(OnLayoutChanged) then
4071 OnLayoutChanged(DataSet);
4072 {$ifdef dbgDBGrid}
4073 DebugLnExit('%s.LayoutChanged DONE', [ClassName]);
4074 {$endif}
4075 end;
4076
4077 procedure TComponentDataLink.DataSetScrolled(Distance: Integer);
4078 begin
4079 {$ifdef dbgDBGrid}
4080 DebugLn('%s.DataSetScrolled Distance=%d',[ClassName, Distance]);
4081 {$endif}
4082 if Assigned(OnDataSetScrolled) then
4083 OnDataSetScrolled(DataSet, Distance);
4084 end;
4085
4086 procedure TComponentDataLink.FocusControl(Field: TFieldRef);
4087 begin
4088 {$ifdef dbgDBGrid}
4089 DebugLn('%s.FocusControl', [ClassName]);
4090 {$endif}
4091 if Assigned(OnFocusControl) then
4092 OnFocusControl(Field);
4093 end;
4094
4095 procedure TComponentDataLink.CheckBrowseMode;
4096 begin
4097 {$ifdef dbgDBGrid}
4098 DebugLn('%s.CheckBrowseMode', [ClassName]);
4099 {$endif}
4100 inherited CheckBrowseMode;
4101 end;
4102
4103 procedure TComponentDataLink.EditingChanged;
4104 begin
4105 {$ifdef dbgDBGrid}
4106 DebugLn('%s.EditingChanged', [ClassName]);
4107 {$endif}
4108 if Assigned(OnEditingChanged) then
4109 OnEditingChanged(DataSet);
4110 end;
4111
4112 procedure TComponentDataLink.UpdateData;
4113 begin
4114 {$ifdef dbgDBGrid}
4115 DebugLn('%s.UpdateData', [ClassName]);
4116 {$endif}
4117 if Assigned(OnUpdatedata) then
4118 OnUpdateData(DataSet);
4119 end;
4120
MoveBynull4121 function TComponentDataLink.MoveBy(Distance: Integer): Integer;
4122 begin
4123 (*
4124 {$ifdef dbgDBGrid}
4125 DebugLnEnter('%s.MoveBy INIT Distance=%d',[ClassName, Distance]);
4126 {$endif}
4127 *)
4128 Result:=inherited MoveBy(Distance);
4129 (*
4130 {$ifdef dbgDBGrid}
4131 DebugLnExit('%s.MoveBy DONE Result=%d',[ClassName, Result]);
4132 {$endif}
4133 *)
4134 end;
4135
4136 { TDBGridColumns }
4137
GetColumnnull4138 function TDBGridColumns.GetColumn(Index: Integer): TColumn;
4139 begin
4140 result := TColumn( inherited Items[Index] );
4141 end;
4142
4143 procedure TDBGridColumns.SetColumn(Index: Integer; Value: TColumn);
4144 begin
4145 Items[Index].Assign( Value );
4146 end;
4147
4148 procedure TDBGridColumns.Update(Item: TCollectionItem);
4149 begin
4150 if (Grid<>nil) and not (csLoading in Grid.ComponentState) then
4151 TCustomDBGrid(Grid).LayoutChanged;
4152 end;
4153
TDBGridColumns.ColumnFromFieldnull4154 function TDBGridColumns.ColumnFromField(Field: TField): TColumn;
4155 var
4156 i: Integer;
4157 begin
4158 if Field<>nil then
4159 for i:=0 to Count-1 do begin
4160 result := Items[i];
4161 if (result<>nil)and(result.Field=Field) then
4162 exit;
4163 end;
4164 result:=nil;
4165 end;
4166
HasAutomaticColumnsnull4167 function TDBGridColumns.HasAutomaticColumns: boolean;
4168 var
4169 i: Integer;
4170 begin
4171 Result := False;
4172 for i:=0 to Count-1 do
4173 if Items[i].IsAutomaticColumn then begin
4174 Result := true;
4175 break;
4176 end;
4177 end;
4178
TDBGridColumns.HasDesignColumnsnull4179 function TDBGridColumns.HasDesignColumns: boolean;
4180 var
4181 i: Integer;
4182 begin
4183 Result := False;
4184 for i:=0 to Count-1 do
4185 if Items[i].IsDesignColumn then begin
4186 Result := true;
4187 break;
4188 end;
4189 end;
4190
4191 procedure TDBGridColumns.RemoveAutoColumns;
4192 var
4193 i: Integer;
4194 G: TCustomDBGrid;
4195 begin
4196 if HasAutomaticColumns then begin
4197 G := TCustomDBGrid(Grid);
4198 G.GridStatus := G.GridStatus + [gsRemovingAutoColumns];
4199 BeginUpdate;
4200 try
4201 for i:=Count-1 downto 0 do
4202 if Items[i].IsAutomaticColumn then
4203 Delete(i);
4204 finally
4205 EndUpdate;
4206 G.GridStatus := G.GridStatus - [gsRemovingAutoColumns];
4207 end;
4208 end;
4209 end;
4210
CompareFieldIndexnull4211 function CompareFieldIndex(P1,P2:Pointer): integer;
4212 begin
4213 if P1=P2 then
4214 Result := 0
4215 else if (P1=nil) or (TColumn(P1).Field=nil) then
4216 Result := 1
4217 else if (P2=nil) or (TColumn(P2).Field=nil) then
4218 Result := -1
4219 else
4220 Result := TColumn(P1).Field.Index - TColumn(P2).Field.Index;
4221 end;
4222
CompareDesignIndexnull4223 function CompareDesignIndex(P1,P2:Pointer): integer;
4224 begin
4225 result := TColumn(P1).DesignIndex - TColumn(P2).DesignIndex;
4226 end;
4227
4228 procedure TDBGridColumns.ResetColumnsOrder(ColumnOrder: TColumnOrder);
4229 var
4230 L: TList;
4231 i: Integer;
4232 begin
4233 L := TList.Create;
4234 try
4235
4236 for i:=0 to Count-1 do
4237 L.Add(Items[i]);
4238
4239 case ColumnOrder of
4240 coDesignOrder:
4241 begin
4242 if not HasDesignColumns then
4243 exit;
4244 L.Sort(@CompareDesignIndex)
4245 end;
4246 coFieldIndexOrder:
4247 L.Sort(@CompareFieldIndex);
4248 else
4249 exit;
4250 end;
4251
4252 for i:=0 to L.Count-1 do
4253 TColumn(L.Items[i]).Index := i;
4254
4255 finally
4256 L.Free;
4257 end;
4258 end;
4259
Addnull4260 function TDBGridColumns.Add: TColumn;
4261 var
4262 G: TCustomDBGrid;
4263 begin
4264 {$ifdef dbgDBGrid}
4265 DebugLn('%s.Add', [ClassName]);
4266 {$endif}
4267 G := TCustomDBGrid(Grid);
4268 if G<>nil then begin
4269 // remove automatic columns before adding user columns
4270 if not (gsAddingAutoColumns in G.GridStatus) then
4271 RemoveAutoColumns;
4272 end;
4273 result := TColumn( inherited add );
4274 end;
4275
4276 procedure TDBGridColumns.LinkFields;
4277 var
4278 i: Integer;
4279 G: TCustomDBGrid;
4280 begin
4281 G := TCustomDBGrid(Grid);
4282 if G<>nil then
4283 G.BeginLayout;
4284 for i:=0 to Count-1 do
4285 Items[i].LinkField;
4286 if G<>nil then
4287 G.EndLayout;
4288 end;
4289
4290 { TColumn }
4291
GetFieldnull4292 function TColumn.GetField: TField;
4293 begin
4294 if (FFieldName<>'') and (FField<>nil) then
4295 LinkField;
4296 result := FField;
4297 end;
4298
GetIsDesignColumnnull4299 function TColumn.GetIsDesignColumn: boolean;
4300 begin
4301 result := (DesignIndex>=0) and (DesignIndex<10000);
4302 end;
4303
TColumn.GetPickListnull4304 function TColumn.GetPickList: TStrings;
4305 begin
4306 Result := inherited GetPickList;
4307 if (Field<>nil) and (FField.FieldKind=fkLookup) then
4308 begin
4309 if FField.LookupCache then
4310 FField.LookupList.ValuesToStrings(Result)
4311 else
4312 begin
4313 Result.Clear;
4314 LookupGetBookMark(FField);
4315 try
4316 with FField.LookupDataSet do
4317 begin
4318 First;
4319 while not EOF do
4320 begin
4321 Result.Add(FieldbyName(FField.LookupResultField).AsString);
4322 Next;
4323 end;
4324 end;
4325 finally
4326 LookupGotoBookMark(FField);
4327 end;
4328 end;
4329 end;
4330 end;
4331
4332 procedure TColumn.ApplyDisplayFormat;
4333 begin
4334 if (FField <> nil) and FDisplayFormatChanged then begin
4335 if (FField is TNumericField) then
4336 TNumericField(FField).DisplayFormat := DisplayFormat
4337 else if (FField is TDateTimeField) then
4338 TDateTimeField(FField).DisplayFormat := DisplayFormat;
4339 end;
4340 end;
4341
GetDisplayFormatnull4342 function TColumn.GetDisplayFormat: string;
4343 begin
4344 if not FDisplayFormatChanged then
4345 Result := GetDefaultDisplayFormat
4346 else
4347 result := FDisplayFormat;
4348 end;
4349
IsDisplayFormatStorednull4350 function TColumn.IsDisplayFormatStored: boolean;
4351 begin
4352 Result := FDisplayFormatChanged;
4353 end;
4354
4355 procedure TColumn.SetDisplayFormat(const AValue: string);
4356 begin
4357 if (not FDisplayFormatChanged)or(CompareText(AValue, FDisplayFormat)<>0) then begin
4358 FDisplayFormat := AValue;
4359 FDisplayFormatChanged:=True;
4360 ColumnChanged;
4361 end;
4362 end;
4363
4364 procedure TColumn.SetField(const AValue: TField);
4365 begin
4366 if FField <> AValue then begin
4367 FField := AValue;
4368 if FField<>nil then
4369 FFieldName := FField.FieldName;
4370 ColumnChanged;
4371 end;
4372 end;
4373
4374 procedure TColumn.SetFieldName(const AValue: String);
4375 begin
4376 if FFieldName=AValue then exit;
4377 FFieldName:=AValue;
4378 LinkField;
4379 ColumnChanged;
4380 end;
4381
GetDataSetnull4382 function TColumn.GetDataSet: TDataSet;
4383 var
4384 AGrid: TCustomDBGrid;
4385 begin
4386 AGrid := TCustomDBGrid(Grid);
4387 if (AGrid<>nil) then
4388 result := AGrid.FDataLink.DataSet
4389 else
4390 result :=nil;
4391 end;
4392
4393 procedure TColumn.Assign(Source: TPersistent);
4394 begin
4395 if Source is TColumn then begin
4396 //DebugLn('Assigning TColumn[',dbgs(Index),'] a TColumn')
4397 Collection.BeginUpdate;
4398 try
4399 inherited Assign(Source);
4400 FieldName := TColumn(Source).FieldName;
4401 DisplayFormat := TColumn(Source).DisplayFormat;
4402 ValueChecked := TColumn(Source).ValueChecked;
4403 ValueUnchecked := TColumn(Source).ValueUnchecked;
4404 finally
4405 Collection.EndUpdate;
4406 end;
4407 end else
4408 inherited Assign(Source);
4409 end;
4410
GetDefaultWidthnull4411 function TColumn.GetDefaultWidth: Integer;
4412 var
4413 AGrid: TCustomDBGrid;
4414 tmpCanvas: TCanvas;
4415 begin
4416 AGrid := TCustomDBGrid(Grid);
4417 if AGrid<>nil then begin
4418
4419 tmpCanvas := GetWorkingCanvas(aGrid.Canvas);
4420 tmpCanvas.Font := aGrid.Font;
4421
4422 if FField<>nil then
4423 result := CalcColumnFieldWidth(
4424 tmpCanvas,
4425 dgTitles in aGrid.Options,
4426 Title.Caption,
4427 Title.Font,
4428 FField)
4429 else
4430 result := AGrid.DefaultColWidth;
4431
4432 if tmpCanvas<>AGrid.Canvas then
4433 FreeWorkingCanvas(tmpCanvas);
4434
4435 end else
4436 result := -1;
4437 end;
4438
CreateTitlenull4439 function TColumn.CreateTitle: TGridColumnTitle;
4440 begin
4441 Result := TColumnTitle.Create(Self);
4442 end;
4443
4444 constructor TColumn.Create(ACollection: TCollection);
4445 var
4446 AGrid: TCustomGrid;
4447 begin
4448 {$ifdef dbgDBGrid}
4449 DebugLn('%s.Create', [ClassName]);
4450 {$endif}
4451 inherited Create(ACollection);
4452 if ACollection is TDBGridColumns then begin
4453 AGrid := TDBGridColumns(ACollection).Grid;
4454 if (AGrid<>nil) and (csLoading in AGrid.ComponentState) then
4455 FDesignIndex := Index
4456 else
4457 FDesignIndex := 10000;
4458 end;
4459 end;
4460
IsDefaultnull4461 function TColumn.IsDefault: boolean;
4462 begin
4463 result := not FDisplayFormatChanged and (inherited IsDefault());
4464 end;
4465
4466 procedure TColumn.LinkField;
4467 var
4468 AGrid: TCustomDBGrid;
4469 begin
4470 AGrid:= TCustomDBGrid(Grid);
4471 if (AGrid<>nil) and AGrid.FDatalink.Active then begin
4472 Field := AGrid.FDataLink.DataSet.FindField(FFieldName);
4473 ApplyDisplayFormat;
4474 end else
4475 Field := nil;
4476 end;
4477
GetDefaultDisplayFormatnull4478 function TColumn.GetDefaultDisplayFormat: string;
4479 begin
4480 Result := '';
4481 if FField<>nil then begin
4482 if FField is TNumericField then
4483 Result := TNumericField(FField).DisplayFormat
4484 else if FField is TDateTimeField then
4485 Result := TDateTimeField(FField).DisplayFormat
4486 end;
4487 end;
4488
TColumn.GetDefaultValueCheckednull4489 function TColumn.GetDefaultValueChecked: string;
4490 begin
4491 if (FField<>nil) and (FField.Datatype=ftBoolean) then
4492 Result := BoolToStr(True)
4493 else
4494 Result := '1';
4495 end;
4496
TColumn.GetDefaultValueUncheckednull4497 function TColumn.GetDefaultValueUnchecked: string;
4498 begin
4499 if (FField<>nil) and (FField.DataType=ftBoolean) then
4500 Result := BoolToStr(False)
4501 else
4502 Result := '0';
4503 end;
4504
TColumn.GetDefaultReadOnlynull4505 function TColumn.GetDefaultReadOnly: boolean;
4506 var
4507 AGrid: TCustomDBGrid;
4508 begin
4509 AGrid := TCustomDBGrid(Grid);
4510 Result := ((AGrid<>nil)and(AGrid.ReadOnly)) or ((FField<>nil)And(FField.ReadOnly))
4511 end;
4512
GetDefaultVisiblenull4513 function TColumn.GetDefaultVisible: boolean;
4514 begin
4515 if FField<>nil then
4516 result := FField.Visible
4517 else
4518 result := True;
4519 end;
4520
TColumn.GetDisplayNamenull4521 function TColumn.GetDisplayName: string;
4522 begin
4523 if FFieldName<>'' then
4524 Result:=FFieldName
4525 else
4526 Result:=inherited GetDisplayName;
4527 end;
4528
GetDefaultAlignmentnull4529 function TColumn.GetDefaultAlignment: TAlignment;
4530 var
4531 Bs: set of TColumnButtonStyle;
4532 begin
4533 bs := [buttonStyle];
4534 if Grid<>nil then
4535 Include(bs, TCustomDbGrid(Grid).DefaultEditorStyle(ButtonStyle, FField));
4536 if bs*[cbsCheckboxColumn,cbsButtonColumn]<>[] then
4537 result := taCenter
4538 else
4539 if FField<>nil then
4540 result := FField.Alignment
4541 else
4542 Result := taLeftJustify;
4543 end;
4544
4545 { TColumnTitle }
4546
TColumnTitle.GetDefaultCaptionnull4547 function TColumnTitle.GetDefaultCaption: string;
4548 begin
4549 with (Column as TColumn) do begin
4550 if FieldName<>'' then begin
4551 if FField<>nil then
4552 Result := FField.DisplayName
4553 else
4554 Result := Fieldname;
4555 end else
4556 Result := inherited GetDefaultCaption;
4557 end;
4558 end;
4559
4560 { TBookmarkList }
4561
GetCountnull4562 function TBookmarkList.GetCount: integer;
4563 begin
4564 {$ifdef dbgDBGrid}
4565 DebugLn('%s.GetCount FList.Count=%d',[ClassName, FList.Count]);
4566 {$endif}
4567 result := FList.Count;
4568 end;
4569
GetCurrentRowSelectednull4570 function TBookmarkList.GetCurrentRowSelected: boolean;
4571 var
4572 Bookmark: TBookmark;
4573 begin
4574 CheckActive;
4575 Bookmark := FDataset.GetBookmark;
4576 Result := IndexOf(Bookmark)>=0;
4577 FDataset.FreeBookmark(Bookmark);
4578 end;
4579
GetItemnull4580 function TBookmarkList.GetItem(AIndex: Integer): TBookmark;
4581 begin
4582 Result := TBookmark(FList[AIndex]);
4583 end;
4584
4585 procedure TBookmarkList.SetCurrentRowSelected(const AValue: boolean);
4586 var
4587 Bookmark: pointer;
4588 Index: Integer;
4589 begin
4590 CheckActive;
4591
4592 Bookmark := nil;
4593 TBookmark(Bookmark) := FDataset.GetBookmark; // fetch and increase reference count
4594 if Bookmark = nil then
4595 Exit;
4596
4597 if Find(Bookmark, Index) then begin
4598 FDataset.FreeBookmark(Bookmark);
4599 {$ifndef noautomatedbookmark}
4600 SetLength(TBookmark(Bookmark),0); // decrease reference count
4601 {$endif noautomatedbookmark}
4602 if not AValue then begin
4603 FDataset.FreeBookmark(Pointer(Items[Index]));
4604 {$ifndef noautomatedbookmark}
4605 Bookmark := FList[Index];
4606 SetLength(TBookmark(Bookmark),0); // decrease reference count
4607 {$endif noautomatedbookmark}
4608 FList.Delete(Index);
4609 FGrid.Invalidate;
4610 end;
4611 end else begin
4612 if AValue then begin
4613 // the reference count of Bookmark was increased above, so it is save to
4614 // store it here as pointer
4615 FList.Insert(Index, Bookmark);
4616 FGrid.Invalidate;
4617 end else
4618 FDataset.FreeBookmark(Bookmark);
4619 end;
4620 end;
4621
4622 procedure TBookmarkList.CheckActive;
4623 begin
4624 {$ifdef dbgDBGrid}
4625 DebugLn('%s.CheckActive', [ClassName]);
4626 {$endif}
4627 if not FGrid.FDataLink.Active then
4628 raise EInvalidGridOperation.Create('Dataset Inactive');
4629
4630 if FGrid.DataSource.DataSet=FDataset then
4631 exit;
4632 FDataset := FGrid.DataSource.DataSet;
4633
4634 // Note.
4635 //
4636 // Some dataset descendants do not implement CompareBookmarks, for these we
4637 // use MyCompareBookmarks in the hope the allocated bookmark memory is used
4638 // to hold some kind of record index.
4639 FUseCompareBookmarks := TMethod(@FDataset.CompareBookmarks).Code<>pointer(@TDataset.CompareBookmarks);
4640
4641 // Note.
4642 //
4643 // fpc help say CompareBookmarks should return -1, 0 or 1 ... which imply that
4644 // bookmarks should be a sorted array (or list). In this scenario binary search
4645 // is the prefered method for finding a bookmark.
4646 //
4647 // The problem here is that TBufDataset and TSQLQuery (and thus TCustomSQLQuery
4648 // and TCustomBufDataset) CompareBookmarks only return 0 or -1 (some kind of
4649 // is this a valid bookmark or not), the result is that it appears as an unsorted
4650 // list (or array) and binary search should not be used.
4651 //
4652 // The weird thing is that if we use MyCompareBookmarks which deals with comparing
4653 // the memory reserved for bookmarks in the hope bookmarks are just some kind of
4654 // reocord indexes, currently work fine for TCustomBufDataset derived datasets.
4655 // however using CompareBookmarks is always the right thing to use where implemented.
4656 //
4657 // As Dbgrid should be TDataset implementation agnostic this is a way I found
4658 // to know if the dataset is derived from TCustomBufDataset or not.
4659 // Once TCustomBufDataset is fixed, remove this ugly note & hack.
4660 case FDataset.ClassName of
4661 'TSQLQuery','TBufDataset','TCustomSQLQuery','TCustomBufDataset':
4662 FCanDoBinarySearch := false;
4663 else
4664 FCanDoBinarySearch := true;
4665 end;
4666 end;
4667
TBookmarkList.GetEnumeratornull4668 function TBookmarkList.GetEnumerator(opt: TBookmarkedRecordEnumeratorOptions
4669 ): TBookmarkedRecordEnumerator;
4670 begin
4671 result := TBookmarkedRecordEnumerator.Create(self, fGrid, opt);
4672 end;
4673
4674 constructor TBookmarkList.Create(AGrid: TCustomDbGrid);
4675 begin
4676 inherited Create;
4677 FGrid := AGrid;
4678 FList := TFPList.Create;
4679 end;
4680
4681 destructor TBookmarkList.Destroy;
4682 begin
4683 Clear;
4684 FreeAndNil(FList);
4685 inherited Destroy;
4686 end;
4687
4688 procedure TBookmarkList.Clear;
4689 var
4690 i: Integer;
4691 {$ifndef noautomatedbookmark}
4692 Bookmark: Pointer;
4693 {$endif}
4694 begin
4695 for i:=0 to FList.Count-1 do
4696 begin
4697 {$ifdef dbgDBGrid}
4698 DebugLn('%s.Clear', [ClassName]);
4699 {$endif}
4700 FDataset.FreeBookmark(Items[i]);
4701 {$ifndef noautomatedbookmark}
4702 Bookmark := FList[i];
4703 SetLength(TBookmark(Bookmark),0); // decrease reference count
4704 {$endif noautomatedbookmark}
4705 end;
4706 FList.Clear;
4707 FGrid.Invalidate;
4708 end;
4709
4710 procedure TBookmarkList.Delete;
4711 var
4712 i: Integer;
4713 {$ifndef noautomatedbookmark}
4714 Bookmark: Pointer;
4715 {$endif}
4716 begin
4717 {$ifdef dbgDBGrid}
4718 DebugLn('%s.Delete', [ClassName]);
4719 {$endif}
4720 for i := FList.Count-1 downto 0 do begin
4721 FDataset.GotoBookmark(Items[i]);
4722 {$ifndef noautomatedbookmark}
4723 Bookmark := FList[i];
4724 SetLength(TBookmark(Bookmark),0); // decrease reference count
4725 {$else}
4726 FDataset.FreeBookmark(Items[i]);
4727 {$endif noautomatedbookmark}
4728 FDataset.Delete;
4729 FList.Delete(i);
4730 end;
4731 end;
4732
4733 type
4734 TDs=class(TDataset)
4735 end;
4736
MyCompareBookmarksnull4737 function MyCompareBookmarks(ds:Tdataset; b1,b2:pointer): Integer;
4738 begin
4739 if b1=b2 then
4740 result := 0
4741 else
4742 if b1=nil then
4743 result := 1
4744 else
4745 if b2=nil then
4746 result := -1
4747 else begin
4748 // Note: Tds(ds).bookmarksize is set at creation of TDataSet and does not change
4749 result := CompareMemRange(b1,b2,Tds(ds).bookmarksize);
4750 end;
4751 end;
4752
Findnull4753 function TBookmarkList.Find(const Item: TBookmark; var AIndex: Integer): boolean;
4754 var
4755 L, R, I: Integer;
4756 CompareRes: Integer;
4757
4758 procedure BinarySearch;
4759 begin
4760 L := 0;
4761 R := FList.Count - 1;
4762 while (L <= R) do
4763 begin
4764 I := L + (R - L) div 2;
4765 if FUseCompareBookmarks then
4766 CompareRes := FDataset.CompareBookmarks(Item, TBookmark(FList[I]))
4767 else
4768 CompareRes := MyCompareBookmarks(FDataset, pointer(Item), FList[I]);
4769 if (CompareRes > 0) then
4770 L := I + 1
4771 else
4772 begin
4773 R := I - 1;
4774 if (CompareRes = 0) then
4775 begin
4776 Result := True;
4777 L := I;
4778 end;
4779 end;
4780 end;
4781 AIndex := L;
4782 end;
4783
4784 procedure VisitAll;
4785 begin
4786 AIndex := 0;
4787 i := 0;
4788 while i<FList.Count do begin
4789 if FUseCompareBookmarks then
4790 CompareRes := FDataset.CompareBookmarks(Item, TBookmark(FList[I]))
4791 else
4792 CompareRes := MyCompareBookmarks(FDataset, pointer(Item), FList[I]);
4793 if CompareRes=0 then begin
4794 result := true;
4795 AIndex := i;
4796 exit;
4797 end;
4798 inc(i);
4799 end;
4800 end;
4801
4802 begin
4803 {$ifdef dbgDBGrid}
4804 DebugLn('%s.Find', [ClassName]);
4805 {$endif}
4806
4807 Result := False;
4808 if Item=nil then
4809 Exit;
4810 if FCanDoBinarySearch then
4811 BinarySearch
4812 else
4813 VisitAll;
4814 end;
4815
IndexOfnull4816 function TBookmarkList.IndexOf(const Item: TBookmark): Integer;
4817 begin
4818 {$ifdef dbgDBGrid}
4819 DebugLn('%s.IndexOf', [ClassName]);
4820 {$endif}
4821 if not Find(Item, Result) then
4822 Result := -1;
4823 end;
4824
Refreshnull4825 function TBookmarkList.Refresh: boolean;
4826 var
4827 i: LongInt;
4828 {$ifndef noautomatedbookmark}
4829 Bookmark: Pointer;
4830 {$endif}
4831 begin
4832 {$ifdef dbgDBGrid}
4833 DebugLn('%s.Refresh', [ClassName]);
4834 {$endif}
4835 Result := False;
4836 for i := FList.Count - 1 downto 0 do
4837 if not FDataset.BookmarkValid(TBookMark(Items[i])) then begin
4838 Result := True;
4839 FDataset.FreeBookmark(Items[i]);
4840 {$ifndef noautomatedbookmark}
4841 Bookmark := FList[i];
4842 SetLength(TBookmark(Bookmark),0); // decrease reference count
4843 {$endif noautomatedbookmark}
4844 Flist.Delete(i);
4845 end;
4846 if Result then
4847 FGrid.Invalidate;
4848 end;
4849
4850 end.
4851