1
2 { $Id$}
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 FCanDoBinarySearch: boolean;
GetCountnull170 function GetCount: integer;
GetCurrentRowSelectednull171 function GetCurrentRowSelected: boolean;
GetItemnull172 function GetItem(AIndex: Integer): TBookmark;
173 procedure SetCurrentRowSelected(const AValue: boolean);
174 procedure CheckActive;
175 public
176 constructor Create(AGrid: TCustomDbGrid);
177 destructor Destroy; override;
178
179 procedure Clear;
180 procedure Delete;
Findnull181 function Find(const Item: TBookmark; var AIndex: Integer): boolean;
IndexOfnull182 function IndexOf(const Item: TBookmark): Integer;
Refreshnull183 function Refresh: boolean;
GetEnumeratornull184 function GetEnumerator(opt: TBookmarkedRecordEnumeratorOptions =
185 [breDisableDataset, breRestoreCurrent]): TBookmarkedRecordEnumerator;
186
187 property Count: integer read GetCount;
188 property CurrentRowSelected: boolean
189 read GetCurrentRowSelected write SetCurrentRowSelected;
190 property Items[AIndex: Integer]: TBookmark read GetItem; default;
191 end;
192
193 { TComponentDataLink }
194
195 TComponentDataLink=class(TDatalink)
196 private
197 FDataSet: TDataSet;
198 FDataSetName: string;
199 FModified: Boolean;
200 FOnDatasetChanged: TDatasetNotifyEvent;
201 fOnDataSetClose: TDataSetNotifyEvent;
202 fOnDataSetOpen: TDataSetNotifyEvent;
203 FOnDataSetScrolled: TDataSetScrolledEvent;
204 FOnEditingChanged: TDataSetNotifyEvent;
205 fOnFocusControl: TFocusControlEvent;
206 fOnInvalidDataSet: TDataSetNotifyEvent;
207 fOnInvalidDataSource: TDataSetNotifyEvent;
208 FOnLayoutChanged: TDataSetNotifyEvent;
209 fOnNewDataSet: TDataSetNotifyEvent;
210 FOnRecordChanged: TFieldNotifyEvent;
211 FOnUpdateData: TDataSetNotifyEvent;
212
GetDataSetNamenull213 function GetDataSetName: string;
GetFieldsnull214 function GetFields(Index: Integer): TField;
215 procedure SetDataSetName(const AValue: string);
216 protected
217 procedure RecordChanged(Field: TField); override;
218 procedure DataSetChanged; override;
219 procedure ActiveChanged; override;
220 procedure LayoutChanged; override;
221 procedure DataSetScrolled(Distance: Integer); override;
222 procedure FocusControl(Field: TFieldRef); override;
223 // Testing Events
224 procedure CheckBrowseMode; override;
225 procedure EditingChanged; override;
226 procedure UpdateData; override;
MoveBynull227 function MoveBy(Distance: Integer): Integer; override;
228 property Modified: Boolean read FModified write FModified;
229 public
230 property OnRecordChanged: TFieldNotifyEvent read FOnRecordChanged write FOnRecordChanged;
231 property OnDataSetChanged: TDatasetNotifyEvent read FOnDatasetChanged write FOnDataSetChanged;
232 property OnNewDataSet: TDataSetNotifyEvent read fOnNewDataSet write fOnNewDataSet;
233 property OnDataSetOpen: TDataSetNotifyEvent read fOnDataSetOpen write fOnDataSetOpen;
234 property OnInvalidDataSet: TDataSetNotifyEvent read fOnInvalidDataSet write fOnInvalidDataSet;
235 property OnInvalidDataSource: TDataSetNotifyEvent read fOnInvalidDataSource write fOnInvalidDataSource;
236 property OnFocusControl: TFocusControlEvent read fOnFocusControl write fOnFocusControl;
237 property OnLayoutChanged: TDataSetNotifyEvent read FOnLayoutChanged write FOnLayoutChanged;
238 property OnDataSetClose: TDataSetNotifyEvent read fOnDataSetClose write fOnDataSetClose;
239 property OnDataSetScrolled: TDataSetScrolledEvent read FOnDataSetScrolled write FOnDataSetScrolled;
240 property OnEditingChanged: TDataSetNotifyEvent read FOnEditingChanged write FOnEditingChanged;
241 property OnUpdateData: TDataSetNotifyEvent read FOnUpdateData write FOnUpdateData;
242 property DataSetName:string read GetDataSetName write SetDataSetName;
243 property Fields[Index: Integer]: TField read GetFields;
244 property VisualControl;
245 end;
246
247 { TColumn }
248
249 TColumnTitle = class(TGridColumnTitle)
250 protected
GetDefaultCaptionnull251 function GetDefaultCaption: string; override;
252 end;
253
254 { TColumn }
255
256 TColumn = class(TGridColumn)
257 private
258 FDisplayFormat: String;
259 FDisplayFormatChanged: boolean;
260 FFieldName: String;
261 FField: TField;
262 FIsAutomaticColumn: boolean;
263 FDesignIndex: Integer;
264 procedure ApplyDisplayFormat;
GetDataSetnull265 function GetDataSet: TDataSet;
GetDisplayFormatnull266 function GetDisplayFormat: string;
GetFieldnull267 function GetField: TField;
GetIsDesignColumnnull268 function GetIsDesignColumn: boolean;
IsDisplayFormatStorednull269 function IsDisplayFormatStored: boolean;
270 procedure SetDisplayFormat(const AValue: string);
271 procedure SetField(const AValue: TField);
272 procedure SetFieldName(const AValue: String);
273 protected
CreateTitlenull274 function CreateTitle: TGridColumnTitle; override;
GetDefaultAlignmentnull275 function GetDefaultAlignment: TAlignment; override;
GetDefaultDisplayFormatnull276 function GetDefaultDisplayFormat: string;
GetDefaultValueCheckednull277 function GetDefaultValueChecked: string; override;
GetDefaultValueUncheckednull278 function GetDefaultValueUnchecked: string; override;
GetDefaultVisiblenull279 function GetDefaultVisible: boolean; override;
GetDisplayNamenull280 function GetDisplayName: string; override;
GetDefaultReadOnlynull281 function GetDefaultReadOnly: boolean; override;
GetDefaultWidthnull282 function GetDefaultWidth: Integer; override;
GetPickListnull283 function GetPickList: TStrings; override;
284 property IsAutomaticColumn: boolean read FIsAutomaticColumn;
285 property IsDesignColumn: boolean read GetIsDesignColumn;
286 procedure LinkField;
287 public
288 constructor Create(ACollection: TCollection); override;
289 procedure Assign(Source: TPersistent); override;
IsDefaultnull290 function IsDefault: boolean; override;
291 property DesignIndex: integer read FDesignIndex;
292 property Field: TField read GetField write SetField;
293 published
294 property FieldName: String read FFieldName write SetFieldName;
295 property DisplayFormat: string read GetDisplayFormat write SetDisplayFormat
296 stored IsDisplayFormatStored;
297 end;
298
299 TColumnOrder = (coDesignOrder, coFieldIndexOrder);
300
301 { TDBGridColumns }
302 TDBGridColumns = class(TGridColumns)
303 private
GetColumnnull304 function GetColumn(Index: Integer): TColumn;
305 procedure SetColumn(Index: Integer; Value: TColumn);
306 protected
307 procedure Update(Item: TCollectionItem); override;
ColumnFromFieldnull308 function ColumnFromField(Field: TField): TColumn;
HasAutomaticColumnsnull309 function HasAutomaticColumns: boolean;
HasDesignColumnsnull310 function HasDesignColumns: boolean;
311 procedure RemoveAutoColumns;
312 public
Addnull313 function Add: TColumn;
ColumnByFieldnamenull314 function ColumnByFieldname(const aFieldname: string): TColumn;
ColumnByTitlenull315 function ColumnByTitle(const aTitle: string): TColumn;
316 procedure LinkFields;
317 procedure ResetColumnsOrder(ColumnOrder: TColumnOrder);
318 property Items[Index: Integer]: TColumn read GetColumn write SetColumn; default;
319 end;
320
321 { TCustomDBGrid }
322
323 TCustomDBGrid=class(TCustomGrid)
324 private
325 FDataLink: TComponentDataLink;
326 FExtraOptions: TDBGridExtraOptions;
327 FOnCellClick: TDBGridClickEvent;
328 FOnColEnter,FOnColExit: TNotifyEvent;
329 FOnColumnMoved: TMovedEvent;
330 FOnColumnSized: TNotifyEvent;
331 FOnDrawColumnCell: TDrawColumnCellEvent;
332 FOnDrawColumnTitle: TDrawColumnCellEvent;
333 FOnFieldEditMask: TGetDbEditMaskEvent;
334 FOnTitleClick: TDBGridClickEvent;
335 FOnSelectEditor: TDbGridSelEditorEvent;
336 FOnCheckboxBitmap: TDbGridCheckBoxBitmapEvent;
337 FOnCheckboxState: TDbGridCheckboxStateEvent;
338 FOptions: TDBGridOptions;
339 FReadOnly: Boolean;
340 FColEnterPending: Boolean;
341 FLayoutChangedCount: integer;
342 FTempText : string;
343 FDrawingActiveRecord: Boolean;
344 FDrawingMultiSelRecord: Boolean;
345 FDrawingEmptyDataset: Boolean;
346 FEditingColumn: Integer;
347 FOldPosition: Integer;
348 FDefaultColWidths: boolean;
349 FGridStatus: TDBGridStatus;
350 FOldControlStyle: TControlStyle;
351 FSelectedRows: TBookmarkList;
352 FOnPrepareCanvas: TPrepareDbGridCanvasEvent;
353 FKeySign: Integer;
354 FSavedRecord: Integer;
355 FOnGetCellHint: TDbGridCellHintEvent;
356 FOnRowMoved: TMovedEvent;
357 FFixedRowsExtra: Integer;
358 procedure EmptyGrid;
GetColumnsnull359 function GetColumns: TDBGridColumns;
GetCurrentColumnnull360 function GetCurrentColumn: TColumn;
GetCurrentFieldnull361 function GetCurrentField: TField;
GetDataSourcenull362 function GetDataSource: TDataSource;
GetFirstColumnnull363 function GetFirstColumn: TColumn;
GetLastColumnnull364 function GetLastColumn: TColumn;
GetRecordCountnull365 function GetRecordCount: Integer;
GetSelectedFieldRectnull366 function GetSelectedFieldRect: TRect;
GetSelectedIndexnull367 function GetSelectedIndex: Integer;
368 procedure OnRecordChanged(Field:TField);
369 procedure OnDataSetChanged(aDataSet: TDataSet);
370 procedure OnDataSetOpen(aDataSet: TDataSet);
371 procedure OnDataSetClose(aDataSet: TDataSet);
372 procedure OnEditingChanged(aDataSet: TDataSet);
373 procedure OnInvalidDataSet(aDataSet: TDataSet);
374 procedure OnInvalidDataSource(aDataSet: TDataset);
375 procedure OnFocusControl(aField: TFieldRef);
376 procedure OnLayoutChanged(aDataSet: TDataSet);
377 procedure OnNewDataSet(aDataSet: TDataset);
378 procedure OnDataSetScrolled(aDataSet:TDataSet; Distance: Integer);
379 procedure OnUpdateData(aDataSet: TDataSet);
380 procedure SetColumns(const AValue: TDBGridColumns);
381 //procedure ReadColumns(Reader: TReader);
382 //procedure SetColumns(const AValue: TDBGridColumns);
383 procedure SetCurrentField(const AValue: TField);
384 procedure SetDataSource(const AValue: TDataSource);
385 procedure SetExtraOptions(const AValue: TDBGridExtraOptions);
386 procedure SetFixedRowsExtra(AValue: Integer);
387 procedure SetOptions(const AValue: TDBGridOptions);
388 procedure SetRowMoved(AValue: TMovedEvent);
389 procedure SetSelectedIndex(const AValue: Integer);
390 procedure UpdateBufferCount;
391
392 // Temporal
GetColumnCountnull393 function GetColumnCount: Integer;
394
DefaultFieldColWidthnull395 function DefaultFieldColWidth(F: TField): Integer;
396
397 procedure UpdateGridColumnSizes;
398 procedure UpdateScrollbarRange;
399 procedure DoLayoutChanged;
400 //procedure WriteColumns(Writer: TWriter);
401
402 procedure RestoreEditor;
ISEOFnull403 function ISEOF: boolean;
ValidDataSetnull404 function ValidDataSet: boolean;
InsertCancelablenull405 function InsertCancelable: boolean;
406 procedure StartUpdating;
407 procedure EndUpdating;
UpdatingDatanull408 function UpdatingData: boolean;
409 procedure SwapCheckBox;
410 procedure ToggleSelectedRow;
411 procedure SelectRecord(AValue: boolean);
412 procedure GetScrollbarParams(out aRange, aPage, aPos: Integer);
413 procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
414 procedure ClearSelection(selCurrent:boolean=false);
NeedAutoSizeColumnsnull415 function NeedAutoSizeColumns: boolean;
416 procedure RenewColWidths;
417 procedure InternalAutoSizeColumn(aCol: Integer; aCanvas: TCanvas; aDatalinkActive: Boolean);
418 procedure DoHeaderClick(Index: Integer);
419 protected
420 procedure AddAutomaticColumns;
421 procedure AssignTo(Dest: TPersistent); override;
422 procedure AutoAdjustColumn(aCol: Integer); override;
423 procedure BeforeMoveSelection(const DCol,DRow: Integer); override;
424 procedure BeginLayout;
425 procedure CellClick(const aCol,aRow: Integer; const Button:TMouseButton); override;
CheckDisplayMemonull426 function CheckDisplayMemo(aField: TField): boolean;
427 procedure InvalidateSizes;
428 procedure ColRowMoved(IsColumn: Boolean; FromIndex,ToIndex: Integer); override;
ColumnEditorStylenull429 function ColumnEditorStyle(aCol: Integer; F: TField): TColumnButtonStyle;
CreateColumnsnull430 function CreateColumns: TGridColumns; override;
431 procedure CreateWnd; override;
432 procedure DefineProperties(Filer: TFiler); override;
433 procedure DefaultDrawCell(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState);
DefaultEditorStylenull434 function DefaultEditorStyle(const Style:TColumnButtonStyle; const F:TField): TColumnButtonStyle;
435 procedure DoCopyToClipboard; override;
436 procedure DoExit; override;
DoMouseWheelDownnull437 function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
DoMouseWheelUpnull438 function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
439 procedure DoOnChangeBounds; override;
440 procedure DoPrepareCanvas(aCol,aRow:Integer; aState: TGridDrawState); override;
441 procedure DoLoadColumn(sender: TCustomGrid; aColumn: TGridColumn; aColIndex: Integer;
442 aCfg: TXMLConfig; aVersion: Integer; aPath: string); override;
443 procedure DoSaveColumn(sender: TCustomGrid; aColumn: TGridColumn; aColIndex: Integer;
444 aCfg: TXMLConfig; aVersion: Integer; aPath: string); override;
445 procedure DrawAllRows; override;
446 procedure DrawFocusRect(aCol,aRow:Integer; ARect:TRect); override;
447 procedure DrawRow(ARow: Integer); override;
448 procedure DrawCell(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState); override;
449 procedure DrawCellBackground(aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState);
450 procedure DrawCheckboxBitmaps(aCol: Integer; aRect: TRect; F: TField);
451 procedure DrawFixedText(aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState);
452 procedure DrawColumnText(aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState); override;
453 procedure DrawIndicator(ACanvas: TCanvas; R: TRect; Opt: TDataSetState; MultiSel: boolean); virtual;
454 procedure EditingColumn(aCol: Integer; Ok: boolean);
455 procedure EditorCancelEditing;
456 procedure EditorDoGetValue; override;
EditorCanAcceptKeynull457 function EditorCanAcceptKey(const ch: TUTF8Char): boolean; override;
EditorIsReadOnlynull458 function EditorIsReadOnly: boolean; override;
459 procedure EditorTextChanged(const aCol,aRow: Integer; const aText:string); override;
460 procedure EndLayout;
FieldIndexFromGridColumnnull461 function FieldIndexFromGridColumn(AGridCol: Integer): Integer;
FirstGridColumnnull462 function FirstGridColumn: Integer; override;
GetBufferCountnull463 function GetBufferCount: integer; virtual;
GetCellHintTextnull464 function GetCellHintText(aCol, aRow: Integer): String; override;
GetDefaultColumnAlignmentnull465 function GetDefaultColumnAlignment(Column: Integer): TAlignment; override;
GetDefaultColumnWidthnull466 function GetDefaultColumnWidth(Column: Integer): Integer; override;
GetDefaultColumnReadOnlynull467 function GetDefaultColumnReadOnly(Column: Integer): boolean; override;
GetDefaultColumnTitlenull468 function GetDefaultColumnTitle(Column: Integer): string; override;
GetDefaultRowHeightnull469 function GetDefaultRowHeight: integer; override;
GetDsFieldFromGridColumnnull470 function GetDsFieldFromGridColumn(Column: Integer): TField;
GetEditMasknull471 function GetEditMask(aCol, aRow: Longint): string; override;
GetEditTextnull472 function GetEditText(aCol, aRow: Longint): string; override;
GetFieldFromGridColumnnull473 function GetFieldFromGridColumn(Column: Integer): TField;
GetGridColumnFromFieldnull474 function GetGridColumnFromField(F: TField): Integer;
475 procedure GetImageForCheckBox(const aCol, aRow: Integer;
476 CheckBoxView: TCheckBoxState; var ImageList: TCustomImageList;
477 var ImageIndex: TImageIndex; var Bitmap: TBitmap); override;
GetIsCellSelectednull478 function GetIsCellSelected(aCol, aRow: Integer): boolean; override;
GetIsCellTitlenull479 function GetIsCellTitle(aCol,aRow: Integer): boolean; override;
480 procedure GetSelectedState(AState: TGridDrawState; out IsSelected:boolean); override;
GetSmoothScrollnull481 function GetSmoothScroll(Which: Integer): Boolean; override;
GetTruncCellHintTextnull482 function GetTruncCellHintText(aCol, aRow: Integer): string; override;
GridCanModifynull483 function GridCanModify: boolean;
484 procedure GetSBVisibility(out HsbVisible,VsbVisible:boolean);override;
485 procedure GetSBRanges(const HsbVisible,VsbVisible: boolean;
486 out HsbRange,VsbRange,HsbPage,VsbPage,HsbPos,VsbPos:Integer); override;
487 procedure HeaderClick(IsColumn: Boolean; index: Integer); override;
488 procedure HeaderSized(IsColumn: Boolean; Index: Integer); override;
IsColumnVisiblenull489 function IsColumnVisible(aCol: Integer): boolean;
IsValidCharnull490 function IsValidChar(AField: TField; AChar: TUTF8Char): boolean;
491 procedure KeyDown(var Key : Word; Shift : TShiftState); override;
492 procedure LinkActive(Value: Boolean); virtual;
493 procedure LayoutChanged; virtual;
494 procedure Loaded; override;
495 procedure LoadGridOptions(cfg: TXMLConfig; Version: Integer); override;
496 procedure MoveSelection; override;
MouseButtonAllowednull497 function MouseButtonAllowed(Button: TMouseButton): boolean; override;
498 procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
499 procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
500 procedure PrepareCanvas(aCol,aRow: Integer; aState:TGridDrawState); override;
501 procedure PrepareCellHints(aCol,aRow: Integer); override;
502 procedure RemoveAutomaticColumns;
503 procedure ResetSizes; override;
504 procedure SaveGridOptions(Cfg: TXMLConfig); override;
505 procedure SelectEditor; override;
506 procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
507 procedure SetFixedCols(const AValue: Integer); override;
508 procedure UnprepareCellHints; override;
509 procedure UpdateActive; virtual;
510 procedure UpdateAutoSizeColumns;
511 procedure UpdateData; virtual;
UpdateGridCountsnull512 function UpdateGridCounts: Integer;
513 procedure WMVScroll(var Message : TLMVScroll); message LM_VScroll;
514 procedure WndProc(var TheMessage : TLMessage); override;
515
516 property Columns: TDBGridColumns read GetColumns write SetColumns;
517 property FixedRowsExtra: Integer read FFixedRowsExtra write SetFixedRowsExtra;
518 property GridStatus: TDBGridStatus read FGridStatus write FGridStatus;
519 property Datalink: TComponentDataLink read FDatalink;
520 property Options: TDBGridOptions read FOptions write SetOptions default
521 [dgColumnResize, dgColumnMove, dgTitles, dgIndicator, dgRowLines,
522 dgColLines, dgConfirmDelete, dgCancelOnExit, dgTabs, dgEditing,
523 dgAlwaysShowSelection];
524 property OptionsExtra: TDBGridExtraOptions read FExtraOptions
525 write SetExtraOptions default [dgeAutoColumns, dgeCheckboxColumn];
526 property ReadOnly: Boolean read FReadOnly write FReadOnly default false;
527 property SelectedRows: TBookmarkList read FSelectedRows;
528
529 property OnCellClick: TDBGridClickEvent read FOnCellClick write FOnCellClick;
530 property OnColEnter: TNotifyEvent read FOnColEnter write FOnColEnter;
531 property OnColExit: TNotifyEvent read FOnColExit write FOnColExit;
532 property OnColumnMoved: TMovedEvent read FOnColumnMoved write FOnColumnMoved;
533 property OnColumnSized: TNotifyEvent read FOnColumnSized write FOnColumnSized;
534 property OnDrawColumnCell: TDrawColumnCellEvent read FOnDrawColumnCell write FOnDrawColumnCell;
535 property OnDrawColumnTitle: TDrawColumnCellEvent read FOnDrawColumnTitle write FOnDrawColumnTitle;
536 property OnFieldEditMask: TGetDbEditMaskEvent read FOnFieldEditMask write FOnFieldEditMask;
537 property OnGetCellHint: TDbGridCellHintEvent read FOnGetCellHint write FOnGetCellHint;
538 property OnPrepareCanvas: TPrepareDbGridCanvasEvent read FOnPrepareCanvas write FOnPrepareCanvas;
539 property OnSelectEditor: TDbGridSelEditorEvent read FOnSelectEditor write FOnSelectEditor;
540 property OnTitleClick: TDBGridClickEvent read FOnTitleClick write FOnTitleClick;
541 property OnUserCheckboxBitmap: TDbGridCheckboxBitmapEvent read FOnCheckboxBitmap write FOnCheckboxBitmap;
542 property OnUserCheckboxState: TDbGridCheckboxStateEvent read FOnCheckboxState write FOnCheckboxState;
543 property OnRowMoved: TMovedEvent read FOnRowMoved write SetRowMoved;
544 public
545 constructor Create(AOwner: TComponent); override;
546 procedure AutoAdjustColumns; override;
547 procedure InitiateAction; override;
548 procedure DefaultDrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
EditorByStylenull549 function EditorByStyle(Style: TColumnButtonStyle): TWinControl; override;
550 procedure ResetColWidths;
551 destructor Destroy; override;
MouseToRecordOffsetnull552 function MouseToRecordOffset(const x,y: Integer; out Column: TColumn; out RecordOffset: Integer): TGridZone;
ExecuteActionnull553 function ExecuteAction(AAction: TBasicAction): Boolean; override;
UpdateActionnull554 function UpdateAction(AAction: TBasicAction): Boolean; override;
555
556 procedure SaveToFile(FileName: string); override;
557 procedure SaveToStream(AStream: TStream); override;
558 procedure LoadFromFile(FileName: string); override;
559 procedure LoadFromStream(AStream: TStream); override;
560
561 property AllowOutboundEvents;
562 property SelectedField: TField read GetCurrentField write SetCurrentField;
563 property SelectedIndex: Integer read GetSelectedIndex write SetSelectedIndex;
564 property SelectedColumn: TColumn read GetCurrentColumn;
565 property SelectedFieldRect: TRect read GetSelectedFieldRect;
566 property LastColumn: TColumn read GetLastColumn;
567 property FirstColumn: TColumn read GetFirstColumn;
568 property DataSource: TDataSource read GetDataSource write SetDataSource;
569 end;
570
571 TDBGrid=class(TCustomDBGrid)
572 public
573 property BorderColor;
574 property Canvas;
575 property DefaultTextStyle;
576 property EditorBorderStyle;
577 property EditorMode;
578 property ExtendedColSizing;
579 property FastEditing;
580 property FocusColor;
581 property FocusRectVisible;
582 property GridLineColor;
583 property GridLineStyle;
584 property InplaceEditor;
585 property SelectedColor;
586 property SelectedRows;
587 property OnRowMoved;
588 published
589 property Align;
590 property AlternateColor;
591 property Anchors;
592 property AutoAdvance default aaRightDown;
593 property AutoEdit;
594 property AutoFillColumns;
595 property BiDiMode;
596 property BorderSpacing;
597 property BorderStyle;
598 property CellHintPriority;
599 property Color;
600 property Columns; // stored false;
601 property Constraints;
602 property DataSource;
603 property DefaultDrawing;
604 property DefaultRowHeight;
605 property DoubleBuffered;
606 property DragCursor;
607 //property DragKind;
608 property DragMode;
609 property Enabled;
610 property FixedColor;
611 property FixedCols;
612 property FixedHotColor;
613 property Flat;
614 property Font;
615 property HeaderHotZones;
616 property HeaderPushZones;
617 //property ImeMode;
618 //property ImeName;
619 property Options;
620 property Options2;
621 property OptionsExtra;
622 property ParentBiDiMode;
623 property ParentColor default false;
624 property ParentDoubleBuffered;
625 property ParentFont;
626 //property ParentShowHint;
627 property PopupMenu;
628 property ReadOnly;
629 property Scrollbars default ssBoth;
630 property ShowHint;
631 property TabAdvance;
632 property TabOrder;
633 property TabStop;
634 property TitleFont;
635 property TitleImageList;
636 property TitleStyle;
637 property UseXORFeatures;
638 property Visible;
639 property OnCellClick;
640 property OnColEnter;
641 property OnColExit;
642 property OnColumnMoved;
643 property OnColumnSized;
644 property OnContextPopup;
645 property OnDrawColumnCell;
646 property OnDrawColumnTitle;
647 property OnDblClick;
648 property OnDragDrop;
649 property OnDragOver;
650 property OnEditButtonClick;
651 property OnEditingDone;
652 //property OnEndDock;
653 property OnEndDrag;
654 property OnEnter;
655 property OnExit;
656 property OnFieldEditMask;
657 property OnGetCellHint;
658 property OnKeyDown;
659 property OnKeyPress;
660 property OnKeyUp;
661 property OnMouseDown;
662 property OnMouseEnter;
663 property OnMouseLeave;
664 property OnMouseMove;
665 property OnMouseUp;
666 property OnMouseWheel;
667 property OnMouseWheelDown;
668 property OnMouseWheelUp;
669 property OnPrepareCanvas;
670 property OnSelectEditor;
671 //property OnStartDock;
672 property OnStartDrag;
673 property OnTitleClick;
674 property OnUserCheckboxBitmap;
675 property OnUserCheckboxImage;
676 property OnUserCheckboxState;
677 property OnUTF8KeyPress;
678 end;
679
680 procedure Register;
681
682 implementation
683
684 procedure Register;
685 begin
686 RegisterComponents('Data Controls',[TDBGrid]);
687 end;
688
CalcCanvasCharWidthnull689 function CalcCanvasCharWidth(Canvas:TCanvas): integer;
690 begin
691 {$ifdef dbgDBGridExtra}
692 DebugLnEnter('CalcCanvasCharWidth INIT');
693 {$endif}
694 if Canvas.HandleAllocated then
695 result := Canvas.TextWidth('MX') div 2
696 else
697 result := 8;
698 {$ifdef dbgDBGridExtra}
699 DebugLnExit('CalcCanvasCharWidth DONE result=%d', [result]);
700 {$endif}
701 end;
702
CalcColumnFieldWidthnull703 function CalcColumnFieldWidth(Canvas: TCanvas; hasTitle: boolean;
704 aTitle: String; aTitleFont: TFont; Field: TField): Integer;
705 var
706 aCharWidth, aTitleWidth: Integer;
707 aFont: TFont;
708 UseTitleFont: boolean;
709 begin
710 {$ifdef dbgDBGridExtra}
711 DebugLnEnter('CalcColumnFieldWidth INIT');
712 {$endif}
713 if (Field=nil) or (Field.DisplayWidth=0) then
714 Result := DEFCOLWIDTH
715 else begin
716
717 aCharWidth := CalcCanvasCharWidth(Canvas);
718 aTitleWidth := UTF8Length(aTitle);
719 if Field.DisplayWidth > aTitleWidth then
720 result := aCharWidth * Field.DisplayWidth
721 else
722 result := aCharWidth * aTitleWidth;
723
724 if HasTitle then begin
725 UseTitleFont :=
726 (Canvas.Font.Size<>aTitleFont.Size) or
727 (Canvas.Font.Style<>aTitleFont.Style) or
728 (Canvas.Font.CharSet<>aTitleFont.CharSet) or
729 (Canvas.Font.Name<>aTitleFont.Name);
730 if UseTitleFont then begin
731 aFont := TFont.Create;
732 aFont.Assign(Canvas.Font);
733 Canvas.Font := aTitleFont;
734 end;
735 try
736 aCharWidth := Canvas.TextWidth(ATitle)+6;
737 if aCharWidth>Result then
738 Result := aCharWidth;
739 finally
740 if UseTitleFont then begin
741 Canvas.Font := aFont;
742 aFont.Free;
743 end;
744 end;
745 end; // if HasTitle ...
746 end; // if (Field=nil) or (Field.DisplayWidth=0)
747 {$ifdef dbgDBGridExtra}
748 DebugLnExit('CalcColumnFieldWidth DONE result=%d', [result]);
749 {$endif}
750 end;
751
752 var
753 LookupTmpSetActive: Boolean;
754 LookupBookMark: TBookmark;
755
756 procedure LookupGetBookMark(ALookupField: TField);
757 begin
758 {$ifdef dbgDBGrid}
759 DebugLn('LookupGetBookMark');
760 {$endif}
761 LookupTmpSetActive := not ALookupField.LookupDataSet.Active;
762 if LookupTmpSetActive then
763 ALookupField.LookupDataSet.Active := True
764 else
765 begin
766 LookupBookMark := ALookupField.LookupDataSet.GetBookmark;
767 ALookupField.LookupDataSet.DisableControls;
768 end;
769 end;
770
771 procedure LookupGotoBookMark(ALookupField: TField);
772 begin
773 {$ifdef dbgDBGrid}
774 DebugLn('LookupGotoBookMark');
775 {$endif}
776 if LookupTmpSetActive then
777 begin
778 ALookupField.LookupDataSet.Active := False;
779 LookupTmpSetActive := False;
780 end
781 else
782 try
783 ALookupField.LookupDataSet.GotoBookmark(LookupBookMark);
784 ALookupField.LookupDataSet.FreeBookmark(LookupBookMark);
785 finally
786 ALookupField.LookupDataSet.EnableControls;
787 end;
788 end;
789
790 { TBookmarkedRecordEnumerator }
791
792 constructor TBookmarkedRecordEnumerator.Create(bookList: TBookmarkList;
793 aGrid: TCustomDbGrid; anOptions: TBookmarkedRecordEnumeratorOptions);
794 begin
795 inherited Create;
796 fBookmarkList := bookList;
797 fBookmarkIndex := -1;
798 fDataset := aGrid.Datasource.dataset;
799 fOptions := anOptions;
800 end;
801
802 destructor TBookmarkedRecordEnumerator.Destroy;
803 begin
804 if breRestoreCurrent in fOptions then begin
805 if fDataset.BookmarkValid(fBook) then
806 fDataset.GotoBookmark(fBook);
807 fDataset.FreeBookmark(fBook);
808 end;
809 if breDisableDataset in fOptions then
810 fDataset.EnableControls;
811 inherited Destroy;
812 end;
813
TBookmarkedRecordEnumerator.MoveNextnull814 function TBookmarkedRecordEnumerator.MoveNext: boolean;
815 begin
816 inc(fBookmarkIndex);
817
818 if fBookmarkIndex=0 then begin
819 if breDisableDataset in fOptions then
820 fDataset.DisableControls;
821 if breRestoreCurrent in fOptions then
822 fBook := fDataset.GetBookmark;
823 end;
824
825 result := fBookmarkIndex<fBookmarkList.Count;
826 if result then begin
827 fCurrent := fBookmarkList[fBookmarkIndex];
828 if fDataset.BookmarkValid(fCurrent) then
829 fDataSet.GotoBookmark(fCurrent)
830 else if breStopOnInvalidBookmark in fOptions then
831 result := false;
832 end;
833 end;
834
GetEnumeratornull835 function TBookmarkedRecordEnumerator.GetEnumerator: TBookmarkedRecordEnumerator;
836 begin
837 result := self;
838 end;
839
840 { TCustomDBGrid }
841
842 procedure TCustomDBGrid.OnRecordChanged(Field: TField);
843 var
844 c: Integer;
845 begin
846 {$ifdef dbgDBGrid}
847 DbgOut(ClassName,'.OnRecordChanged(Field=');
848 if Field=nil then DebugLn('nil)')
849 else DebugLn(Field.FieldName,')');
850 {$endif}
851 if Field=nil then
852 UpdateActive
853 else begin
854 c := GetGridColumnFromField(Field);
855 if c>0 then begin
856 if EditorMode and (Field=SelectedField) then
857 EditorDoSetValue
858 else
859 InvalidateCell(C, Row)
860 end else
861 UpdateActive;
862 end;
863 end;
864
TCustomDBGrid.GetDataSourcenull865 function TCustomDBGrid.GetDataSource: TDataSource;
866 begin
867 {$ifdef dbgDBGrid}
868 DebugLn('%s.GetDataSource', [ClassName]);
869 {$endif}
870 Result:= FDataLink.DataSource;
871 end;
872
GetFirstColumnnull873 function TCustomDBGrid.GetFirstColumn: TColumn;
874 var
875 i: Integer;
876 begin
877 i := ColumnIndexFromGridColumn(GetFirstVisibleColumn);
878 if i>=0 then
879 Result := Columns[i]
880 else
881 Result := nil;
882 end;
883
GetLastColumnnull884 function TCustomDBGrid.GetLastColumn: TColumn;
885 var
886 i: Integer;
887 begin
888 i := ColumnIndexFromGridColumn(GetLastVisibleColumn);
889 if i>=0 then
890 Result := Columns[i]
891 else
892 Result := nil;
893 end;
894
TCustomDBGrid.GetRecordCountnull895 function TCustomDBGrid.GetRecordCount: Integer;
896 begin
897 {$ifdef dbgDBGrid}
898 DebugLnEnter('%s.GetRecordCount INIT', [ClassName]);
899 {$endif}
900 result := FDataLink.DataSet.RecordCount;
901 {$ifdef dbgDBGrid}
902 DebugLnExit('%s.GetRecordCount DONE RecordCount=%d', [ClassName, result]);
903 {$endif}
904 end;
905
TCustomDBGrid.GetSelectedFieldRectnull906 function TCustomDBGrid.GetSelectedFieldRect: TRect;
907 begin
908 result := CellRect(Col,Row);
909 end;
910
TCustomDBGrid.GetSelectedIndexnull911 function TCustomDBGrid.GetSelectedIndex: Integer;
912 begin
913 if Columns.Enabled then
914 Result := ColumnIndexFromGridColumn( Col )
915 else
916 Result := FieldIndexFromGridColumn( Col );
917 end;
918
919 procedure TCustomDBGrid.EmptyGrid;
920 var
921 OldFixedCols, OldFixedRows: Integer;
922 begin
923 {$ifdef dbgDBGrid}
924 DebugLn('%s.EmptyGrid', [ClassName]);
925 {$endif}
926 OldFixedCols := FixedCols;
927 OldFixedRows := FixedRows;
928 Clear;
929 RowCount := OldFixedRows + 1;
930 ColCount := OldFixedCols + 1;
931 if dgIndicator in Options then
932 ColWidths[0]:=Scale96ToFont(DEFINDICATORCOLWIDTH);
933 end;
934
935 procedure TCustomDBGrid.DoHeaderClick(Index: Integer);
936 var
937 Column: TColumn;
938 begin
939 if Assigned(OnTitleClick) then begin
940 Column := TColumn(ColumnFromGridColumn(Index));
941 if Column <> nil then
942 OnTitleClick(Column);
943 end;
944 end;
945
GetColumnsnull946 function TCustomDBGrid.GetColumns: TDBGridColumns;
947 begin
948 result := TDBGridColumns( inherited Columns );
949 end;
950
951 procedure TCustomDBGrid.InvalidateSizes;
952 begin
953 {$ifdef dbgDBGrid}
954 DebugLn('%s.InvalidateSizes', [ClassName]);
955 {$endif}
956 GridFlags := GridFlags + [gfVisualChange];
957 end;
958
GetCurrentColumnnull959 function TCustomDBGrid.GetCurrentColumn: TColumn;
960 begin
961 if Columns.Enabled then
962 Result := TColumn(Columns[SelectedIndex])
963 else
964 Result := nil;
965 end;
966
TCustomDBGrid.GetCurrentFieldnull967 function TCustomDBGrid.GetCurrentField: TField;
968 begin
969 result := GetFieldFromGridColumn( Col );
970 end;
971
972 procedure TCustomDBGrid.OnDataSetChanged(aDataSet: TDataSet);
973 begin
974 {$ifdef dbgDBGrid}
975 DebugLnEnter('%s.OnDataSetChanged INIT name=%s aDataSet=%s',
976 [ClassName,name,dbgsname(ADataset)]);
977 {$endif}
978 if not (gsStartEditing in FGridStatus) then begin
979 GridFlags := GridFlags + [gfEditingDone];
980 if EditorMode then
981 EditorMode := False;
982 GridFlags := GridFlags - [gfEditingDone];
983 LayoutChanged;
984 end;
985 UpdateActive;
986 if not (gsStartEditing in FGridStatus) then begin
987 SelectEditor;
988 if (dgAlwaysShowEditor in Options) and not EditorMode then
989 EditorMode := true;
990 end;
991 {$ifdef dbgDBGrid}
992 DebugLnExit('%s.OnDataSetChanged DONE name=%s aDataSet=%s',
993 [ClassName,name,dbgsname(ADataset)]);
994 {$endif}
995 end;
996
997 procedure TCustomDBGrid.OnDataSetOpen(aDataSet: TDataSet);
998 begin
999 {$ifdef dbgDBGrid}
1000 DebugLnEnter('%s.OnDataSetOpen INIT', [ClassName]);
1001 {$endif}
1002 RenewColWidths;
1003 LinkActive(True);
1004 UpdateActive;
1005 SelectEditor;
1006 {$ifdef dbgDBGrid}
1007 DebugLnExit('%s.OnDataSetOpen DONE', [ClassName]);
1008 {$endif}
1009 end;
1010
1011 procedure TCustomDBGrid.OnDataSetClose(aDataSet: TDataSet);
1012 begin
1013 {$ifdef dbgDBGrid}
1014 DebugLn('%s.OnDataSetClose', [ClassName]);
1015 {$endif}
1016 LinkActive(False);
1017 end;
1018
1019 procedure TCustomDBGrid.OnEditingChanged(aDataSet: TDataSet);
1020 begin
1021 {$ifdef dbgDBGrid}
1022 DebugLn('%s.OnEditingChanged', [ClassName]);
1023 if aDataSet<>nil then begin
1024 DebugLn(['Editing=', dsEdit = aDataSet.State]);
1025 DebugLn(['Inserting=',dsInsert = aDataSet.State]);
1026 end else
1027 DebugLn('Dataset=nil');
1028 {$endif}
1029 FDataLink.Modified := False;
1030 UpdateActive;
1031 end;
1032
1033 procedure TCustomDBGrid.OnInvalidDataSet(aDataSet: TDataSet);
1034 begin
1035 {$ifdef dbgDBGrid}
1036 DebugLn('%s.OnInvalidDataSet', [ClassName]);
1037 {$endif}
1038 LinkActive(False);
1039 end;
1040
1041 procedure TCustomDBGrid.OnInvalidDataSource(aDataSet: TDataset);
1042 begin
1043 {$ifdef dbgDBGrid}
1044 DebugLn('%s.OnInvalidDataSource', [ClassName]);
1045 {$endif}
1046 LinkActive(False);
1047 end;
1048
1049 procedure TCustomDBGrid.OnFocusControl(aField: TFieldRef);
1050 var
1051 aIndex: Integer;
1052 begin
1053 if CanFocus and (aField<>nil) and (aField^<>nil) then begin
1054 aIndex := GetGridColumnFromField(aField^);
1055 if aIndex>=FirstGridColumn then begin
1056 SelectedField := aField^;
1057 aField^ := nil;
1058 SetFocus;
1059 end;
1060 end;
1061 end;
1062
1063 procedure TCustomDBGrid.OnLayoutChanged(aDataSet: TDataSet);
1064 begin
1065 {$ifdef dbgDBGrid}
1066 DebugLn('%s.OnLayoutChanged', [ClassName]);
1067 {$endif}
1068 LayoutChanged;
1069 end;
1070
1071 procedure TCustomDBGrid.OnNewDataSet(aDataSet: TDataset);
1072 begin
1073 {$ifdef dbgDBGrid}
1074 DebugLnEnter('%s.OnNewDataSet INIT', [ClassName]);
1075 {$endif}
1076 RenewColWidths;
1077 LinkActive(True);
1078 UpdateActive;
1079 SelectEditor;
1080 {$ifdef dbgDBGrid}
1081 DebugLnExit('%s.OnNewDataSet DONE', [ClassName]);
1082 {$endif}
1083 end;
1084
1085 procedure TCustomDBGrid.OnDataSetScrolled(aDataSet: TDataSet; Distance: Integer
1086 );
1087 var
1088 OldEditorMode: boolean;
1089 OldRow: Integer;
1090 begin
1091 {$ifdef dbgDBGrid}
1092 DebugLn('%s.OnDataSetScrolled Distance=%d ds.RecordCount=%d',[ClassName, Distance, aDataSet.RecordCount]);
1093 {$endif}
1094 UpdateScrollBarRange;
1095 // todo: Use a fast interface method to scroll a rectangular section of window
1096 // if distance=+, Row[Distance] to Row[RowCount-2] UP
1097 // if distance=-, Row[FixedRows+1] to Row[RowCount+Distance] DOWN
1098
1099 OldEditorMode := EditorMode;
1100 if OldEditorMode then
1101 EditorMode := False;
1102
1103 if Distance<>0 then begin
1104
1105 OldRow := Row;
1106 Row := FixedRows + FDataLink.ActiveRecord;
1107 if OldRow=Row then // if OldRow<>NewRow SelectEditor will be called by MoveExtend
1108 SelectEditor; // if OldRow=NewRow we need to manually call SelectEditor
1109
1110 Invalidate;
1111 end else
1112 UpdateActive;
1113
1114 if OldEditorMode and (dgAlwaysShowEditor in Options) then
1115 EditorMode := True;
1116 end;
1117
1118 procedure TCustomDBGrid.OnUpdateData(aDataSet: TDataSet);
1119 begin
1120 {$ifdef dbgDBGrid}
1121 DebugLn('%s.OnUpdateData', [ClassName]);
1122 {$endif}
1123 UpdateData;
1124 end;
1125
1126 procedure TCustomDBGrid.SetColumns(const AValue: TDBGridColumns);
1127 begin
1128 {$ifdef dbgDBGrid}
1129 DebugLn('%s.SetColumns', [ClassName]);
1130 {$endif}
1131 inherited Columns := TGridColumns(AValue);
1132 end;
1133
1134 {
1135 procedure TCustomDBGrid.ReadColumns(Reader: TReader);
1136 begin
1137 Columns.Clear;
1138 Reader.ReadValue;
1139 Reader.ReadCollection(Columns);
1140 end;
1141 procedure TCustomDBGrid.SetColumns(const AValue: TDBGridColumns);
1142 begin
1143 Columns.Assign(AValue);
1144 end;
1145 }
1146 procedure TCustomDBGrid.SetCurrentField(const AValue: TField);
1147 var
1148 i: Integer;
1149 begin
1150 if Avalue<>SelectedField then begin
1151 i := GetGridColumnFromField( AValue );
1152 if (i>=FirstGridColumn) and (i>=FixedCols) then
1153 Col := i;
1154 end;
1155 end;
1156
1157 procedure TCustomDBGrid.SetDataSource(const AValue: TDataSource);
1158 begin
1159 {$ifdef dbgDBGrid}
1160 DebugLn('%s.SetDataSource', [ClassName]);
1161 {$endif}
1162 if AValue = FDatalink.Datasource then Exit;
1163 RenewColWidths;
1164 FDataLink.DataSource := AValue;
1165 UpdateActive;
1166 end;
1167
1168 procedure TCustomDBGrid.SetExtraOptions(const AValue: TDBGridExtraOptions);
1169 var
1170 OldOptions: TDBGridExtraOptions;
IsOptionChangednull1171 function IsOptionChanged(Op: TDBGridExtraOption): boolean;
1172 begin
1173 result := ((op in OldOptions) and not (op in AValue)) or
1174 (not (op in OldOptions) and (op in AValue));
1175 end;
1176 begin
1177 {$ifdef dbgDBGrid}
1178 DebugLn('%s.SetExtraOptions', [ClassName]);
1179 {$endif}
1180 if FExtraOptions=AValue then exit;
1181 OldOptions := FExtraOptions;
1182 FExtraOptions := AValue;
1183
1184 if IsOptionChanged(dgeCheckboxColumn) then
1185 Invalidate;
1186
1187 if IsOptionChanged(dgeAutoColumns) then begin
1188 if dgeAutoColumns in aValue then
1189 AddAutomaticColumns
1190 else if TDBGridColumns(Columns).HasAutomaticColumns then
1191 RemoveAutomaticColumns;
1192 UpdateActive;
1193 end;
1194
1195 end;
1196
1197 procedure TCustomDBGrid.SetFixedRowsExtra(AValue: Integer);
1198 begin
1199 if FFixedRowsExtra = AValue then Exit;
1200 FFixedRowsExtra := AValue;
1201 LayoutChanged;
1202 end;
1203
1204 procedure TCustomDBGrid.SetOptions(const AValue: TDBGridOptions);
1205 var
1206 OldOptions: TGridOptions;
1207 ChangedOptions: TDbGridOptions;
1208 MultiSel: boolean;
1209 begin
1210 {$ifdef dbgDBGrid}
1211 DebugLnEnter('%s.SetOptions INIT', [ClassName]);
1212 {$endif}
1213 if FOptions<>AValue then begin
1214 MultiSel := dgMultiSelect in FOptions;
1215 ChangedOptions := (FOptions-AValue) + (AValue-FOptions);
1216 FOptions:=AValue;
1217 OldOptions := inherited Options;
1218
1219 if dgRowSelect in FOptions then
1220 FOptions := FOptions - [dgEditing, dgAlwaysShowEditor, dgRowHighlight];
1221
1222 BeginLayout;
1223
1224 if dgRowLines in fOptions then
1225 Include(OldOptions, goHorzLine)
1226 else
1227 Exclude(OldOptions, goHorzLine);
1228
1229 if dgColLines in fOptions then
1230 Include(OldOptions, goVertLine)
1231 else
1232 Exclude(OldOptions, goVertLine);
1233
1234 if dgColumnResize in fOptions then
1235 Include(OldOptions, goColSizing)
1236 else
1237 Exclude(OldOptions, goColSizing);
1238
1239 if dgColumnMove in fOptions then
1240 Include(OldOptions, goColMoving)
1241 else
1242 Exclude(OldOptions, goColMoving);
1243
1244 if dgAlwaysShowEditor in FOptions then
1245 Include(OldOptions, goAlwaysShowEditor)
1246 else
1247 Exclude(OldOptions, goAlwaysShowEditor);
1248
1249 if dgRowSelect in FOptions then
1250 Include(OldOptions, goRowSelect)
1251 else
1252 Exclude(OldOptions, goRowSelect);
1253
1254 if dgEditing in FOptions then
1255 Include(OldOptions, goEditing)
1256 else
1257 Exclude(OldOptions, goediting);
1258
1259 if dgTabs in FOptions then
1260 Include(OldOptions, goTabs)
1261 else
1262 Exclude(OldOptions, goTabs);
1263
1264 if dgHeaderHotTracking in FOptions then
1265 Include(OldOptions, goHeaderHotTracking)
1266 else
1267 Exclude(OldOptions, goHeaderHotTracking);
1268
1269 if dgHeaderPushedLook in FOptions then
1270 Include(OldOptions, goHeaderPushedLook)
1271 else
1272 Exclude(OldOptions, goHeaderPushedLook);
1273
1274 if dgCellHints in FOptions then
1275 Include(OldOptions, goCellHints)
1276 else
1277 Exclude(OldOptions, goCellHints);
1278
1279 if dgTruncCellHints in FOptions then
1280 Include(OldOptions, goTruncCellHints)
1281 else
1282 Exclude(OldOptions, goTruncCellHints);
1283
1284 if dgCellEllipsis in FOptions then
1285 Include(OldOptions, goCellEllipsis)
1286 else
1287 Exclude(OldOptions, goCellEllipsis);
1288
1289 if dgRowHighlight in FOptions then
1290 Include(OldOptions, goRowHighlight)
1291 else
1292 Exclude(OldOptions, goRowHighlight);
1293
1294 if dgDblClickAutoSize in FOptions then
1295 Include(OldOptions, goDblClickAutoSize)
1296 else
1297 Exclude(OldOptions, goDblClickAutoSize);
1298
1299 if (dgIndicator in ChangedOptions) then begin
1300 if (dgIndicator in FOptions) then
1301 FixedCols := FixedCols + 1
1302 else
1303 FixedCols := Max(FixedCols - 1, 0);
1304 end;
1305
1306 if (dgTitles in ChangedOptions) then begin
1307 if dgTitles in FOptions then
1308 FixedRows := FixedRows + 1
1309 else
1310 FixedRows := Max(FixedRows - 1, 0);
1311 end;
1312
1313 if (dgAutoSizeColumns in ChangedOptions) then begin
1314 Exclude(FGridStatus, gsAutoSized);
1315 end;
1316
1317 if dgThumbTracking in ChangedOptions then begin
1318 if dgThumbTracking in FOptions then
1319 Include(OldOptions, goThumbTracking)
1320 else
1321 Exclude(OldOptions, goThumbTracking);
1322 end;
1323
1324 inherited Options := OldOptions;
1325
1326 if MultiSel and not (dgMultiSelect in FOptions) then begin
1327 FSelectedRows.Clear;
1328 end;
1329
1330 EndLayout;
1331 end;
1332 {$ifdef dbgDBGrid}
1333 DebugLnExit('%s.SetOptions DONE', [ClassName]);
1334 {$endif}
1335 end;
1336
1337 procedure TCustomDBGrid.SetRowMoved(AValue: TMovedEvent);
1338 begin
1339 if FOnRowMoved = AValue then
1340 Exit;
1341 FOnRowMoved := AValue;
1342 if assigned(OnRowMoved) then
1343 inherited Options := inherited Options + [goRowMoving]
1344 else
1345 inherited Options := inherited Options - [goRowMoving];
1346 end;
1347
1348 procedure TCustomDBGrid.SetSelectedIndex(const AValue: Integer);
1349 begin
1350 Col := FirstGridColumn + AValue;
1351 end;
1352
1353 procedure TCustomDBGrid.UpdateBufferCount;
1354 var
1355 BCount: Integer;
1356 begin
1357 {$ifdef dbgDBGrid}
1358 DebugLnEnter('%s.UpdateBufferCount INIT', [ClassName]);
1359 {$endif}
1360 if FDataLink.Active then begin
1361 BCount := GetBufferCount;
1362 if BCount<1 then
1363 BCount := 1;
1364 FDataLink.BufferCount:= BCount;
1365 end;
1366 {$ifdef dbgDBGrid}
1367 DebugLnExit('%s.UpdateBufferCount DONE BufferCount=%d', [ClassName, FDataLink.BufferCount]);
1368 {$endif}
1369 end;
1370
1371 procedure TCustomDBGrid.UpdateData;
1372 var
1373 selField,edField: TField;
1374 LookupKeyValues: Variant;
1375 begin
1376 // get Editor text and update field content
1377 if not UpdatingData and (FEditingColumn>-1) and FDatalink.Editing then begin
1378 SelField := SelectedField;
1379 edField := GetFieldFromGridColumn(FEditingColumn);
1380
1381 if (edField<>nil) and (edField = SelField) then begin
1382 {$ifdef dbgDBGrid}
1383 DebugLnEnter('%s.UpdateData INIT Field[%s(%s)]=%s',
1384 [ClassName, edField.Fieldname ,edField.AsString, FTempText]);
1385 {$endif}
1386
1387 StartUpdating;
1388 try
1389 edField.Text := FTempText;
1390 if edField.FieldKind = fkLookup then
1391 begin
1392 LookupKeyValues := Null;
1393 if edField.LookupCache then
1394 LookupKeyValues := edField.LookupList.FirstKeyByValue(FTempText)
1395 else
1396 begin
1397 LookupGetBookMark(edField);
1398 try
1399 if edField.LookupDataSet.Locate(edField.LookupResultField,
1400 VarArrayOf([FTempText]), []) then
1401 LookupKeyValues :=
1402 edField.LookupDataSet.FieldValues[edField.LookupKeyFields];
1403 finally
1404 LookupGotoBookMark(edField);
1405 end;
1406 end;
1407 edField.DataSet.FieldValues[edField.KeyFields] := LookupKeyValues;
1408 end;
1409 finally
1410 EndUpdating;
1411 end;
1412 EditingColumn(FEditingColumn, False);
1413 {$ifdef dbgDBGrid}
1414 DebugLnExit('%s.UpdateData DONE Field=%s',[ClassName, edField.ASString]);
1415 {$endif}
1416 end;
1417
1418 end;
1419 end;
1420
1421 {$ifdef dbgDBGrid}
SBCodeToStrnull1422 function SBCodeToStr(Code: Integer): String;
1423 begin
1424 Case Code of
1425 SB_LINEUP : result := 'SB_LINEUP';
1426 SB_LINEDOWN: result := 'SB_LINEDOWN';
1427 SB_PAGEUP: result := 'SB_PAGEUP';
1428 SB_PAGEDOWN: result := 'SB_PAGEDOWN';
1429 SB_THUMBTRACK: result := 'SB_THUMBTRACK';
1430 SB_THUMBPOSITION: result := 'SB_THUMBPOSITION';
1431 SB_ENDSCROLL: result := 'SB_SCROLLEND';
1432 SB_TOP: result := 'SB_TOP';
1433 SB_BOTTOM: result := 'SB_BOTTOM';
1434 else result :=IntToStr(Code)+ ' -> ?';
1435 end;
1436 end;
1437 {$endif}
1438
1439 procedure TCustomDBGrid.WMVScroll(var Message: TLMVScroll);
1440 var
1441 IsSeq: boolean;
1442 aPos, aRange, aPage: Integer;
1443 DeltaRec: integer;
1444
MaxPosnull1445 function MaxPos: Integer;
1446 begin
1447 if IsSeq then
1448 result := GetRecordCount - 1
1449 else
1450 result := 4;
1451 end;
1452
1453 procedure DsMoveBy(Delta: Integer);
1454 begin
1455 FDataLink.MoveBy(Delta);
1456 GetScrollbarParams(aRange, aPage, aPos);
1457 end;
1458
1459 procedure DsGoto(BOF: boolean);
1460 begin
1461 if BOF then FDatalink.DataSet.First
1462 else FDataLink.DataSet.Last;
1463 GetScrollbarParams(aRange, aPage, aPos);
1464 end;
1465
DsPosnull1466 function DsPos: boolean;
1467 var
1468 oldMaxPos: Integer;
1469 begin
1470 result := false;
1471 aPos := Message.Pos;
1472 if aPos=FOldPosition then begin
1473 result := true;
1474 exit;
1475 end;
1476 oldMaxPos := MaxPos;
1477 if aPos>=oldMaxPos then
1478 dsGoto(False)
1479 else if aPos<=0 then
1480 dsGoto(True)
1481 else if IsSeq then begin
1482 FDatalink.DataSet.RecNo := aPos + 1;
1483 {$IFDEF MSWINDOWS}
1484 // Workaround for scrollbar range not being updated
1485 // probably only needed under windows, issue 33799
1486 if oldMaxPos<>MaxPos then begin
1487 ScrollBarShow(SB_VERT, false);
1488 ScrollBarShow(SB_VERT, true);
1489 end;
1490 {$ENDIF}
1491 end
1492 else begin
1493 DeltaRec := Message.Pos - FOldPosition;
1494 if DeltaRec=0 then begin
1495 result := true;
1496 exit
1497 end
1498 else if DeltaRec<-1 then
1499 DsMoveBy(-VisibleRowCount)
1500 else if DeltaRec>1 then
1501 DsMoveBy(VisibleRowCount)
1502 else
1503 DsMoveBy(DeltaRec);
1504 end;
1505 end;
1506
1507 begin
1508 if not FDatalink.Active then exit;
1509
1510 {$ifdef dbgDBGrid}
1511 DebugLnEnter('%s.WMVScroll INIT Code=%s Position=%s OldPos=%s',
1512 [ClassName, SbCodeToStr(Message.ScrollCode), dbgs(Message.Pos), Dbgs(FOldPosition)]);
1513 {$endif}
1514
1515 aPos := 0;
1516 IsSeq := FDatalink.DataSet.IsSequenced and not FDataLink.DataSet.Filtered;
1517 case Message.ScrollCode of
1518 SB_TOP:
1519 DsGoto(True);
1520 SB_BOTTOM:
1521 DsGoto(False);
1522 SB_PAGEUP:
1523 DsMoveBy(-VisibleRowCount);
1524 SB_LINEUP:
1525 DsMoveBy(-1);
1526 SB_LINEDOWN:
1527 DsMoveBy(1);
1528 SB_PAGEDOWN:
1529 DsMoveBy(VisibleRowCount);
1530 SB_THUMBPOSITION:
1531 if DsPos then
1532 exit;
1533 SB_THUMBTRACK:
1534 if dgThumbTracking in Options then begin
1535 if not (FDatalink.DataSet.IsSequenced) or DsPos then begin
1536 {$ifdef dbgDBGrid}
1537 DebugLnExit('%s.WMVScroll EXIT: SB_THUMBTRACK: DsPos or not sequenced', [ClassName]);
1538 {$endif}
1539 exit;
1540 end;
1541 end else begin
1542 {$ifdef dbgDBGrid}
1543 DebugLnExit('%s.WMVScroll EXIT: SB_THUMBTRACK: not using dgThumbTracking', [ClassName]);
1544 {$endif}
1545 Exit;
1546 end;
1547 else begin
1548 {$ifdef dbgDBGrid}
1549 DebugLnExit('%s.WMVScroll EXIT: invalid ScrollCode: %d', [ClassName, message.ScrollCode]);
1550 {$endif}
1551 Exit;
1552 end;
1553 end;
1554
1555 ScrollBarPosition(SB_VERT, aPos);
1556 FOldPosition:=aPos;
1557
1558 if EditorMode then
1559 RestoreEditor;
1560 {$ifdef dbgDBGrid}
1561 DebugLnExit('%s.WMVScroll DONE Diff=%s FinalPos=%s', [ClassName, dbgs(DeltaRec), dbgs(aPos)]);
1562 {$endif}
1563 end;
1564
1565 procedure TCustomDBGrid.WndProc(var TheMessage: TLMessage);
1566 begin
1567 if (TheMessage.Msg=LM_SETFOCUS) and (gsUpdatingData in FGridStatus) then begin
1568 {$ifdef dbgGrid}DebugLn('%s.LM_SETFOCUS while updating', [ClassName]);{$endif}
1569 if EditorMode then begin
1570 LCLIntf.SetFocus(Editor.Handle);
1571 EditorSelectAll;
1572 end;
1573 exit;
1574 end;
1575 inherited WndProc(TheMessage);
1576 end;
1577
1578
TCustomDBGrid.DefaultFieldColWidthnull1579 function TCustomDBGrid.DefaultFieldColWidth(F: TField): Integer;
1580 begin
1581 if not HandleAllocated or (F=nil) then
1582 result:=DefaultColWidth
1583 else begin
1584 if F.DisplayWidth = 0 then
1585 if Canvas.HandleAllocated then
1586 result := Canvas.TextWidth( F.DisplayName ) + 3
1587 else
1588 Result := DefaultColWidth
1589 else
1590 result := F.DisplayWidth * CalcCanvasCharWidth(Canvas);
1591 end;
1592 end;
1593
TCustomDBGrid.GetColumnCountnull1594 function TCustomDBGrid.GetColumnCount: Integer;
1595 var
1596 i: integer;
1597 F: TField;
1598 begin
1599 result := 0;
1600 if Columns.Enabled then
1601 result := Columns.VisibleCount
1602 else
1603 if (dgeAutoColumns in OptionsExtra) and FDataLink.Active then
1604 for i:=0 to FDataLink.DataSet.FieldCount-1 do begin
1605 F:= FDataLink.DataSet.Fields[i];
1606 if (F<>nil) and F.Visible then
1607 Inc(Result);
1608 end;
1609 end;
1610
1611 // Get the visible field (from dataset fields) that corresponds to given column
GetDsFieldFromGridColumnnull1612 function TCustomDBGrid.GetDsFieldFromGridColumn(Column: Integer): TField;
1613 var
1614 i: Integer;
1615 begin
1616 i := FieldIndexFromGridColumn( Column );
1617 if i>=0 then
1618 Result := FDataLink.DataSet.Fields[i]
1619 else
1620 Result := nil;
1621 end;
1622
FirstGridColumnnull1623 function TCustomDBGrid.FirstGridColumn: Integer;
1624 begin
1625 if (dgIndicator in Options) then
1626 Result := 1
1627 else
1628 Result := 0;
1629 end;
1630
1631 procedure TCustomDBGrid.PrepareCellHints(aCol, aRow: Integer);
1632 begin
1633 if not DataLink.Active then Exit;
1634 FSavedRecord := DataLink.ActiveRecord;
1635 DataLink.ActiveRecord := ARow - FixedRows;
1636 end;
1637
1638 procedure TCustomDBGrid.UnprepareCellHints;
1639 begin
1640 if not DataLink.Active then Exit;
1641 DataLink.ActiveRecord := FSavedRecord;
1642 end;
1643
GetCellHintTextnull1644 function TCustomDBGrid.GetCellHintText(aCol, aRow: Integer): String;
1645 var
1646 C: TColumn;
1647 begin
1648 Result := '';
1649 if (ARow < FixedRows) then
1650 exit;
1651 if Assigned(FOnGetCellHint) then begin
1652 C := ColumnFromGridColumn(ACol) as TColumn;
1653 FOnGetCellHint(self, C, Result);
1654 end;
1655 end;
1656
GetTruncCellHintTextnull1657 function TCustomDBGrid.GetTruncCellHintText(aCol, aRow: Integer): string;
1658 var
1659 F: TField;
1660 C: TColumn;
1661 begin
1662 Result := '';
1663 if ARow < FixedRows then
1664 exit;
1665 F := GetFieldFromGridColumn(ACol);
1666 if (F <> nil) then
1667 if CheckDisplayMemo(f) then
1668 result := F.AsString
1669 else
1670 if (F.DataType <> ftBlob) then
1671 Result := F.DisplayText
1672 else
1673 Result := '(blob)';
1674 // pass to OnGetCellHint() only if chpTruncOnly
1675 if Assigned(OnGetCellHint) and (CellHintPriority = chpTruncOnly) then begin
1676 C := ColumnFromGridColumn(ACol) as TColumn;
1677 FOnGetCellHint(self, C, Result);
1678 end;
1679 end;
1680
1681 // obtain the field either from a Db column or directly from dataset fields
TCustomDBGrid.GetFieldFromGridColumnnull1682 function TCustomDBGrid.GetFieldFromGridColumn(Column: Integer): TField;
1683 var
1684 i: integer;
1685 begin
1686 if Columns.Enabled then begin
1687 i := ColumnIndexFromGridColumn( Column );
1688 if i>=0 then
1689 result := TDBGridColumns(Columns)[i].FField
1690 else
1691 result := nil;
1692 end else
1693 result := GetDsFieldFromGridColumn(Column);
1694 end;
1695
1696 // obtain the corresponding grid column for the given field
GetGridColumnFromFieldnull1697 function TCustomDBGrid.GetGridColumnFromField(F: TField): Integer;
1698 var
1699 i: Integer;
1700 begin
1701 result := -1;
1702 for i:=FirstGridColumn to ColCount-1 do begin
1703 if GetFieldFromGridColumn(i) = F then begin
1704 result := i;
1705 break;
1706 end;
1707 end;
1708 end;
1709
1710 procedure TCustomDBGrid.GetImageForCheckBox(const aCol, aRow: Integer;
1711 CheckBoxView: TCheckBoxState; var ImageList: TCustomImageList;
1712 var ImageIndex: TImageIndex; var Bitmap: TBitmap);
1713 begin
1714 inherited GetImageForCheckBox(aCol, aRow, CheckBoxView, ImageList, ImageIndex, Bitmap);
1715 if Assigned(OnUserCheckboxBitmap) then
1716 OnUserCheckboxBitmap(Self, CheckBoxView, Bitmap);
1717 end;
1718
1719 // obtain the visible field index corresponding to the grid column index
TCustomDBGrid.FieldIndexFromGridColumnnull1720 function TCustomDBGrid.FieldIndexFromGridColumn(AGridCol: Integer): Integer;
1721 var
1722 i: Integer;
1723 Column: TColumn;
1724 begin
1725 result := -1;
1726 if not FDatalink.Active then
1727 exit;
1728
1729 if Columns.Enabled then begin
1730 Column := TColumn(ColumnFromGridColumn(AGridCol));
1731 if (Column<>nil) and (Column.Field<>nil) and Column.Field.Visible then
1732 Result := FDatalink.Dataset.Fields.IndexOf(Column.Field)
1733 end else begin
1734 AGridCol := AGridCol - FirstGridColumn;
1735 i := 0;
1736 while (AGridCol>=0) and (i<FDatalink.DataSet.FieldCount) do begin
1737 if FDatalink.Fields[i].Visible then begin
1738 Dec(AGridCol);
1739 if AGridCol<0 then begin
1740 Result := i;
1741 break;
1742 end;
1743 end;
1744 inc(i);
1745 end;
1746 end;
1747 end;
1748
GetBufferCountnull1749 function TCustomDBGrid.GetBufferCount: integer;
1750 begin
1751 {$ifdef dbgDBGrid}
1752 DebugLn('%s.GetBufferCount', [ClassName]);
1753 {$endif}
1754 Result := ClientHeight div DefaultRowHeight;
1755 if dgTitles in Options then
1756 Dec(Result, FixedRows);
1757 end;
1758
1759 procedure TCustomDBGrid.UpdateGridColumnSizes;
1760 var
1761 i: Integer;
1762 begin
1763 {$ifdef dbgDBGrid}
1764 DebugLn('%s.UpdateGridColumnSizes', [ClassName]);
1765 {$endif}
1766 if FDefaultColWidths then begin
1767 if dgIndicator in Options then
1768 ColWidths[0]:=Scale96ToFont(12);
1769 if NeedAutoSizeColumns then
1770 UpdateAutoSizeColumns;
1771 end;
1772 end;
1773
1774 procedure TCustomDBGrid.UpdateScrollbarRange;
1775 var
1776 aRange, aPage, aPos: Integer;
1777 ScrollInfo: TScrollInfo;
1778 begin
1779 if not HandleAllocated then exit;
1780
1781 {$ifdef dbgDBGrid}
1782 DebugLnEnter('%s.UpdateScrollbarRange INIT', [ClassName]);
1783 {$endif}
1784
1785 GetScrollBarParams(aRange, aPage, aPos);
1786
1787 if (ScrollBars in [ssBoth, ssVertical])
1788 or ((Scrollbars in [ssAutoVertical, ssAutoBoth]) and (aRange>aPage)) then
1789 begin
1790 FillChar(ScrollInfo, SizeOf(ScrollInfo), 0);
1791 ScrollInfo.cbSize := SizeOf(ScrollInfo);
1792
1793 {TODO: try to move this out}
1794 {$ifdef WINDOWS}
1795 ScrollInfo.fMask := SIF_ALL or SIF_DISABLENOSCROLL;
1796 ScrollInfo.ntrackPos := 0;
1797 {$else}
1798 ScrollInfo.fMask := SIF_ALL or SIF_UPDATEPOLICY;
1799 //ScrollInfo.ntrackPos := SB_POLICY_CONTINUOUS;
1800 ScrollInfo.ntrackPos := SB_POLICY_DISCONTINUOUS;
1801 {$endif}
1802 ScrollInfo.nMin := 0;
1803 ScrollInfo.nMax := aRange;
1804 ScrollInfo.nPos := Min(aPos,aRange-aPage);
1805 ScrollInfo.nPage := aPage;
1806 SetScrollInfo(Handle, SB_VERT, ScrollInfo, True);
1807 end;
1808
1809 FOldPosition := aPos;
1810 {$ifdef dbgDBGrid}
1811 DebugLnExit('%s.UpdateScrollBarRange DONE Handle=%d aRange=%d aPage=%d aPos=%d',
1812 [ClassName, Handle, aRange, aPage, aPos]);
1813 {$endif}
1814 end;
1815
1816 procedure TCustomDBGrid.DoLayoutChanged;
1817 begin
1818 if csDestroying in ComponentState then
1819 exit;
1820 {$ifdef dbgDBGrid}DebugLnEnter('%s.doLayoutChanged INIT', [ClassName]);{$endif}
1821 BeginUpdate;
1822 if UpdateGridCounts=0 then
1823 EmptyGrid;
1824 EndUpdate;
1825 UpdateScrollbarRange;
1826 {$ifdef dbgDBGrid}DebugLnExit('%s.doLayoutChanged DONE', [ClassName]);{$endif}
1827 end;
1828 {
1829 procedure TCustomDBGrid.WriteColumns(Writer: TWriter);
1830 begin
1831 if Columns.IsDefault then
1832 Writer.WriteCollection(nil)
1833 else
1834 Writer.WriteCollection(Columns);
1835 end;
1836 }
1837 procedure TCustomDBGrid.RestoreEditor;
1838 begin
1839 if EditorMode then begin
1840 EditorMode := False;
1841 EditorMode := True;
1842 end;
1843 end;
1844
ISEOFnull1845 function TCustomDBGrid.ISEOF: boolean;
1846 begin
1847 {$ifdef dbgDBGrid}
1848 DebugLn('%s.IsEOF', [ClassName]);
1849 {$endif}
1850 Result := FDatalink.Active and FDatalink.DataSet.EOF;
1851 end;
1852
TCustomDBGrid.ValidDataSetnull1853 function TCustomDBGrid.ValidDataSet: boolean;
1854 begin
1855 {$ifdef dbgDBGrid}
1856 DebugLn('%s.ValidDataSet', [ClassName]);
1857 {$endif}
1858 Result := FDatalink.Active And (FDatalink.DataSet<>nil)
1859 end;
1860
InsertCancelablenull1861 function TCustomDBGrid.InsertCancelable: boolean;
1862 begin
1863 with FDatalink.DataSet do
1864 Result := (State=dsInsert) and not (Modified or FDataLink.FModified);
1865 end;
1866
1867 procedure TCustomDBGrid.StartUpdating;
1868 begin
1869 if not UpdatingData then begin
1870 {$ifdef dbgDBGrid}DebugLn('%s.StartUpdating', [ClassName]);{$endif}
1871 Include(FGridStatus, gsUpdatingData);
1872 FOldControlStyle := ControlStyle;
1873 ControlStyle := ControlStyle + [csActionClient];
1874 LockEditor;
1875 end
1876 else
1877 {$ifdef dbgDBGrid}DebugLn('WARNING: multiple calls to StartUpdating');{$endif}
1878 end;
1879
1880 procedure TCustomDBGrid.EndUpdating;
1881 begin
1882 {$ifdef dbgDBGrid}DebugLn('%s.EndUpdating', [ClassName]);{$endif}
1883 Exclude(FGridStatus, gsUpdatingData);
1884 ControlStyle := FOldControlStyle;
1885 UnLockEditor;
1886 if csActionClient in ControlStyle then
1887 DebugLn('WARNING: still got csActionClient');
1888 end;
1889
TCustomDBGrid.UpdatingDatanull1890 function TCustomDBGrid.UpdatingData: boolean;
1891 begin
1892 result := gsUpdatingData in FGridStatus;
1893 end;
1894
1895 procedure TCustomDBGrid.AddAutomaticColumns;
1896 var
1897 i: Integer;
1898 F: TField;
1899 begin
1900 // add as many columns as there are fields in the dataset
1901 // do this only at runtime.
1902 if (csDesigning in ComponentState) or not FDatalink.Active or
1903 (gsRemovingAutoColumns in FGridStatus) or (gsLoadingGrid in FGridStatus) or
1904 not (dgeAutoColumns in OptionsExtra)
1905 then
1906 exit;
1907 Include(FGridStatus, gsAddingAutoColumns);
1908 try
1909 for i:=0 to FDataLink.DataSet.FieldCount-1 do begin
1910
1911 F:= FDataLink.DataSet.Fields[i];
1912
1913 if TDBGridColumns(Columns).ColumnFromField(F) <> nil then
1914 // this field is already in the collection. This could only happen
1915 // if AddAutomaticColumns was called out of LayoutChanged.
1916 // to avoid duplicate columns skip this field.
1917 continue;
1918
1919 if (F<>nil) then begin
1920 with TDBGridColumns(Columns).Add do begin
1921 FIsAutomaticColumn := True;
1922 Field := F;
1923 Visible := F.Visible;
1924 end;
1925 end;
1926
1927 end;
1928 // honor the field.index
1929 TDBGridColumns(Columns).ResetColumnsOrder(coFieldIndexOrder);
1930 finally
1931 Exclude(FGridStatus, gsAddingAutoColumns);
1932 end;
1933 end;
1934
1935 procedure TCustomDBGrid.AssignTo(Dest: TPersistent);
1936 begin
1937 if Dest is TCustomDbGrid then begin
1938 // TODO
1939 end else
1940 inherited AssignTo(Dest);
1941 end;
1942
1943 procedure TCustomDBGrid.AutoAdjustColumn(aCol: Integer);
1944 var
1945 DatalinkActive: Boolean;
1946 CurActiveRecord: Integer;
1947 tmpCanvas: TCanvas;
1948 begin
1949 BeginLayout;
1950
1951 DatalinkActive := FDatalink.Active;
1952 if DatalinkActive then
1953 CurActiveRecord := FDatalink.ActiveRecord;
1954
1955 tmpCanvas := GetWorkingCanvas(Canvas);
1956 try
1957
1958 InternalAutoSizeColumn(aCol,tmpCanvas,DatalinkActive);
1959
1960 finally
1961 if TmpCanvas<>Canvas then
1962 FreeWorkingCanvas(tmpCanvas);
1963
1964 if DatalinkActive then
1965 FDatalink.ActiveRecord := CurActiveRecord;
1966
1967 EndLayout;
1968 end;
1969 end;
1970
1971 procedure TCustomDBGrid.UpdateAutoSizeColumns;
1972 var
1973 ACol: Integer;
1974 DatalinkActive: boolean;
1975 CurActiveRecord: Integer;
1976 tmpCanvas: TCanvas;
1977 begin
1978 if gsAutoSized in GridStatus then
1979 exit;
1980
1981 BeginLayout;
1982
1983 DatalinkActive := FDatalink.Active;
1984 if DatalinkActive then
1985 CurActiveRecord := FDatalink.ActiveRecord;
1986
1987 tmpCanvas := GetWorkingCanvas(Canvas);
1988 try
1989
1990 for aCol:=FixedCols to ColCount-1 do
1991 InternalAutoSizeColumn(ACol,tmpCanvas,DatalinkActive);
1992
1993 finally
1994 if TmpCanvas<>Canvas then
1995 FreeWorkingCanvas(tmpCanvas);
1996
1997 if DatalinkActive then
1998 FDatalink.ActiveRecord := CurActiveRecord;
1999
2000 include(FGridStatus, gsAutoSized);
2001
2002 EndLayout;
2003 end;
2004
2005 end;
2006
2007 procedure TCustomDBGrid.SwapCheckBox;
2008 var
2009 SelField: TField;
2010 TempColumn: TColumn;
2011 begin
2012 if not GridCanModify then
2013 exit;
2014
2015 SelField := SelectedField;
2016 TempColumn := TColumn(ColumnFromGridColumn(Col));
2017 if (SelField<>nil) and (TempColumn<>nil) and not TempColumn.ReadOnly and
2018 FDatalink.Edit then
2019 begin
2020 if SelField.DataType=ftBoolean then
2021 SelField.AsBoolean := not SelField.AsBoolean
2022 else
2023 begin
2024 if TempColumn.ValueChecked=SelField.AsString then
2025 SelField.AsString := TempColumn.ValueUnchecked
2026 else
2027 SelField.AsString := TempColumn.ValueChecked;
2028 end;
2029 end;
2030 end;
2031
2032 procedure TCustomDBGrid.ToggleSelectedRow;
2033 begin
2034 SelectRecord(not FSelectedRows.CurrentRowSelected);
2035 end;
2036
2037 procedure TCustomDBGrid.LinkActive(Value: Boolean);
2038 begin
2039 {$ifdef dbgDBGrid}
2040 DebugLn('%s.LinkActive', [ClassName]);
2041 {$endif}
2042 if not Value then begin
2043 FSelectedRows.Clear;
2044 RemoveAutomaticColumns;
2045 end;
2046 LayoutChanged;
2047 end;
2048
2049 procedure TCustomDBGrid.LayoutChanged;
2050 begin
2051 {$ifdef dbgDBGrid}
2052 DebugLn('%s.LayoutChanged', [ClassName]);
2053 {$endif}
2054 if csDestroying in ComponentState then
2055 exit;
2056 if FLayoutChangedCount=0 then begin
2057 BeginLayout;
2058 if Columns.Count>0 then
2059 TDBGridColumns(Columns).LinkFields
2060 else if not FDataLink.Active then
2061 FDataLink.BufferCount := 0
2062 else
2063 AddAutomaticColumns;
2064 EndLayout;
2065 end;
2066 end;
2067
2068 procedure TCustomDBGrid.Loaded;
2069 begin
2070 {$ifdef dbgDBGrid}
2071 DebugLn('%s.Loaded', [ClassName]);
2072 {$endif}
2073 LayoutChanged;
2074 inherited Loaded;
2075 end;
2076
2077 procedure TCustomDBGrid.LoadGridOptions(cfg: TXMLConfig; Version: Integer);
2078 var
2079 Opt: TDBGridOptions;
2080 Path: string;
2081 procedure GetValue(optStr:string; aOpt:TDBGridOption);
2082 begin
2083 if Cfg.GetValue(Path+OptStr+'/value', False) then Opt:=Opt+[aOpt];
2084 end;
2085 begin
2086 Opt:=[];
2087 Path:='grid/design/options/';
2088 GetValue('dgEditing', dgEditing);
2089 GetValue('dgTitles', dgTitles);
2090 GetValue('dgIndicator', dgIndicator);
2091 GetValue('dgColumnResize', dgColumnResize);
2092 GetValue('dgColumnMove', dgColumnMove);
2093 GetValue('dgColLines', dgColLines);
2094 GetValue('dgRowLines', dgRowLines);
2095 GetValue('dgTabs', dgTabs);
2096 GetValue('dgAlwaysShowEditor', dgAlwaysShowEditor);
2097 GetValue('dgRowSelect', dgRowSelect);
2098 GetValue('dgAlwaysShowSelection', dgAlwaysShowSelection);
2099 GetValue('dgConfirmDelete', dgConfirmDelete);
2100 GetValue('dgCancelOnExit', dgCancelOnExit);
2101 GetValue('dgMultiselect', dgMultiselect);
2102 GetValue('dgHeaderHotTracking', dgHeaderHotTracking);
2103 GetValue('dgHeaderPushedLook', dgHeaderPushedLook);
2104 GetValue('dgPersistentMultiSelect', dgPersistentMultiSelect);
2105 GetValue('dgAutoSizeColumns', dgAutoSizeColumns);
2106 GetValue('dgAnyButtonCanSelect', dgAnyButtonCanSelect);
2107 GetValue('dgDisableDelete', dgDisableDelete);
2108 GetValue('dgDisableInsert', dgDisableInsert);
2109 GetValue('dgCellHints', dgCellHints);
2110 GetValue('dgTruncCellHints', dgTruncCellHints);
2111 GetValue('dgCellEllipsis', dgCellEllipsis);
2112 GetValue('dgRowHighlight', dgRowHighlight);
2113 GetValue('dgThumbTracking', dgThumbTracking);
2114 Options:=Opt;
2115 end;
2116
2117 type
2118 TProtFields=class(TFields)
2119 end;
2120
2121 procedure TCustomDBGrid.ColRowMoved(IsColumn: Boolean; FromIndex,
2122 ToIndex: Integer);
2123 var
2124 F: TField;
2125 begin
2126 if IsColumn then begin
2127 if Columns.Enabled then
2128 inherited ColRowMoved(IsColumn, FromIndex, ToIndex)
2129 else if FDatalink.Active and (FDataLink.DataSet<>nil) then begin
2130 F := GetDsFieldFromGridColumn(FromIndex);
2131 if F<>nil then begin
2132 TProtFields(FDatalink.DataSet.Fields).SetFieldIndex( F, ToIndex - FirstGridColumn );
2133 end;
2134 end;
2135 if Assigned(OnColumnMoved) then
2136 OnColumnMoved(Self, FromIndex, ToIndex);
2137 end
2138 else if Assigned(OnRowMoved) then
2139 OnRowMoved(Self, FromIndex, ToIndex);
2140 end;
2141
ColumnEditorStylenull2142 function TCustomDBGrid.ColumnEditorStyle(aCol: Integer; F: TField): TColumnButtonStyle;
2143 var
2144 gridcol: TGridColumn;
2145 begin
2146 result := cbsAuto;
2147 gridcol := ColumnFromGridColumn(aCol);
2148 if Columns.Enabled and assigned(gridcol) then
2149 result := gridcol.ButtonStyle;
2150
2151 result := DefaultEditorStyle(result, F);
2152 end;
2153
CreateColumnsnull2154 function TCustomDBGrid.CreateColumns: TGridColumns;
2155 begin
2156 {$ifdef dbgDBGrid}
2157 DebugLn('%s.CreateColumns', [ClassName]);
2158 {$endif}
2159 result := TDBGridColumns.Create(Self, TColumn);
2160 end;
2161
2162 procedure TCustomDBGrid.CreateWnd;
2163 begin
2164 {$ifdef dbgDBGrid}
2165 DebugLn('%s.CreateWnd', [ClassName]);
2166 {$endif}
2167 inherited CreateWnd;
2168 LayoutChanged;
2169 if Scrollbars in [ssBoth, ssVertical, ssAutoBoth, ssAutoVertical] then
2170 ScrollBarShow(SB_VERT, True);
2171 end;
2172
2173 procedure TCustomDBGrid.DefineProperties(Filer: TFiler);
2174 {
2175 function HasColumns: boolean;
2176 var
2177 C: TGridColumns;
2178 begin
2179 if Filer.Ancestor <> nil then
2180 C := TCustomGrid(Filer.Ancestor).Columns
2181 else
2182 C := Columns;
2183 if C<>nil then
2184 result := not C.IsDefault
2185 else
2186 result := false;
2187 end;
2188 }
2189 begin
2190 // simply avoid to call TCustomGrid.DefineProperties method
2191 // which defines ColWidths,Rowheights,Cells
2192 //Filer.DefineProperty('Columns', @ReadColumns, @WriteColumns, HasColumns);
2193 end;
2194
2195 procedure TCustomDBGrid.DefaultDrawCell(aCol, aRow: Integer; aRect: TRect;
2196 aState: TGridDrawState);
2197
2198 var
2199 S: string;
2200 F: TField;
2201 cbs: TColumnButtonStyle;
2202 begin
2203
2204 DrawCellBackground(aCol, aRow, aRect, aState);
2205
2206 if gdFixed in aState then
2207 DrawFixedText(aCol, aRow, aRect, aState)
2208 else
2209 if not FDrawingEmptyDataset then begin
2210
2211 F := GetFieldFromGridColumn(aCol);
2212 cbs := ColumnEditorStyle(aCol, F);
2213 case cbs of
2214 cbsCheckBoxColumn:
2215 DrawCheckBoxBitmaps(aCol, aRect, F);
2216 else
2217 begin
2218
2219 if cbs=cbsButtonColumn then
2220 DrawButtonCell(aCol, aRow, aRect, aState);
2221
2222 {$ifdef dbggridpaint}
2223 DbgOut(' Col=%d',[ACol]);
2224 {$endif}
2225 if F<>nil then begin
2226 {$ifdef dbgGridPaint}
2227 DbgOut(' Field=%s',[F.FieldName]);
2228 {$endif}
2229 if CheckDisplayMemo(F) then
2230 S := F.AsString
2231 else
2232 S := F.DisplayText;
2233 end else
2234 S := '';
2235 {$ifdef dbggridpaint}
2236 DbgOut(' Value=%s ',[S]);
2237 {$endif}
2238 DrawCellText(aCol,aRow,aRect,aState,S);
2239 end;
2240 end;
2241 end;
2242 end;
2243
TCustomDBGrid.DefaultEditorStylenull2244 function TCustomDBGrid.DefaultEditorStyle(const Style: TColumnButtonStyle;
2245 const F: TField): TColumnButtonStyle;
2246 begin
2247 result := Style;
2248 if (Result=cbsAuto) and (F<>nil) then
2249 case F.DataType of
2250 ftBoolean: Result := cbsCheckboxColumn;
2251 end;
2252 if (result = cbsCheckBoxColumn) and not (dgeCheckboxColumn in FExtraOptions) then
2253 Result := cbsAuto;
2254 end;
2255
2256 procedure TCustomDBGrid.DoCopyToClipboard;
2257 var
2258 F: TField;
2259 begin
2260 // copy current field to clipboard
2261 if not FDatalink.Active then
2262 exit;
2263 F := GetFieldFromGridColumn(Col);
2264 if F<>nil then
2265 Clipboard.AsText := F.AsString;
2266 end;
2267
2268 procedure TCustomDBGrid.DoOnChangeBounds;
2269 begin
2270 BeginUpdate;
2271 inherited DoOnChangeBounds;
2272 if HandleAllocated then
2273 LayoutChanged;
2274 EndUpdate;
2275 end;
2276
2277 procedure TCustomDBGrid.DoPrepareCanvas(aCol, aRow: Integer;
2278 aState: TGridDrawState);
2279 var
2280 DataCol: Integer;
2281 IsSelected: boolean;
2282 begin
2283 if (ARow>=FixedRows) then begin
2284
2285 if not DefaultDrawing then begin
2286 GetSelectedState(aState, IsSelected);
2287 if IsSelected then begin
2288 Canvas.Brush.Color := SelectedColor;
2289 Canvas.Font.Color := clHighlightText;
2290 end;
2291 end;
2292
2293 if Assigned(OnPrepareCanvas) then begin
2294 DataCol := ColumnIndexFromGridColumn(aCol);
2295 if DataCol>=0 then
2296 OnPrepareCanvas(Self, DataCol, TColumn(Columns[DataCol]), aState);
2297 end;
2298
2299 end;
2300 end;
2301
2302 procedure TCustomDBGrid.DoLoadColumn(sender: TCustomGrid; aColumn: TGridColumn;
2303 aColIndex: Integer; aCfg: TXMLConfig; aVersion: Integer; aPath: string);
2304 var
2305 c: TColumn;
2306 s: string;
2307 begin
2308 c:=TColumn(aColumn);
2309 s := aCfg.GetValue(aPath + '/fieldname/value', '');
2310 if s<>'' then
2311 c.FieldName := s;
2312 s := aCfg.GetValue(aPath + '/displayformat/value', '');
2313 if s<>'' then
2314 c.DisplayFormat := s;
2315 inherited DoLoadColumn(sender, aColumn, aColIndex, aCfg, aVersion, aPath);
2316 end;
2317
2318 procedure TCustomDBGrid.DoSaveColumn(sender: TCustomGrid; aColumn: TGridColumn;
2319 aColIndex: Integer; aCfg: TXMLConfig; aVersion: Integer; aPath: string);
2320 var
2321 c: TColumn;
2322 begin
2323 c:=TColumn(aColumn);
2324 aCfg.SetValue(aPath + '/fieldname/value', c.FieldName);
2325 aCfg.SetValue(aPath + '/displayformat/value', c.DisplayFormat);
2326 inherited DoSaveColumn(sender, aColumn, aColIndex, aCfg, aVersion, aPath);
2327 end;
2328
2329 procedure TCustomDBGrid.BeforeMoveSelection(const DCol,DRow: Integer);
2330 begin
2331 {$ifdef dbgDBGrid}DebugLnEnter('%s.BeforeMoveSelection INIT', [ClassName]);{$endif}
2332 inherited BeforeMoveSelection(DCol, DRow);
2333 if DCol<>Col then begin
2334 if assigned(OnColExit) then
2335 OnColExit(Self);
2336 FColEnterPending:=True;
2337 end;
2338 {$ifdef dbgDBGrid}DebugLnExit('%s.BeforeMoveSelection DONE', [ClassName]);{$endif}
2339 end;
2340
2341 procedure TCustomDBGrid.HeaderClick(IsColumn: Boolean; index: Integer);
2342 begin
2343 {$ifdef dbgDBGrid}
2344 DebugLn('%s.HeaderClick', [ClassName]);
2345 {$endif}
2346 if IsColumn then
2347 DoHeaderClick(Index);
2348 end;
2349
2350 procedure TCustomDBGrid.KeyDown(var Key: Word; Shift: TShiftState);
2351 type
2352 TOperation=(opMoveBy,opCancel,opAppend,opInsert,opDelete);
2353 var
2354 DeltaCol,DeltaRow: Integer;
2355 preSelIndex, posSelIndex: Integer;
2356
2357 procedure DoOnKeyDown;
2358 begin
2359 {$ifdef dbgGrid}DebugLnEnter('DoOnKeyDown INIT');{$endif}
2360 if Assigned(OnKeyDown) then
2361 OnKeyDown(Self, Key, Shift);
2362 {$ifdef dbgGrid}DebugLnExit('DoOnKeyDown DONE');{$endif}
2363 end;
2364
2365 {$ifdef dbgGrid}
OperToStrnull2366 function OperToStr(AOper: TOperation): string;
2367 begin
2368 case AOper of
2369 opMoveBy: result := 'opMoveBy';
2370 opCancel: result := 'opCancel';
2371 opAppend: result := 'opAppend';
2372 opInsert: result := 'opInsert';
2373 opDelete: result := 'opDelete';
2374 end;
2375 end;
2376 {$endif}
2377
2378 procedure DoOperation(AOper: TOperation; Arg: Integer = 0);
2379 begin
2380 {$ifdef dbgGrid}DebugLnEnter('KeyDown.DoOperation(%s,%d) INIT',[OperToStr(AOper),arg]);{$endif}
2381 GridFlags := GridFlags + [gfEditingDone];
2382 case AOper of
2383 opMoveBy:
2384 FDatalink.MoveBy(Arg);
2385 opCancel:
2386 begin
2387 if EditorMode then
2388 EditorCancelEditing;
2389 FDatalink.Dataset.Cancel;
2390 end;
2391 opAppend:
2392 FDatalink.Dataset.Append;
2393 opInsert:
2394 FDatalink.Dataset.Insert;
2395 opDelete:
2396 FDatalink.Dataset.Delete;
2397 end;
2398 GridFlags := GridFlags - [gfEditingDone];
2399 {$ifdef dbgGrid}DebugLnExit('KeyDown.DoOperation(%s,%d) DONE',[OperToStr(AOper),arg]);{$endif}
2400 end;
2401
2402 procedure SelectNext(const AStart,ADown:Boolean);
2403 var
2404 N, curActiveRecord: Integer;
2405 CurBookmark: TBookmark;
2406 begin
2407 if dgPersistentMultiSelect in Options then
2408 exit;
2409
2410 if (ssShift in Shift) then begin
2411 if dgMultiSelect in Options then begin
2412 curBookmark := FDatalink.DataSet.GetBookmark;
2413 try
2414 if AStart then preSelIndex := FSelectedRows.IndexOf(curBookmark)
2415 else posSelIndex := FSelectedRows.IndexOf(curBookmark);
2416 if not AStart then begin
2417 FSelectedRows.CurrentRowSelected := true;
2418 // deal with selection of previous (not prior) record
2419 curActiveRecord := FDatalink.ActiveRecord;
2420 try
2421 if ADown then FDatalink.ActiveRecord := FDatalink.ActiveRecord - 1
2422 else FDatalink.ActiveRecord := FDatalink.ActiveRecord + 1;
2423 if (preSelIndex>=0) and (posSelIndex>=0) then begin
2424 if preSelIndex<>posSelIndex then
2425 FSelectedRows.CurrentRowSelected := false
2426 end else
2427 FSelectedRows.CurrentRowSelected := true;
2428 finally
2429 FDatalink.ActiveRecord := curActiveRecord;
2430 end;
2431 end;
2432 finally
2433 FDatalink.DataSet.FreeBookmark(CurBookmark);
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
2786 P:=MouseToCell(Point(X,Y));
2787 if Gz=gzFixedRows then
2788 P.X := Col;
2789
2790 if P.Y=Row then begin // The current active row was clicked again.
2791 //doAcceptValue;
2792
2793 if ssCtrl in Shift then begin
2794 doMouseDown;
2795 // Don't unselect the row if Right-click was for PopupMenu.
2796 if (Button<>mbRight) or (PopupMenu=Nil) then
2797 ToggleSelectedRow;
2798 end
2799 else begin
2800 if Button=mbLeft then
2801 ClearSelection(true);
2802 if gz=gzFixedRows then begin
2803 fGridState:=gsRowMoving;
2804 ResetLastMove;
2805 doMouseDown;
2806 end
2807 else
2808 doInherited;
2809 end;
2810
2811 end else begin
2812 doMouseDown;
2813 if ValidDataSet then begin
2814 if InsertCancelable and IsEOF then
2815 doCancel;
2816 doMoveBy;
2817 if IsMouseOverCellButton(X, Y) then
2818 StartPushCell;
2819 end;
2820 if ssCtrl in Shift then
2821 ToggleSelectedRow
2822 else begin
2823 if (Button=mbLeft) or (dgAnyButtonCanSelect in Options) then
2824 ClearSelection(true);
2825 // Select row before popupmenu
2826 if (Button=mbRight) and Assigned(PopupMenu) and not FSelectedRows.CurrentRowSelected then
2827 ToggleSelectedRow;
2828 doMoveToColumn;
2829 end;
2830 end;
2831 end;
2832 end;
2833 {$ifdef dbgGrid}DebugLnExit('%s.MouseDown DONE', [ClassName]); {$endif}
2834 end;
2835
2836 procedure TCustomDBGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
2837 begin
2838 if (fGridState=gsSelecting) and not Dragging then begin
2839 if Assigned(OnMouseMove) then
2840 OnMouseMove(Self, Shift, x, y);
2841 exit;
2842 end else
2843 inherited MouseMove(Shift, X, Y);
2844 end;
2845
2846 procedure TCustomDBGrid.PrepareCanvas(aCol, aRow: Integer;
2847 aState: TGridDrawState);
2848 begin
2849 inherited PrepareCanvas(aCol, aRow, aState);
2850
2851 if gdFixed in aState then begin
2852 if gdHot in aState then
2853 Canvas.Brush.Color := FixedHotColor
2854 else
2855 Canvas.Brush.Color := GetColumnColor(aCol, gdFixed in AState);
2856 end;
2857
2858 if (not FDatalink.Active) and ((gdSelected in aState) or (gdFocused in aState)) then
2859 Canvas.Brush.Color := Self.Color;
2860 end;
2861
2862 procedure TCustomDBGrid.RemoveAutomaticColumns;
2863 begin
2864 if not (csDesigning in ComponentState) then
2865 TDBGridColumns(Columns).RemoveAutoColumns;
2866 end;
2867
2868 procedure TCustomDBGrid.ResetSizes;
2869 begin
2870 LayoutChanged;
2871 inherited ResetSizes;
2872 end;
2873
2874 procedure TCustomDBGrid.SaveGridOptions(Cfg: TXMLConfig);
2875 var
2876 Path: string;
2877 begin
2878 Path:='grid/design/options/';
2879 Cfg.SetValue(Path+'dgEditing/value', dgEditing in Options);
2880 Cfg.SetValue(Path+'dgTitles/value', dgTitles in Options);
2881 Cfg.SetValue(Path+'dgIndicator/value', dgIndicator in Options);
2882 Cfg.SetValue(Path+'dgColumnResize/value', dgColumnResize in Options);
2883 Cfg.SetValue(Path+'dgColumnMove/value', dgColumnMove in Options);
2884 Cfg.SetValue(Path+'dgColLines/value', dgColLines in Options);
2885 Cfg.SetValue(Path+'dgRowLines/value', dgRowLines in Options);
2886 Cfg.SetValue(Path+'dgTabs/value', dgTabs in Options);
2887 Cfg.SetValue(Path+'dgAlwaysShowEditor/value', dgAlwaysShowEditor in Options);
2888 Cfg.SetValue(Path+'dgRowSelect/value', dgRowSelect in Options);
2889 Cfg.SetValue(Path+'dgAlwaysShowSelection/value', dgAlwaysShowSelection in Options);
2890 Cfg.SetValue(Path+'dgConfirmDelete/value', dgConfirmDelete in Options);
2891 Cfg.SetValue(Path+'dgCancelOnExit/value', dgCancelOnExit in Options);
2892 Cfg.SetValue(Path+'dgMultiselect/value', dgMultiselect in Options);
2893 Cfg.SetValue(Path+'dgHeaderHotTracking/value', dgHeaderHotTracking in Options);
2894 Cfg.SetValue(Path+'dgHeaderPushedLook/value', dgHeaderPushedLook in Options);
2895 Cfg.SetValue(Path+'dgPersistentMultiSelect/value', dgPersistentMultiSelect in Options);
2896 cfg.SetValue(Path+'dgAutoSizeColumns/value', dgAutoSizeColumns in Options);
2897 cfg.SetValue(Path+'dgAnyButtonCanSelect/value', dgAnyButtonCanSelect in Options);
2898 Cfg.SetValue(Path+'dgDisableDelete/value', dgDisableDelete in Options);
2899 Cfg.SetValue(Path+'dgDisableInsert/value', dgDisableInsert in Options);
2900 Cfg.SetValue(Path+'dgCellHints/value', dgCellHints in Options);
2901 cfg.SetValue(Path+'dgTruncCellHints/value', dgTruncCellHints in Options);
2902 Cfg.SetValue(Path+'dgCellEllipsis/value', dgCellEllipsis in Options);
2903 Cfg.SetValue(Path+'dgRowHighlight/value', dgRowHighlight in Options);
2904 Cfg.SetValue(Path+'dgThumbTracking/value', dgThumbTracking in Options);
2905 end;
2906
2907 procedure TCustomDBGrid.SelectEditor;
2908 var
2909 aEditor: TWinControl;
2910 aMaxLen: integer;
2911 begin
2912 {$ifdef dbgDBGrid}
2913 DebugLnEnter('%s.SelectEditor INIT Editor=%s',[ClassName, dbgsname(editor)]);
2914 {$endif}
2915 if (FDatalink<>nil) and FDatalink.Active then begin
2916 inherited SelectEditor;
2917
2918 if (SelectedField is TStringField) then
2919 aMaxLen := SelectedField.Size
2920 else
2921 aMaxLen := 0;
2922
2923 if (Editor is TCustomEdit) then
2924 TCustomEdit(Editor).MaxLength := aMaxLen
2925 else
2926 if (Editor is TCompositeCellEditor) then
2927 TCompositeCellEditor(Editor).MaxLength := aMaxLen;
2928
2929 if Assigned(OnSelectEditor) then begin
2930 aEditor:=Editor;
2931 OnSelectEditor(Self, SelectedColumn, aEditor);
2932 Editor:=aEditor;
2933 end;
2934 end else
2935 Editor := nil;
2936 {$ifdef dbgDBGrid}
2937 DebugLnExit('%s.SelectEditor DONE Editor=%s',[ClassName, dbgsname(editor)]);
2938 {$endif}
2939 end;
2940
2941 procedure TCustomDBGrid.SetEditText(ACol, ARow: Longint; const Value: string);
2942 begin
2943 FTempText := Value;
2944 end;
2945
2946 procedure TCustomDBGrid.SetFixedCols(const AValue: Integer);
2947 begin
2948 if (FixedCols=AValue) or (AValue<FirstGridColumn) then
2949 exit;
2950 inherited SetFixedCols(AValue);
2951 end;
2952
2953 procedure TCustomDBGrid.BeginLayout;
2954 begin
2955 inc(FLayoutChangedCount);
2956 end;
2957
2958 procedure TCustomDBGrid.EditingColumn(aCol: Integer; Ok: boolean);
2959 begin
2960 {$ifdef dbgDBGrid}DebugLnEnter('%s.EditingColumn INIT aCol=%d Ok=%s',
2961 [ClassName, aCol, BoolToStr(ok, true)]); {$endif}
2962 if Ok then begin
2963 FEditingColumn := aCol;
2964 FDatalink.Modified := True;
2965 end
2966 else
2967 FEditingColumn := -1;
2968 {$ifdef dbgDBGrid} DebugLnExit('%s.EditingColumn DONE', [ClassName]); {$endif}
2969 end;
2970
2971 procedure TCustomDBGrid.EditorCancelEditing;
2972 begin
2973 EditingColumn(FEditingColumn, False); // prevents updating the value
2974 if EditorMode then begin
2975 EditorMode := False;
2976 if dgAlwaysShowEditor in Options then
2977 EditorMode := True;
2978 end;
2979 end;
2980
2981 procedure TCustomDBGrid.EditorDoGetValue;
2982 begin
2983 {$ifdef dbgDBGrid}DebugLnEnter('%s.EditorDoGetValue INIT', [ClassName]);{$endif}
2984 inherited EditordoGetValue;
2985 UpdateData;
2986 {$ifdef dbgDBGrid}DebugLnExit('%s.EditorDoGetValue DONE', [ClassName]);{$endif}
2987 end;
2988
2989 procedure TCustomDBGrid.CellClick(const aCol, aRow: Integer; const Button:TMouseButton);
2990 begin
2991 {$ifdef dbgGrid}DebugLn('%s.CellClick', [ClassName]); {$endif}
2992 if Button<>mbLeft then
2993 exit;
2994
2995 if (aCol>=FirstGridColumn) then begin
2996 if (aRow>=FixedRows) then begin
2997 if IsColumnVisible(aCol) and
2998 (ColumnEditorStyle(ACol, SelectedField) = cbsCheckboxColumn) then begin
2999 // react only if overriden editor is hidden
3000 if (Editor=nil) or not EditorMode then
3001 SwapCheckBox
3002 end;
3003 if Assigned(OnCellClick) then
3004 OnCellClick(TColumn(ColumnFromGridColumn(aCol)));
3005 end else
3006 DoHeaderClick(aCol)
3007 end;
3008 end;
3009
CheckDisplayMemonull3010 function TCustomDBGrid.CheckDisplayMemo(aField: TField): boolean;
3011 begin
3012 // note that this assumes that aField is not nil
3013 result := (aField.DataType=ftMemo) and (dgDisplayMemoText in Options);
3014 end;
3015
3016 procedure TCustomDBGrid.EndLayout;
3017 begin
3018 dec(FLayoutChangedCount);
3019 if FLayoutChangedCount = 0 then
3020 DoLayoutChanged;
3021 end;
3022
GetDefaultColumnAlignmentnull3023 function TCustomDBGrid.GetDefaultColumnAlignment(Column: Integer): TAlignment;
3024 var
3025 F: TField;
3026 begin
3027 F := GetDsFieldFromGridColumn(Column);
3028 if F<>nil then
3029 result := F.Alignment
3030 else
3031 result := taLeftJustify;
3032 end;
3033
GetDefaultColumnWidthnull3034 function TCustomDBGrid.GetDefaultColumnWidth(Column: Integer): Integer;
3035 begin
3036 Result := DefaultFieldColWidth(GetDsFieldFromGridColumn(Column));
3037 end;
3038
GetDefaultColumnReadOnlynull3039 function TCustomDBGrid.GetDefaultColumnReadOnly(Column: Integer): boolean;
3040 var
3041 F: Tfield;
3042 begin
3043 result := true;
3044 if not Self.ReadOnly and (FDataLink.Active and not FDatalink.ReadOnly) then begin
3045 F := GetDsFieldFromGridColumn(Column);
3046 result := (F=nil) or F.ReadOnly;
3047 end;
3048 end;
3049
GetDefaultColumnTitlenull3050 function TCustomDBGrid.GetDefaultColumnTitle(Column: Integer): string;
3051 var
3052 F: Tfield;
3053 begin
3054 F := GetDsFieldFromGridColumn(Column);
3055 if F<>nil then
3056 Result := F.DisplayName
3057 else
3058 Result := '';
3059 end;
3060
TCustomDBGrid.GetDefaultRowHeightnull3061 function TCustomDBGrid.GetDefaultRowHeight: integer;
3062 begin
3063 result := inherited GetDefaultRowHeight;
3064 Dec(Result, 2); // a litle smaller for dbgrid
3065 end;
3066
3067 procedure TCustomDBGrid.DoExit;
3068 begin
3069 {$ifdef dbgDBGrid}DebugLnEnter('%s.DoExit INIT', [ClassName]);{$endif}
3070 if ValidDataSet and (dgCancelOnExit in Options) and
3071 InsertCancelable then
3072 begin
3073 FDataLink.DataSet.Cancel;
3074 EditingColumn(FEditingColumn, False);
3075 end;
3076 inherited DoExit;
3077 {$ifdef dbgDBGrid}DebugLnExit('%s.DoExit DONE', [ClassName]);{$endif}
3078 end;
3079
TCustomDBGrid.DoMouseWheelDownnull3080 function TCustomDBGrid.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint
3081 ): Boolean;
3082 begin
3083 Result := False;
3084 if Assigned(OnMouseWheelDown) then
3085 OnMouseWheelDown(Self, Shift, MousePos, Result);
3086 if not Result and FDatalink.Active then begin
3087 FDatalink.MoveBy(1);
3088 Result := True;
3089 end;
3090 end;
3091
DoMouseWheelUpnull3092 function TCustomDBGrid.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint
3093 ): Boolean;
3094 begin
3095 Result := False;
3096 if Assigned(OnMouseWheelUp) then
3097 OnMouseWheelUp(Self, Shift, MousePos, Result);
3098 if not Result and FDatalink.Active then begin
3099 FDatalink.MoveBy(-1);
3100 Result := True;
3101 end;
3102 end;
3103
GetEditMasknull3104 function TCustomDBGrid.GetEditMask(aCol, aRow: Longint): string;
3105 var
3106 aField: TField;
3107 begin
3108 Result := '';
3109 if FDataLink.Active then begin
3110 aField := GetFieldFromGridColumn(aCol);
3111 if (aField<>nil) then begin
3112 Result := aField.EditMask;
3113 if assigned(OnFieldEditMask) then
3114 OnFieldEditMask(Self, AField, Result);
3115 end;
3116 end;
3117 end;
3118
TCustomDBGrid.GetEditTextnull3119 function TCustomDBGrid.GetEditText(aCol, aRow: Longint): string;
3120 var
3121 aField: TField;
3122 begin
3123 Result := '';
3124 if FDataLink.Active then begin
3125 aField := GetFieldFromGridColumn(aCol);
3126 if aField<>nil then begin
3127 if CheckDisplayMemo(aField) then
3128 Result := aField.AsString
3129 else
3130 Result := aField.Text;
3131 end;
3132 end;
3133 end;
3134
TCustomDBGrid.GetIsCellSelectednull3135 function TCustomDBGrid.GetIsCellSelected(aCol, aRow: Integer): boolean;
3136 begin
3137 Result:=inherited GetIsCellSelected(aCol, aRow) or
3138 FDrawingMultiSelRecord;
3139 end;
3140
GetIsCellTitlenull3141 function TCustomDBGrid.GetIsCellTitle(aCol, aRow: Integer): boolean;
3142 begin
3143 result := (FixedRows>0) and (aRow=0);
3144 if result and Columns.Enabled then
3145 result := (aCol>=FirstGridColumn);
3146 end;
3147
3148 procedure TCustomDBGrid.GetSelectedState(AState: TGridDrawState; out
3149 IsSelected: boolean);
3150 begin
3151 inherited GetSelectedState(AState, IsSelected);
3152 if IsSelected and not Self.Focused and not(dgAlwaysShowSelection in Options) then
3153 IsSelected := false;
3154 end;
3155
GetSmoothScrollnull3156 function TCustomDBGrid.GetSmoothScroll(Which: Integer): Boolean;
3157 begin
3158 if Which=SB_Vert then
3159 Result := False
3160 else
3161 Result := inherited GetSmoothScroll(Which);
3162 end;
3163
TCustomDBGrid.GridCanModifynull3164 function TCustomDBGrid.GridCanModify: boolean;
3165 begin
3166 result := not ReadOnly and (dgEditing in Options) and not FDataLink.ReadOnly
3167 and FDataLink.Active and FDatalink.DataSet.CanModify;
3168 end;
3169
3170 procedure TCustomDBGrid.GetSBVisibility(out HsbVisible, VsbVisible: boolean);
3171 var
3172 aRange,aPage,aPos: Integer;
3173 begin
3174 inherited GetSBVisibility(HsbVisible, VsbVisible);
3175 VSbVisible := (ScrollBars in [ssVertical, ssBoth]);
3176 if not VSbVisible and ScrollBarAutomatic(ssVertical) then begin
3177 GetScrollbarParams(aRange,aPage, aPos);
3178 if ARange>aPage then
3179 VSbVisible:=True;
3180 end;
3181 end;
3182
3183 procedure TCustomDBGrid.GetSBRanges(const HsbVisible, VsbVisible: boolean; out
3184 HsbRange, VsbRange, HsbPage, VsbPage, HsbPos, VsbPos: Integer);
3185 begin
3186 inherited GetSBRanges(HsbVisible, VsbVisible, HsbRange, VsbRange, HsbPage, VsbPage, HsbPos, VsbPos);
3187 if VSbVisible then
3188 GetScrollbarParams(VsbRange, VsbPage, VsbPos)
3189 else begin
3190 VsbRange := 0;
3191 VsbPage := 0;
3192 VsbPos := 0;
3193 end;
3194 end;
3195
3196 procedure TCustomDBGrid.MoveSelection;
3197 begin
3198 {$ifdef dbgDBGrid}DebugLnEnter('%s.MoveSelection INIT', [ClassName]);{$endif}
3199 inherited MoveSelection;
3200 if FColEnterPending and Assigned(OnColEnter) then begin
3201 OnColEnter(Self);
3202 end;
3203 FColEnterPending:=False;
3204 UpdateActive;
3205 {$ifdef dbgDBGrid}DebugLnExit('%s.MoveSelection DONE', [ClassName]);{$endif}
3206 end;
3207
MouseButtonAllowednull3208 function TCustomDBGrid.MouseButtonAllowed(Button: TMouseButton): boolean;
3209 begin
3210 Result:= FDataLink.Active and ((Button=mbLeft) or (dgAnyButtonCanSelect in Options));
3211 end;
3212
3213 procedure TCustomDBGrid.DrawAllRows;
3214 var
3215 CurActiveRecord: Integer;
3216 begin
3217 if FDataLink.Active then begin
3218 {$ifdef dbgGridPaint}
3219 DebugLnEnter('%s DrawAllRows INIT Link.ActiveRecord=%d, Row=%d',[Name, FDataLink.ActiveRecord, Row]);
3220 {$endif}
3221 CurActiveRecord:=FDataLink.ActiveRecord;
3222 FDrawingEmptyDataset:=FDatalink.DataSet.IsEmpty;
3223 end else
3224 FDrawingEmptyDataset:=True;
3225 try
3226 inherited DrawAllRows;
3227 finally
3228 if FDataLink.Active then begin
3229 FDataLink.ActiveRecord:=CurActiveRecord;
3230 {$ifdef dbgGridPaint}
3231 DebugLnExit('%s DrawAllRows DONE Link.ActiveRecord=%d, Row=%d',[Name, FDataLink.ActiveRecord, Row]);
3232 {$endif}
3233 end;
3234 end;
3235 end;
3236
3237 procedure TCustomDBGrid.DrawFocusRect(aCol, aRow: Integer; ARect: TRect);
3238 var
3239 DrawBits: Byte;
3240 begin
3241 // Draw focused cell if we have the focus
3242 if Self.Focused and (dgAlwaysShowSelection in Options) and
3243 FDatalink.Active and DefaultDrawing then
3244 begin
3245 DrawBits := BF_RECT;
3246 if (dgRowSelect in Options) then begin
3247 if (LeftCol>FixedCols) or (GCache.TLColOff<>0) then
3248 DrawBits := DrawBits and not BF_LEFT;
3249 if (GCache.VisibleGrid.Right<ColCount-1) then
3250 DrawBits := DrawBits and not BF_RIGHT;
3251 end;
3252 CalcFocusRect(aRect);
3253 DrawRubberRect(Canvas, aRect, FocusColor, DrawBits);
3254 end;
3255 end;
3256
3257 //
3258 procedure TCustomDBGrid.DrawRow(ARow: Integer);
3259 begin
3260 if (ARow>=FixedRows) and FDataLink.Active then begin
3261 //if (Arow>=FixedRows) and FCanBrowse then
3262 FDataLink.ActiveRecord:=ARow-FixedRows;
3263 FDrawingActiveRecord := ARow = Row;
3264 FDrawingMultiSelRecord := (dgMultiSelect in Options) and
3265 SelectedRows.CurrentRowSelected
3266 end else begin
3267 FDrawingActiveRecord := False;
3268 FDrawingMultiSelRecord := False;
3269 end;
3270 {$ifdef dbgGridPaint}
3271 DbgOut('DrawRow Row=', IntToStr(ARow), ' Act=', dbgs(FDrawingActiveRecord));
3272 {$endif}
3273 inherited DrawRow(ARow);
3274 {$ifdef dbgGridPaint}
3275 DebugLn('End Row')
3276 {$endif}
3277 end;
3278
3279 procedure TCustomDBGrid.DrawCell(aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState);
3280 var
3281 DataCol: Integer;
3282 begin
3283 PrepareCanvas(aCol, aRow, aState);
3284
3285 {$ifdef dbgGridPaint}
3286 DbgOut(' ',IntToStr(aCol));
3287 if gdSelected in aState then DbgOut('S');
3288 if gdFocused in aState then DbgOut('*');
3289 if gdFixed in aState then DbgOut('F');
3290 {$endif dbgGridPaint}
3291
3292 if (gdFixed in aState) or DefaultDrawing then
3293 DefaultDrawCell(aCol, aRow, aRect, aState)
3294 else
3295 if not DefaultDrawing then
3296 DrawCellBackground(aCol, aRow, aRect, aState);
3297
3298 if not (csDesigning in ComponentState) then
3299 begin
3300 if (ARow>=FixedRows) and Assigned(OnDrawColumnCell) then begin
3301 DataCol := ColumnIndexFromGridColumn(aCol);
3302 if DataCol>=0 then
3303 OnDrawColumnCell(Self, aRect, DataCol, TColumn(Columns[DataCol]), aState);
3304 end;
3305 if (ARow<FixedRows) and Assigned(OnDrawColumnTitle) then begin
3306 DataCol := ColumnIndexFromGridColumn(aCol);
3307 if DataCol>=0 then
3308 OnDrawColumnTitle(Self, aRect, DataCol, TColumn(Columns[DataCol]), aState);
3309 end;
3310 end;
3311
3312 DrawCellGrid(aCol, aRow, aRect, aState);
3313 end;
3314
3315 procedure TCustomDBGrid.DrawCellBackground(aCol, aRow: Integer; aRect: TRect;
3316 aState: TGridDrawState);
3317 begin
3318 // background
3319 if (gdFixed in aState) and (TitleStyle=tsNative) then
3320 DrawThemedCell(aCol, aRow, aRect, aState)
3321 else
3322 Canvas.FillRect(aRect);
3323 end;
3324
3325 procedure TCustomDBGrid.DrawCheckboxBitmaps(aCol: Integer; aRect: TRect;
3326 F: TField);
3327 var
3328 AState: TCheckboxState;
3329 begin
3330 if (aCol=Col) and FDrawingActiveRecord then begin
3331 // show checkbox only if overriden editor is hidden
3332 if EditorMode then
3333 exit;
3334 end;
3335
3336 // by SSY
3337 if (F<>nil) then
3338 if F.DataType=ftBoolean then
3339 if F.IsNull then
3340 AState := cbGrayed
3341 else
3342 if F.AsBoolean then
3343 AState := cbChecked
3344 else
3345 AState := cbUnChecked
3346 else
3347 if F.AsString=ColumnFromGridColumn(aCol).ValueChecked then
3348 AState := cbChecked
3349 else
3350
3351 if F.AsString=ColumnFromGridColumn(aCol).ValueUnChecked then
3352 AState := cbUnChecked
3353 else
3354 AState := cbGrayed
3355 else
3356 AState := cbGrayed;
3357
3358 if assigned(OnUserCheckboxState) then
3359 OnUserCheckboxState(Self, TColumn(ColumnFromGridColumn(aCol)), AState);
3360
3361 DrawGridCheckboxBitmaps(aCol, Row{dummy}, ARect, AState);
3362 end;
3363
3364 procedure TCustomDBGrid.DrawFixedText(aCol, aRow: Integer; aRect: TRect;
3365 aState: TGridDrawState);
3366
GetDatasetStatenull3367 function GetDatasetState: TDataSetState;
3368 begin
3369 if FDatalink.Active then
3370 result := FDataLink.DataSet.State
3371 else
3372 result := dsInactive;
3373 end;
3374
3375 begin
3376 if (ACol=0) and (dgIndicator in Options) and FDrawingActiveRecord then begin
3377 DrawIndicator(Canvas, aRect, GetDataSetState, FDrawingMultiSelRecord);
3378 {$ifdef dbgGridPaint}
3379 dbgOut('>');
3380 {$endif}
3381 end else
3382 if (ACol=0) and (dgIndicator in Options) and FDrawingMultiSelRecord then
3383 DrawIndicator(Canvas, aRect, dsCurValue{dummy}, True)
3384 else
3385 DrawColumnText(aCol, aRow, aRect, aState);
3386 end;
3387
3388 procedure TCustomDBGrid.DrawColumnText(aCol, aRow: Integer; aRect: TRect;
3389 aState: TGridDrawState);
3390 var
3391 F: TField;
3392 s: String;
3393 begin
3394 if GetIsCellTitle(aCol, aRow) then
3395 inherited DrawColumnText(aCol, aRow, aRect, aState)
3396 else if aRow<FixedRows then
3397 // this case is for drawing fixed rows extra, the standard dbgrid
3398 // have nothing to draw here but it must avoid duplicate titles or
3399 // draw some field.
3400 else begin
3401 F := GetFieldFromGridColumn(aCol);
3402 if F<>nil then begin
3403 if CheckDisplayMemo(F) then
3404 s := F.AsString
3405 else
3406 s := F.DisplayText;
3407 DrawCellText(aCol, aRow, aRect, aState, s)
3408 end;
3409 end;
3410 end;
3411
3412 procedure TCustomDBGrid.DrawIndicator(ACanvas: TCanvas; R: TRect;
3413 Opt: TDataSetState; MultiSel: boolean);
3414 var
3415 dx, dy, x, y: Integer;
3416
3417 procedure CenterY;
3418 begin
3419 y := R.Top + (R.Bottom-R.Top) div 2;
3420 end;
3421
3422 procedure CenterX;
3423 begin
3424 X := R.Left + (R.Right-R.Left) div 2;
3425 end;
3426
3427 procedure DrawEdit(clr: Tcolor);
3428 begin
3429 ACanvas.Pen.Color := clr;
3430 CenterY;
3431 CenterX;
3432 ACanvas.MoveTo(X-2, Y-Dy);
3433 ACanvas.LineTo(X+3, Y-Dy);
3434 ACanvas.MoveTo(X, Y-Dy);
3435 ACanvas.LineTo(X, Y+Dy);
3436 ACanvas.MoveTo(X-2, Y+Dy);
3437 ACanvas.LineTo(X+3, Y+Dy);
3438 end;
3439
3440 begin
3441 dx := 6;
3442 dy := 6;
3443 x := 0;
3444 y := 0;
3445 case Opt of
3446 dsBrowse:
3447 begin //
3448 ACanvas.Brush.Color:=clBlack;
3449 ACanvas.Pen.Color:=clBlack;
3450 CenterY;
3451 x:= R.Left+3;
3452 if MultiSel then begin
3453 if BiDiMode = bdRightToLeft then begin
3454 ACanvas.Polyline([point(x+dx,y-dy), point(x,y),point(x+dx,y+dy), point(x+dx,y+dy-1)]);
3455 ACanvas.Polyline([point(x+dx,y-dy+1), point(x+1,y),point(x+dx,y+dy-1), point(x+dx,y+dy-2)]);
3456 CenterX;
3457 Dec(X,3);
3458 ACanvas.Ellipse(Rect(X+dx-2,Y-2,X+dx+2,Y+2));
3459 end else begin
3460 ACanvas.Polyline([point(x,y-dy), point(x+dx,y),point(x,y+dy), point(x,y+dy-1)]);
3461 ACanvas.Polyline([point(x,y-dy+1),point(x+dx-1,y),point(x, y+dy-1), point(x,y+dy-2)]);
3462 CenterX;
3463 Dec(X,3);
3464 ACanvas.Ellipse(Rect(X-2,Y-2,X+2,Y+2));
3465 end;
3466 end else begin
3467 if BiDiMode = bdRightToLeft then
3468 ACanvas.Polygon([point(x,y),point(x+dx,y-dy),point(x+dx, y+dy),point(x,y)])
3469 else
3470 ACanvas.Polygon([point(x,y-dy),point(x+dx,y),point(x, y+dy),point(x,y-dy)]);
3471 end;
3472 end;
3473 dsEdit:
3474 DrawEdit(clBlack);
3475 dsInsert:
3476 DrawEdit(clGreen);
3477 else
3478 if MultiSel then begin
3479 ACanvas.Brush.Color:=clBlack;
3480 ACanvas.Pen.Color:=clBlack;
3481 CenterX;
3482 CenterY;
3483 ACanvas.Ellipse(Rect(X-3,Y-3,X+3,Y+3));
3484 end;
3485 end;
3486 end;
3487
TCustomDBGrid.EditorCanAcceptKeynull3488 function TCustomDBGrid.EditorCanAcceptKey(const ch: TUTF8Char): boolean;
3489 var
3490 aField: TField;
3491 begin
3492 result := False;
3493 if FDataLink.Active then begin
3494 aField := SelectedField;
3495 if aField<>nil then begin
3496 Result := IsValidChar(AField, Ch) and not aField.Calculated and
3497 (aField.DataType<>ftAutoInc) and (aField.FieldKind<>fkLookup) and
3498 (not aField.IsBlob or CheckDisplayMemo(aField));
3499 end;
3500 end;
3501 end;
3502
TCustomDBGrid.EditorIsReadOnlynull3503 function TCustomDBGrid.EditorIsReadOnly: boolean;
3504 var
3505 AField : TField;
3506 FieldList: TList;
3507 I: Integer;
3508 begin
3509 Result := inherited EditorIsReadOnly;
3510 if not Result then begin
3511
3512 AField := GetFieldFromGridColumn(Col);
3513 if assigned(AField) then begin
3514
3515 // if field can't be modified, it's assumed readonly
3516 result := not AField.CanModify;
3517
3518 // if field is readonly, check if it's a lookup field
3519 if result and (AField.FieldKind = fkLookup) then begin
3520 FieldList := TList.Create;
3521 try
3522 AField.DataSet.GetFieldList(FieldList, AField.KeyFields);
3523 // check if any keyfields are there
3524 result := (FieldList.Count=0); // if not simply is still readonly
3525 // if yes assumed keyfields are modifiable
3526 for I := 0 to FieldList.Count-1 do
3527 if not TField(FieldList[I]).CanModify then begin
3528 result := true; // at least one keyfield is readonly
3529 break;
3530 end;
3531 finally
3532 FieldList.Free;
3533 end;
3534 end;
3535
3536 // if it's not readonly and is not already editing, start editing.
3537 if not result and not FDatalink.Editing then begin
3538 Include(FGridStatus, gsStartEditing);
3539 Result := not FDataLink.Edit;
3540 Exclude(FGridStatus, gsStartEditing);
3541 end;
3542
3543 end
3544 else
3545 result := true; // field is nil so it's readonly
3546
3547 end;
3548 end;
3549
3550 procedure TCustomDBGrid.EditorTextChanged(const aCol, aRow: Integer;
3551 const aText: string);
3552 var
3553 isReadOnly: Boolean;
3554 begin
3555 isReadOnly := EditorIsReadonly;
3556 if not isReadOnly then
3557 SetEditText(aCol, aRow, aText);
3558 EditingColumn(Col, not isReadOnly);
3559 end;
3560
3561 procedure TCustomDBGrid.HeaderSized(IsColumn: Boolean; Index: Integer);
3562 var
3563 i: Integer;
3564 begin
3565 if IsColumn then begin
3566 if Columns.Enabled then begin
3567 i := ColumnIndexFromGridColumn(Index);
3568 if i>=0 then
3569 Columns[i].Width := ColWidths[Index];
3570 end;
3571 FDefaultColWidths := False;
3572 if Assigned(OnColumnSized) then
3573 OnColumnSized(Self);
3574 end;
3575 end;
3576
IsColumnVisiblenull3577 function TCustomDBGrid.IsColumnVisible(aCol: Integer): boolean;
3578 var
3579 gridcol: TGridColumn;
3580 begin
3581 if Columns.Enabled then begin
3582 gridcol := ColumnFromGridColumn(aCol);
3583 result := (gridcol<>nil) and gridCol.Visible;
3584 end else
3585 result := (aCol>=FirstGridColumn) and (ColWidths[aCol]>0);
3586 end;
3587
IsValidCharnull3588 function TCustomDBGrid.IsValidChar(AField: TField; AChar: TUTF8Char): boolean;
3589 begin
3590 result := False;
3591
3592 if Length(AChar)>1 then begin
3593 // problem: AField should validate a unicode char, but AField has no
3594 // such facility, ask the user, if user is not interested
3595 // do ansi convertion and try with field.
3596
3597 { TODO: is this really necessary?
3598 if Assigned(FOnValidateUTF8Char) then begin
3599 result := true;
3600 OnValidateUT8Char(Self, AField, AChar, Result)
3601 exit;
3602 end else
3603 }
3604 AChar := UTF8ToSys(AChar);
3605 end else
3606 if Length(AChar)=0 then
3607 exit;
3608
3609 Result := (AChar[1]=#8) or AField.IsValidChar(AChar[1])
3610 end;
3611
3612 procedure TCustomDBGrid.UpdateActive;
3613 var
3614 PrevRow: Integer;
3615 NewRow: Integer;
3616 begin
3617 if (csDestroying in ComponentState) or
3618 (FDatalink=nil) or (not FDatalink.Active) or
3619 (FDatalink.ActiveRecord<0) then
3620 exit;
3621 {$ifdef dbgDBGrid}
3622 DebugLn('%s.UpdateActive (%s): ActiveRecord=%d FixedRows=%d Row=%d',
3623 [ClassName, Name, FDataLink.ActiveRecord, FixedRows, Row]);
3624 {$endif}
3625 PrevRow := Row;
3626 NewRow:= FixedRows + FDataLink.ActiveRecord;
3627 if NewRow>RowCount-1 then
3628 NewRow := RowCount-1;
3629 Row := NewRow;
3630 if PrevRow<>Row then
3631 InvalidateCell(0, PrevRow);//(InvalidateRow(PrevRow);
3632 InvalidateRow(Row);
3633 end;
3634
UpdateGridCountsnull3635 function TCustomDBGrid.UpdateGridCounts: Integer;
3636 var
3637 RecCount: Integer;
3638 FRCount, FCCount: Integer;
3639 begin
3640 // find out the column count, if result=0 then
3641 // there are no visible columns defined or dataset is inactive
3642 // or there are no visible fields, ie the grid is blank
3643 {$ifdef dbgDBGrid}DebugLnEnter('%s.UpdateGridCounts INIT', [ClassName]);{$endif}
3644 BeginUpdate;
3645 try
3646 Result := GetColumnCount;
3647 if Result > 0 then begin
3648 FRCount := FixedRowsExtra;
3649 if dgTitles in Options then Inc(FRCount);
3650 if dgIndicator in Options then FCCount := 1 else FCCount := 0;
3651 InternalSetColCount(Result + FCCount);
3652 if FDataLink.Active then begin
3653 UpdateBufferCount;
3654 RecCount := FDataLink.RecordCount;
3655 if RecCount<1 then
3656 RecCount := 1;
3657 end else begin
3658 RecCount := 0;
3659 if FRCount=0 then
3660 // need to be large enough to hold indicator
3661 // if there is one, and if there are no titles
3662 RecCount := FCCount;
3663 end;
3664 Inc(RecCount, FRCount);
3665 RowCount := RecCount;
3666 FixedRows := FRCount;
3667 UpdateGridColumnSizes;
3668 if FDatalink.Active and (FDatalink.ActiveRecord>=0) then
3669 AdjustEditorBounds(Col, FixedRows + FDatalink.ActiveRecord);
3670 end;
3671 finally
3672 EndUpdate;
3673 end;
3674 {$ifdef dbgDBGrid}DebugLnExit('%s.UpdateGridCounts DONE', [ClassName]);{$endif}
3675 end;
3676
3677 constructor TCustomDBGrid.Create(AOwner: TComponent);
3678 begin
3679 FEditingColumn:=-1;
3680 DragDx:=5;
3681 inherited Create(AOwner);
3682
3683 FDataLink := TComponentDataLink.Create;//(Self);
3684 FDataLink.OnRecordChanged:=@OnRecordChanged;
3685 FDataLink.OnDatasetChanged:=@OnDataSetChanged;
3686 FDataLink.OnDataSetOpen:=@OnDataSetOpen;
3687 FDataLink.OnDataSetClose:=@OnDataSetClose;
3688 FDataLink.OnNewDataSet:=@OnNewDataSet;
3689 FDataLink.OnInvalidDataSet:=@OnInvalidDataset;
3690 FDataLink.OnInvalidDataSource:=@OnInvalidDataSource;
3691 FDataLink.OnDataSetScrolled:=@OnDataSetScrolled;
3692 FDataLink.OnLayoutChanged:=@OnLayoutChanged;
3693 FDataLink.OnEditingChanged:=@OnEditingChanged;
3694 FDataLink.OnUpdateData:=@OnUpdateData;
3695 FDatalink.OnFocusControl := @OnFocusControl;
3696 FDataLink.VisualControl:= True;
3697
3698 FSelectedRows := TBookmarkList.Create(Self);
3699
3700 RenewColWidths;
3701
3702 FOptions := [dgColumnResize, dgColumnMove, dgTitles, dgIndicator, dgRowLines,
3703 dgColLines, dgConfirmDelete, dgCancelOnExit, dgTabs, dgEditing,
3704 dgAlwaysShowSelection];
3705
3706 inherited Options :=
3707 [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
3708 goSmoothScroll, goColMoving, goTabs, goEditing, goDrawFocusSelected,
3709 goColSizing ];
3710
3711 FExtraOptions := [dgeAutoColumns, dgeCheckboxColumn];
3712
3713 AutoAdvance := aaRightDown;
3714
3715 // What a dilema!, we need ssAutoHorizontal and ssVertical!!!
3716 ScrollBars:=ssBoth;
3717 AllowOutboundEvents := false;
3718 end;
3719
3720 procedure TCustomDBGrid.AutoAdjustColumns;
3721 begin
3722 Exclude(FGridStatus, gsAutoSized);
3723 UpdateAutoSizeColumns;
3724 end;
3725
3726 procedure TCustomDBGrid.InitiateAction;
3727 begin
3728 {$ifdef dbgDBGrid}DebugLnEnter('%s.InitiateAction INIT', [ClassName]);{$endif}
3729 inherited InitiateAction;
3730 if (gsUpdatingData in FGridStatus) then begin
3731 EndUpdating;
3732 {
3733 if EditorMode then begin
3734 Editor.SetFocus;
3735 EditorSelectAll;
3736 end;
3737 }
3738 end;
3739 {$ifdef dbgDBGrid}DebugLnExit('%s.InitiateAction DONE', [ClassName]);{$endif}
3740 end;
3741
3742 procedure TCustomDBGrid.DefaultDrawColumnCell(const Rect: TRect;
3743 DataCol: Integer; Column: TColumn; State: TGridDrawState);
3744 var
3745 S: string;
3746 F: TField;
3747 DataRow: Integer;
3748 begin
3749 F := Column.Field;
3750
3751 DataCol := GridColumnFromColumnIndex(DataCol);
3752 if FDataLink.Active then
3753 DataRow := FixedRows + FDataLink.ActiveRecord
3754 else
3755 DataRow := 0;
3756
3757 if DataCol>=FirstGridColumn then
3758 case ColumnEditorStyle(DataCol, F) of
3759
3760 cbsCheckBoxColumn:
3761 DrawCheckBoxBitmaps(DataCol, Rect, F);
3762
3763 else begin
3764 if F<>nil then begin
3765 if CheckDisplayMemo(F) then
3766 S := F.AsString
3767 else
3768 if F.dataType <> ftBlob then
3769 S := F.DisplayText
3770 else
3771 S := '(blob)';
3772 end else
3773 S := '';
3774 DrawCellText(DataCol, DataRow, Rect, State, S);
3775 end;
3776
3777 end;
3778 end;
3779
EditorByStylenull3780 function TCustomDBGrid.EditorByStyle(Style: TColumnButtonStyle): TWinControl;
3781 begin
3782 // we want override the editor style if it is cbsAuto because
3783 // field.datatype might be ftBoolean or some other cases
3784 if Style=cbsAuto then
3785 Style := ColumnEditorStyle(Col, SelectedField);
3786
3787 Result:=inherited EditorByStyle(Style);
3788 end;
3789
3790 procedure TCustomDBGrid.ResetColWidths;
3791 begin
3792 if not FDefaultColWidths then begin
3793 RenewColWidths;
3794 LayoutChanged;
3795 end;
3796 end;
3797
3798 procedure TCustomDBGrid.SelectRecord(AValue: boolean);
3799 begin
3800 {$ifdef dbgGrid}DebugLn('%s.SelectRecord', [ClassName]); {$endif}
3801 if dgMultiSelect in Options then
3802 FSelectedRows.CurrentRowSelected := AValue;
3803 end;
3804
3805 procedure TCustomDBGrid.GetScrollbarParams(out aRange, aPage, aPos: Integer);
3806 begin
3807 if (FDatalink<>nil) and FDatalink.Active then begin
3808 if FDatalink.dataset.IsSequenced then begin
3809 aRange := GetRecordCount + VisibleRowCount - 1;
3810 aPage := VisibleRowCount;
3811 if aPage<1 then aPage := 1;
3812 if FDatalink.BOF then aPos := 0 else
3813 if FDatalink.EOF then aPos := aRange
3814 else
3815 begin
3816 aPos := FDataLink.DataSet.RecNo - 1; // RecNo is 1 based
3817 FDataLink.DataSet.UpdateCursorPos; // FPC 3 bug #31532 workaround
3818 end;
3819 if aPos<0 then aPos:=0;
3820 if aRange=0 then aRange:=1; // there's always 1 (new) row
3821 end else begin
3822 aRange := 6;
3823 aPage := 2;
3824 if FDatalink.EOF then aPos := 4 else
3825 if FDatalink.BOF then aPos := 0
3826 else aPos := 2;
3827 end;
3828 end else begin
3829 aRange := 0;
3830 aPage := 0;
3831 aPos := 0;
3832 end;
3833 end;
3834
3835 procedure TCustomDBGrid.CMGetDataLink(var Message: TLMessage);
3836 begin
3837 Message.Result := PtrUInt(FDataLink);
3838 end;
3839
3840 procedure TCustomDBGrid.ClearSelection(selCurrent:boolean=false);
3841 begin
3842 if [dgMultiSelect,dgPersistentMultiSelect]*Options=[dgMultiSelect] then begin
3843 if SelectedRows.Count>0 then
3844 SelectedRows.Clear;
3845 if SelCurrent then
3846 SelectRecord(true);
3847 end;
3848 end;
3849
TCustomDBGrid.NeedAutoSizeColumnsnull3850 function TCustomDBGrid.NeedAutoSizeColumns: boolean;
3851 begin
3852 result := (dgAutoSizeColumns in Options)
3853 //and (HandleAllocated)
3854 ;
3855 end;
3856
3857 procedure TCustomDBGrid.RenewColWidths;
3858 begin
3859 FDefaultColWidths := True;
3860 exclude(FGridStatus, gsAutoSized);
3861 end;
3862
3863 procedure TCustomDBGrid.InternalAutoSizeColumn(aCol: Integer; aCanvas: TCanvas; aDatalinkActive: Boolean);
3864 var
3865 Field: TField;
3866 C: TGridColumn;
3867 ColWidth: Integer;
3868 ARow,w: Integer;
3869 s: string;
3870
3871 begin
3872 Field := GetFieldFromGridColumn(ACol);
3873 C := ColumnFromGridColumn(ACol);
3874
3875 if (C<>nil) and (C.Title<>nil) then begin
3876 aCanvas.Font := C.Title.Font;
3877 ColWidth := aCanvas.TextWidth(trim(C.Title.Caption));
3878 aCanvas.Font := C.Font;
3879 end else begin
3880 if (Field<>nil) then begin
3881 aCanvas.Font := TitleFont;
3882 ColWidth := aCanvas.TextWidth(Field.FieldName);
3883 end
3884 else
3885 ColWidth := 0;
3886 aCanvas.Font := Font;
3887 end;
3888
3889 if (Field<>nil) and aDatalinkActive then
3890 for ARow := FixedRows to RowCount-1 do begin
3891
3892 FDatalink.ActiveRecord := ARow - FixedRows;
3893
3894 if CheckDisplayMemo(Field) then
3895 s := Field.AsString
3896 else if Field.dataType<>ftBlob then
3897 s := trim(Field.DisplayText)
3898 else
3899 s := '(blob)';
3900 w := aCanvas.TextWidth(s);
3901 if w>ColWidth then
3902 ColWidth := w;
3903
3904 end;
3905
3906 if ColWidth=0 then
3907 ColWidth := GetColumnWidth(ACol);
3908
3909 ColWidths[ACol] := ColWidth + 15;
3910 end;
3911
3912 destructor TCustomDBGrid.Destroy;
3913 begin
3914 {$ifdef dbgGrid}DebugLn('%s.Destroy', [ClassName]); {$endif}
3915 FSelectedRows.Free;
3916 FDataLink.OnDataSetChanged:=nil;
3917 FDataLink.OnRecordChanged:=nil;
3918 FDataLink.Free;
3919 inherited Destroy;
3920 end;
3921
TCustomDBGrid.MouseToRecordOffsetnull3922 function TCustomDBGrid.MouseToRecordOffset(const x, y: Integer; out
3923 Column: TColumn; out RecordOffset: Integer): TGridZone;
3924 var
3925 aCol,aRow: Integer;
3926 begin
3927 Result := MouseToGridZone(x, y);
3928
3929 Column := nil;
3930 RecordOffset := 0;
3931
3932 if (Result=gzInvalid) or (Result=gzFixedCells) then
3933 exit;
3934
3935 MouseToCell(x, y, aCol, aRow);
3936
3937 if (Result=gzFixedRows) or (Result=gzNormal) then
3938 RecordOffset := aRow - Row;
3939
3940 if (Result=gzFixedCols) or (Result=gzNormal) then begin
3941 aRow := ColumnIndexFromGridColumn(aCol);
3942 if aRow>=0 then
3943 Column := Columns[aRow];
3944 end;
3945 end;
3946
TCustomDBGrid.ExecuteActionnull3947 function TCustomDBGrid.ExecuteAction(AAction: TBasicAction): Boolean;
3948 begin
3949 Result := (DataLink <> nil)
3950 and DataLink.ExecuteAction(AAction);
3951 end;
3952
UpdateActionnull3953 function TCustomDBGrid.UpdateAction(AAction: TBasicAction): Boolean;
3954 begin
3955 Result := (DataLink <> nil)
3956 and DataLink.UpdateAction(AAction);
3957 end;
3958
3959 procedure TCustomDBGrid.SaveToFile(FileName: string);
3960 begin
3961 SaveOptions:=[ soDesign ];
3962 inherited SaveToFile(Filename);
3963 end;
3964
3965 procedure TCustomDBGrid.SaveToStream(AStream: TStream);
3966 begin
3967 SaveOptions:=[ soDesign ];
3968 inherited SaveToStream(AStream);
3969 end;
3970
3971 procedure TCustomDBGrid.LoadFromFile(FileName: string);
3972 begin
3973 SaveOptions:=[ soDesign ];
3974 Include(FGridStatus, gsLoadingGrid);
3975 inherited LoadFromFile(Filename);
3976 Exclude(FGridStatus, gsLoadingGrid);
3977 end;
3978
3979 procedure TCustomDBGrid.LoadFromStream(AStream: TStream);
3980 begin
3981 SaveOptions:=[ soDesign ];
3982 Include(FGridStatus, gsLoadingGrid);
3983 inherited LoadFromStream(AStream);
3984 Exclude(FGridStatus, gsLoadingGrid);
3985 end;
3986
3987 { TComponentDataLink }
3988
GetFieldsnull3989 function TComponentDataLink.GetFields(Index: Integer): TField;
3990 begin
3991 {$ifdef dbgGrid}DebugLn('%s.GetFields Index=%d',[ClassName, Index]); {$endif}
3992 if (index>=0) and (index<DataSet.FieldCount) then
3993 result:=DataSet.Fields[index]
3994 else
3995 result:=nil;
3996 end;
3997
TComponentDataLink.GetDataSetNamenull3998 function TComponentDataLink.GetDataSetName: string;
3999 begin
4000 {$ifdef dbgDBGrid}
4001 DebugLn('%s.GetDataSetName', [ClassName]);
4002 {$endif}
4003 Result:=FDataSetName;
4004 if DataSet<>nil then Result:=DataSet.Name;
4005 end;
4006
4007 procedure TComponentDataLink.SetDataSetName(const AValue: string);
4008 begin
4009 {$ifdef dbgDBGrid}
4010 DebugLn('%s.SetDataSetName', [ClassName]);
4011 {$endif}
4012 if FDataSetName<>AValue then FDataSetName:=AValue;
4013 end;
4014
4015 procedure TComponentDataLink.RecordChanged(Field: TField);
4016 begin
4017 {$ifdef dbgDBGrid}
4018 DebugLn('%s.RecordChanged', [ClassName]);
4019 {$endif}
4020 if Assigned(OnRecordChanged) then
4021 OnRecordChanged(Field);
4022 end;
4023
4024 procedure TComponentDataLink.DataSetChanged;
4025 begin
4026 {$ifdef dbgDBGrid}
4027 DebugLn('%s.DataSetChanged FirstRecord=%d', [ClassName, FirstRecord]);
4028 {$endif}
4029 if Assigned(OnDataSetChanged) then
4030 OnDataSetChanged(DataSet);
4031 end;
4032
4033 procedure TComponentDataLink.ActiveChanged;
4034 begin
4035 {$ifdef dbgDBGrid}
4036 DebugLnEnter('%s.ActiveChanged INIT', [ClassName]);
4037 {$endif}
4038 if Active then begin
4039 fDataSet := DataSet;
4040 if DataSetName <> fDataSetName then begin
4041 fDataSetName := DataSetName;
4042 if Assigned(fOnNewDataSet) then fOnNewDataSet(DataSet);
4043 end else
4044 if Assigned(fOnDataSetOpen) then fOnDataSetOpen(DataSet);
4045 end else begin
4046 BufferCount := 0;
4047 if (DataSource = nil)then begin
4048 if Assigned(fOnInvalidDataSource) then fOnInvalidDataSource(fDataSet);
4049 fDataSet := nil;
4050 fDataSetName := '[???]';
4051 end else begin
4052 if (DataSet=nil)or(csDestroying in DataSet.ComponentState) then begin
4053 if Assigned(fOnInvalidDataSet) then fOnInvalidDataSet(fDataSet);
4054 fDataSet := nil;
4055 fDataSetName := '[???]';
4056 end else begin
4057 if Assigned(FOnDataSetClose) then begin
4058 FOnDataSetClose(DataSet);
4059 {$ifdef dbgDBGrid} DebugLn('%s.ActiveChanged OnDataSetClose Called', [ClassName]); {$endif}
4060 end;
4061 if DataSet <> nil then FDataSetName := DataSetName;
4062 end;
4063 end;
4064 end;
4065 {$ifdef dbgDBGrid}
4066 DebugLnExit('%s.ActiveChanged DONE', [ClassName]);
4067 {$endif}
4068 end;
4069
4070 procedure TComponentDataLink.LayoutChanged;
4071 begin
4072 {$ifdef dbgDBGrid}
4073 DebugLnEnter('%s.LayoutChanged INIT', [ClassName]);
4074 {$endif}
4075 if Assigned(OnLayoutChanged) then
4076 OnLayoutChanged(DataSet);
4077 {$ifdef dbgDBGrid}
4078 DebugLnExit('%s.LayoutChanged DONE', [ClassName]);
4079 {$endif}
4080 end;
4081
4082 procedure TComponentDataLink.DataSetScrolled(Distance: Integer);
4083 begin
4084 {$ifdef dbgDBGrid}
4085 DebugLn('%s.DataSetScrolled Distance=%d',[ClassName, Distance]);
4086 {$endif}
4087 if Assigned(OnDataSetScrolled) then
4088 OnDataSetScrolled(DataSet, Distance);
4089 end;
4090
4091 procedure TComponentDataLink.FocusControl(Field: TFieldRef);
4092 begin
4093 {$ifdef dbgDBGrid}
4094 DebugLn('%s.FocusControl', [ClassName]);
4095 {$endif}
4096 if Assigned(OnFocusControl) then
4097 OnFocusControl(Field);
4098 end;
4099
4100 procedure TComponentDataLink.CheckBrowseMode;
4101 begin
4102 {$ifdef dbgDBGrid}
4103 DebugLn('%s.CheckBrowseMode', [ClassName]);
4104 {$endif}
4105 inherited CheckBrowseMode;
4106 end;
4107
4108 procedure TComponentDataLink.EditingChanged;
4109 begin
4110 {$ifdef dbgDBGrid}
4111 DebugLn('%s.EditingChanged', [ClassName]);
4112 {$endif}
4113 if Assigned(OnEditingChanged) then
4114 OnEditingChanged(DataSet);
4115 end;
4116
4117 procedure TComponentDataLink.UpdateData;
4118 begin
4119 {$ifdef dbgDBGrid}
4120 DebugLn('%s.UpdateData', [ClassName]);
4121 {$endif}
4122 if Assigned(OnUpdatedata) then
4123 OnUpdateData(DataSet);
4124 end;
4125
MoveBynull4126 function TComponentDataLink.MoveBy(Distance: Integer): Integer;
4127 begin
4128 (*
4129 {$ifdef dbgDBGrid}
4130 DebugLnEnter('%s.MoveBy INIT Distance=%d',[ClassName, Distance]);
4131 {$endif}
4132 *)
4133 Result:=inherited MoveBy(Distance);
4134 (*
4135 {$ifdef dbgDBGrid}
4136 DebugLnExit('%s.MoveBy DONE Result=%d',[ClassName, Result]);
4137 {$endif}
4138 *)
4139 end;
4140
4141 { TDBGridColumns }
4142
GetColumnnull4143 function TDBGridColumns.GetColumn(Index: Integer): TColumn;
4144 begin
4145 result := TColumn( inherited Items[Index] );
4146 end;
4147
4148 procedure TDBGridColumns.SetColumn(Index: Integer; Value: TColumn);
4149 begin
4150 Items[Index].Assign( Value );
4151 end;
4152
4153 procedure TDBGridColumns.Update(Item: TCollectionItem);
4154 begin
4155 if (Grid<>nil) and not (csLoading in Grid.ComponentState) then
4156 TCustomDBGrid(Grid).LayoutChanged;
4157 end;
4158
TDBGridColumns.ColumnFromFieldnull4159 function TDBGridColumns.ColumnFromField(Field: TField): TColumn;
4160 var
4161 i: Integer;
4162 begin
4163 if Field<>nil then
4164 for i:=0 to Count-1 do begin
4165 result := Items[i];
4166 if (result<>nil)and(result.Field=Field) then
4167 exit;
4168 end;
4169 result:=nil;
4170 end;
4171
HasAutomaticColumnsnull4172 function TDBGridColumns.HasAutomaticColumns: boolean;
4173 var
4174 i: Integer;
4175 begin
4176 Result := False;
4177 for i:=0 to Count-1 do
4178 if Items[i].IsAutomaticColumn then begin
4179 Result := true;
4180 break;
4181 end;
4182 end;
4183
TDBGridColumns.HasDesignColumnsnull4184 function TDBGridColumns.HasDesignColumns: boolean;
4185 var
4186 i: Integer;
4187 begin
4188 Result := False;
4189 for i:=0 to Count-1 do
4190 if Items[i].IsDesignColumn then begin
4191 Result := true;
4192 break;
4193 end;
4194 end;
4195
4196 procedure TDBGridColumns.RemoveAutoColumns;
4197 var
4198 i: Integer;
4199 G: TCustomDBGrid;
4200 begin
4201 if HasAutomaticColumns then begin
4202 G := TCustomDBGrid(Grid);
4203 G.GridStatus := G.GridStatus + [gsRemovingAutoColumns];
4204 BeginUpdate;
4205 try
4206 for i:=Count-1 downto 0 do
4207 if Items[i].IsAutomaticColumn then
4208 Delete(i);
4209 finally
4210 EndUpdate;
4211 G.GridStatus := G.GridStatus - [gsRemovingAutoColumns];
4212 end;
4213 end;
4214 end;
4215
CompareFieldIndexnull4216 function CompareFieldIndex(P1,P2:Pointer): integer;
4217 begin
4218 if P1=P2 then
4219 Result := 0
4220 else if (P1=nil) or (TColumn(P1).Field=nil) then
4221 Result := 1
4222 else if (P2=nil) or (TColumn(P2).Field=nil) then
4223 Result := -1
4224 else
4225 Result := TColumn(P1).Field.Index - TColumn(P2).Field.Index;
4226 end;
4227
CompareDesignIndexnull4228 function CompareDesignIndex(P1,P2:Pointer): integer;
4229 begin
4230 result := TColumn(P1).DesignIndex - TColumn(P2).DesignIndex;
4231 end;
4232
4233 procedure TDBGridColumns.ResetColumnsOrder(ColumnOrder: TColumnOrder);
4234 var
4235 L: TList;
4236 i: Integer;
4237 begin
4238 L := TList.Create;
4239 try
4240
4241 for i:=0 to Count-1 do
4242 L.Add(Items[i]);
4243
4244 case ColumnOrder of
4245 coDesignOrder:
4246 begin
4247 if not HasDesignColumns then
4248 exit;
4249 L.Sort(@CompareDesignIndex)
4250 end;
4251 coFieldIndexOrder:
4252 L.Sort(@CompareFieldIndex);
4253 else
4254 exit;
4255 end;
4256
4257 for i:=0 to L.Count-1 do
4258 TColumn(L.Items[i]).Index := i;
4259
4260 finally
4261 L.Free;
4262 end;
4263 end;
4264
Addnull4265 function TDBGridColumns.Add: TColumn;
4266 var
4267 G: TCustomDBGrid;
4268 begin
4269 {$ifdef dbgDBGrid}
4270 DebugLn('%s.Add', [ClassName]);
4271 {$endif}
4272 G := TCustomDBGrid(Grid);
4273 if G<>nil then begin
4274 // remove automatic columns before adding user columns
4275 if not (gsAddingAutoColumns in G.GridStatus) then
4276 RemoveAutoColumns;
4277 end;
4278 result := TColumn( inherited add );
4279 end;
4280
TDBGridColumns.ColumnByFieldnamenull4281 function TDBGridColumns.ColumnByFieldname(const aFieldname: string): TColumn;
4282 var
4283 i: Integer;
4284 begin
4285 result := nil;
4286 for i:=0 to Count-1 do
4287 if CompareText(Items[i].FieldName, aFieldname)=0 then begin
4288 result := Items[i];
4289 break;
4290 end;
4291 end;
4292
ColumnByTitlenull4293 function TDBGridColumns.ColumnByTitle(const aTitle: string): TColumn;
4294 begin
4295 result := TColumn(inherited ColumnByTitle(aTitle));
4296 end;
4297
4298 procedure TDBGridColumns.LinkFields;
4299 var
4300 i: Integer;
4301 G: TCustomDBGrid;
4302 begin
4303 G := TCustomDBGrid(Grid);
4304 if G<>nil then
4305 G.BeginLayout;
4306 for i:=0 to Count-1 do
4307 Items[i].LinkField;
4308 if G<>nil then
4309 G.EndLayout;
4310 end;
4311
4312 { TColumn }
4313
GetFieldnull4314 function TColumn.GetField: TField;
4315 begin
4316 if (FFieldName<>'') and (FField<>nil) then
4317 LinkField;
4318 result := FField;
4319 end;
4320
GetIsDesignColumnnull4321 function TColumn.GetIsDesignColumn: boolean;
4322 begin
4323 result := (DesignIndex>=0) and (DesignIndex<10000);
4324 end;
4325
TColumn.GetPickListnull4326 function TColumn.GetPickList: TStrings;
4327 begin
4328 Result := inherited GetPickList;
4329 if (Field<>nil) and (FField.FieldKind=fkLookup) then
4330 begin
4331 if FField.LookupCache then
4332 FField.LookupList.ValuesToStrings(Result)
4333 else
4334 begin
4335 Result.Clear;
4336 LookupGetBookMark(FField);
4337 try
4338 with FField.LookupDataSet do
4339 begin
4340 First;
4341 while not EOF do
4342 begin
4343 Result.Add(FieldbyName(FField.LookupResultField).AsString);
4344 Next;
4345 end;
4346 end;
4347 finally
4348 LookupGotoBookMark(FField);
4349 end;
4350 end;
4351 end;
4352 end;
4353
4354 procedure TColumn.ApplyDisplayFormat;
4355 begin
4356 if (FField <> nil) and FDisplayFormatChanged then begin
4357 if (FField is TNumericField) then
4358 TNumericField(FField).DisplayFormat := DisplayFormat
4359 else if (FField is TDateTimeField) then
4360 TDateTimeField(FField).DisplayFormat := DisplayFormat;
4361 end;
4362 end;
4363
GetDisplayFormatnull4364 function TColumn.GetDisplayFormat: string;
4365 begin
4366 if not FDisplayFormatChanged then
4367 Result := GetDefaultDisplayFormat
4368 else
4369 result := FDisplayFormat;
4370 end;
4371
IsDisplayFormatStorednull4372 function TColumn.IsDisplayFormatStored: boolean;
4373 begin
4374 Result := FDisplayFormatChanged;
4375 end;
4376
4377 procedure TColumn.SetDisplayFormat(const AValue: string);
4378 begin
4379 if (not FDisplayFormatChanged)or(CompareText(AValue, FDisplayFormat)<>0) then begin
4380 FDisplayFormat := AValue;
4381 FDisplayFormatChanged:=True;
4382 ColumnChanged;
4383 end;
4384 end;
4385
4386 procedure TColumn.SetField(const AValue: TField);
4387 begin
4388 if FField <> AValue then begin
4389 FField := AValue;
4390 if FField<>nil then
4391 FFieldName := FField.FieldName;
4392 ColumnChanged;
4393 end;
4394 end;
4395
4396 procedure TColumn.SetFieldName(const AValue: String);
4397 begin
4398 if FFieldName=AValue then exit;
4399 FFieldName:=AValue;
4400 LinkField;
4401 ColumnChanged;
4402 end;
4403
GetDataSetnull4404 function TColumn.GetDataSet: TDataSet;
4405 var
4406 AGrid: TCustomDBGrid;
4407 begin
4408 AGrid := TCustomDBGrid(Grid);
4409 if (AGrid<>nil) then
4410 result := AGrid.FDataLink.DataSet
4411 else
4412 result :=nil;
4413 end;
4414
4415 procedure TColumn.Assign(Source: TPersistent);
4416 begin
4417 if Source is TColumn then begin
4418 //DebugLn('Assigning TColumn[',dbgs(Index),'] a TColumn')
4419 Collection.BeginUpdate;
4420 try
4421 inherited Assign(Source);
4422 FieldName := TColumn(Source).FieldName;
4423 DisplayFormat := TColumn(Source).DisplayFormat;
4424 ValueChecked := TColumn(Source).ValueChecked;
4425 ValueUnchecked := TColumn(Source).ValueUnchecked;
4426 finally
4427 Collection.EndUpdate;
4428 end;
4429 end else
4430 inherited Assign(Source);
4431 end;
4432
GetDefaultWidthnull4433 function TColumn.GetDefaultWidth: Integer;
4434 var
4435 AGrid: TCustomDBGrid;
4436 tmpCanvas: TCanvas;
4437 begin
4438 AGrid := TCustomDBGrid(Grid);
4439 if AGrid<>nil then begin
4440
4441 tmpCanvas := GetWorkingCanvas(aGrid.Canvas);
4442 tmpCanvas.Font := aGrid.Font;
4443
4444 if FField<>nil then
4445 result := CalcColumnFieldWidth(
4446 tmpCanvas,
4447 dgTitles in aGrid.Options,
4448 Title.Caption,
4449 Title.Font,
4450 FField)
4451 else
4452 result := AGrid.DefaultColWidth;
4453
4454 if tmpCanvas<>AGrid.Canvas then
4455 FreeWorkingCanvas(tmpCanvas);
4456
4457 end else
4458 result := -1;
4459 end;
4460
CreateTitlenull4461 function TColumn.CreateTitle: TGridColumnTitle;
4462 begin
4463 Result := TColumnTitle.Create(Self);
4464 end;
4465
4466 constructor TColumn.Create(ACollection: TCollection);
4467 var
4468 AGrid: TCustomGrid;
4469 begin
4470 {$ifdef dbgDBGrid}
4471 DebugLn('%s.Create', [ClassName]);
4472 {$endif}
4473 inherited Create(ACollection);
4474 if ACollection is TDBGridColumns then begin
4475 AGrid := TDBGridColumns(ACollection).Grid;
4476 if (AGrid<>nil) and (csLoading in AGrid.ComponentState) then
4477 FDesignIndex := Index
4478 else
4479 FDesignIndex := 10000;
4480 end;
4481 end;
4482
IsDefaultnull4483 function TColumn.IsDefault: boolean;
4484 begin
4485 result := not FDisplayFormatChanged and (inherited IsDefault());
4486 end;
4487
4488 procedure TColumn.LinkField;
4489 var
4490 AGrid: TCustomDBGrid;
4491 begin
4492 AGrid:= TCustomDBGrid(Grid);
4493 if (AGrid<>nil) and AGrid.FDatalink.Active then begin
4494 Field := AGrid.FDataLink.DataSet.FindField(FFieldName);
4495 ApplyDisplayFormat;
4496 end else
4497 Field := nil;
4498 end;
4499
GetDefaultDisplayFormatnull4500 function TColumn.GetDefaultDisplayFormat: string;
4501 begin
4502 Result := '';
4503 if FField<>nil then begin
4504 if FField is TNumericField then
4505 Result := TNumericField(FField).DisplayFormat
4506 else if FField is TDateTimeField then
4507 Result := TDateTimeField(FField).DisplayFormat
4508 end;
4509 end;
4510
TColumn.GetDefaultValueCheckednull4511 function TColumn.GetDefaultValueChecked: string;
4512 begin
4513 if (FField<>nil) and (FField.Datatype=ftBoolean) then
4514 Result := BoolToStr(True)
4515 else
4516 Result := '1';
4517 end;
4518
TColumn.GetDefaultValueUncheckednull4519 function TColumn.GetDefaultValueUnchecked: string;
4520 begin
4521 if (FField<>nil) and (FField.DataType=ftBoolean) then
4522 Result := BoolToStr(False)
4523 else
4524 Result := '0';
4525 end;
4526
TColumn.GetDefaultReadOnlynull4527 function TColumn.GetDefaultReadOnly: boolean;
4528 var
4529 AGrid: TCustomDBGrid;
4530 begin
4531 AGrid := TCustomDBGrid(Grid);
4532 Result := ((AGrid<>nil)and(AGrid.ReadOnly)) or ((FField<>nil)And(FField.ReadOnly))
4533 end;
4534
GetDefaultVisiblenull4535 function TColumn.GetDefaultVisible: boolean;
4536 begin
4537 if FField<>nil then
4538 result := FField.Visible
4539 else
4540 result := True;
4541 end;
4542
TColumn.GetDisplayNamenull4543 function TColumn.GetDisplayName: string;
4544 begin
4545 if FFieldName<>'' then
4546 Result:=FFieldName
4547 else
4548 Result:=inherited GetDisplayName;
4549 end;
4550
GetDefaultAlignmentnull4551 function TColumn.GetDefaultAlignment: TAlignment;
4552 var
4553 Bs: set of TColumnButtonStyle;
4554 begin
4555 bs := [buttonStyle];
4556 if Grid<>nil then
4557 Include(bs, TCustomDbGrid(Grid).DefaultEditorStyle(ButtonStyle, FField));
4558 if bs*[cbsCheckboxColumn,cbsButtonColumn]<>[] then
4559 result := taCenter
4560 else
4561 if FField<>nil then
4562 result := FField.Alignment
4563 else
4564 Result := taLeftJustify;
4565 end;
4566
4567 { TColumnTitle }
4568
TColumnTitle.GetDefaultCaptionnull4569 function TColumnTitle.GetDefaultCaption: string;
4570 begin
4571 with (Column as TColumn) do begin
4572 if FieldName<>'' then begin
4573 if FField<>nil then
4574 Result := FField.DisplayName
4575 else
4576 Result := Fieldname;
4577 end else
4578 Result := inherited GetDefaultCaption;
4579 end;
4580 end;
4581
4582 { TBookmarkList }
4583
GetCountnull4584 function TBookmarkList.GetCount: integer;
4585 begin
4586 {$ifdef dbgDBGrid}
4587 DebugLn('%s.GetCount FList.Count=%d',[ClassName, FList.Count]);
4588 {$endif}
4589 result := FList.Count;
4590 end;
4591
GetCurrentRowSelectednull4592 function TBookmarkList.GetCurrentRowSelected: boolean;
4593 var
4594 Bookmark: TBookmark;
4595 begin
4596 CheckActive;
4597 Bookmark := FDataset.GetBookmark;
4598 Result := IndexOf(Bookmark)>=0;
4599 FDataset.FreeBookmark(Bookmark);
4600 end;
4601
GetItemnull4602 function TBookmarkList.GetItem(AIndex: Integer): TBookmark;
4603 begin
4604 Result := TBookmark(FList[AIndex]);
4605 end;
4606
4607 procedure TBookmarkList.SetCurrentRowSelected(const AValue: boolean);
4608 var
4609 Bookmark: pointer;
4610 Index: Integer;
4611 begin
4612 CheckActive;
4613
4614 Bookmark := nil;
4615 TBookmark(Bookmark) := FDataset.GetBookmark; // fetch and increase reference count
4616 if Bookmark = nil then
4617 Exit;
4618
4619 if Find(Bookmark, Index) then begin
4620 FDataset.FreeBookmark(Bookmark);
4621 {$ifndef noautomatedbookmark}
4622 SetLength(TBookmark(Bookmark),0); // decrease reference count
4623 {$endif noautomatedbookmark}
4624 if not AValue then begin
4625 FDataset.FreeBookmark(Pointer(Items[Index]));
4626 {$ifndef noautomatedbookmark}
4627 Bookmark := FList[Index];
4628 SetLength(TBookmark(Bookmark),0); // decrease reference count
4629 {$endif noautomatedbookmark}
4630 FList.Delete(Index);
4631 FGrid.Invalidate;
4632 end;
4633 end else begin
4634 if AValue then begin
4635 // the reference count of Bookmark was increased above, so it is save to
4636 // store it here as pointer
4637 FList.Insert(Index, Bookmark);
4638 FGrid.Invalidate;
4639 end else
4640 FDataset.FreeBookmark(Bookmark);
4641 end;
4642 end;
4643
4644 procedure TBookmarkList.CheckActive;
4645 begin
4646 {$ifdef dbgDBGrid}
4647 DebugLn('%s.CheckActive', [ClassName]);
4648 {$endif}
4649 if not FGrid.FDataLink.Active then
4650 raise EInvalidGridOperation.Create('Dataset Inactive');
4651
4652 if FGrid.DataSource.DataSet=FDataset then
4653 exit;
4654 FDataset := FGrid.DataSource.DataSet;
4655
4656 // Note.
4657 //
4658 // fpc help say CompareBookmarks should return -1, 0 or 1 ... which imply that
4659 // bookmarks should be a sorted array (or list). In this scenario binary search
4660 // is the prefered method for finding a bookmark.
4661 //
4662 // The problem here is that TBufDataset and TSQLQuery (and thus TCustomSQLQuery
4663 // and TCustomBufDataset) CompareBookmarks only return 0 or -1 (some kind of
4664 // is this a valid bookmark or not), the result is that it appears as an unsorted
4665 // list (or array) and binary search should not be used.
4666 //
4667 // The weird thing is that if we use MyCompareBookmarks which deals with comparing
4668 // the memory reserved for bookmarks in the hope bookmarks are just some kind of
4669 // reocord indexes, currently work fine for TCustomBufDataset derived datasets.
4670 // however using CompareBookmarks is always the right thing to use where implemented.
4671 //
4672 // As Dbgrid should be TDataset implementation agnostic this is a way I found
4673 // to know if the dataset is derived from TCustomBufDataset or not.
4674 // Once TCustomBufDataset is fixed, remove this ugly note & hack.
4675 case FDataset.ClassName of
4676 'TSQLQuery','TBufDataset','TCustomSQLQuery','TCustomBufDataset':
4677 FCanDoBinarySearch := false;
4678 else
4679 FCanDoBinarySearch := true;
4680 end;
4681 end;
4682
TBookmarkList.GetEnumeratornull4683 function TBookmarkList.GetEnumerator(opt: TBookmarkedRecordEnumeratorOptions
4684 ): TBookmarkedRecordEnumerator;
4685 begin
4686 result := TBookmarkedRecordEnumerator.Create(self, fGrid, opt);
4687 end;
4688
4689 constructor TBookmarkList.Create(AGrid: TCustomDbGrid);
4690 begin
4691 inherited Create;
4692 FGrid := AGrid;
4693 FList := TFPList.Create;
4694 end;
4695
4696 destructor TBookmarkList.Destroy;
4697 begin
4698 Clear;
4699 FreeAndNil(FList);
4700 inherited Destroy;
4701 end;
4702
4703 procedure TBookmarkList.Clear;
4704 var
4705 i: Integer;
4706 {$ifndef noautomatedbookmark}
4707 Bookmark: Pointer;
4708 {$endif}
4709 begin
4710 for i:=0 to FList.Count-1 do
4711 begin
4712 {$ifdef dbgDBGrid}
4713 DebugLn('%s.Clear', [ClassName]);
4714 {$endif}
4715 FDataset.FreeBookmark(Items[i]);
4716 {$ifndef noautomatedbookmark}
4717 Bookmark := FList[i];
4718 SetLength(TBookmark(Bookmark),0); // decrease reference count
4719 {$endif noautomatedbookmark}
4720 end;
4721 FList.Clear;
4722 FGrid.Invalidate;
4723 end;
4724
4725 procedure TBookmarkList.Delete;
4726 var
4727 i: Integer;
4728 {$ifndef noautomatedbookmark}
4729 Bookmark: Pointer;
4730 {$endif}
4731 begin
4732 {$ifdef dbgDBGrid}
4733 DebugLn('%s.Delete', [ClassName]);
4734 {$endif}
4735 for i := FList.Count-1 downto 0 do begin
4736 FDataset.GotoBookmark(Items[i]);
4737 {$ifndef noautomatedbookmark}
4738 Bookmark := FList[i];
4739 SetLength(TBookmark(Bookmark),0); // decrease reference count
4740 {$else}
4741 FDataset.FreeBookmark(Items[i]);
4742 {$endif noautomatedbookmark}
4743 FDataset.Delete;
4744 FList.Delete(i);
4745 end;
4746 end;
4747
4748 type
4749 TDs=class(TDataset)
4750 end;
4751
Findnull4752 function TBookmarkList.Find(const Item: TBookmark; var AIndex: Integer): boolean;
4753 var
4754 L, R, I: Integer;
4755 CompareRes: Integer;
4756
4757 procedure BinarySearch;
4758 begin
4759 L := 0;
4760 R := FList.Count - 1;
4761 while (L <= R) do
4762 begin
4763 I := L + (R - L) div 2;
4764 CompareRes := FDataset.CompareBookmarks(Item, TBookmark(FList[I]));
4765 if (CompareRes > 0) then
4766 L := I + 1
4767 else
4768 begin
4769 R := I - 1;
4770 if (CompareRes = 0) then
4771 begin
4772 Result := True;
4773 L := I;
4774 end;
4775 end;
4776 end;
4777 AIndex := L;
4778 end;
4779
4780 procedure VisitAll;
4781 begin
4782 AIndex := 0;
4783 i := 0;
4784 while i<FList.Count do begin
4785 CompareRes := FDataset.CompareBookmarks(Item, TBookmark(FList[I]));
4786 if CompareRes=0 then begin
4787 result := true;
4788 AIndex := i;
4789 exit;
4790 end;
4791 inc(i);
4792 end;
4793 end;
4794
4795 begin
4796 {$ifdef dbgDBGrid}
4797 DebugLn('%s.Find', [ClassName]);
4798 {$endif}
4799
4800 Result := False;
4801 if Item=nil then
4802 Exit;
4803 if FCanDoBinarySearch then
4804 BinarySearch
4805 else
4806 VisitAll;
4807 end;
4808
IndexOfnull4809 function TBookmarkList.IndexOf(const Item: TBookmark): Integer;
4810 begin
4811 {$ifdef dbgDBGrid}
4812 DebugLn('%s.IndexOf', [ClassName]);
4813 {$endif}
4814 if not Find(Item, Result) then
4815 Result := -1;
4816 end;
4817
Refreshnull4818 function TBookmarkList.Refresh: boolean;
4819 var
4820 i: LongInt;
4821 {$ifndef noautomatedbookmark}
4822 Bookmark: Pointer;
4823 {$endif}
4824 begin
4825 {$ifdef dbgDBGrid}
4826 DebugLn('%s.Refresh', [ClassName]);
4827 {$endif}
4828 Result := False;
4829 for i := FList.Count - 1 downto 0 do
4830 if not FDataset.BookmarkValid(TBookMark(Items[i])) then begin
4831 Result := True;
4832 FDataset.FreeBookmark(Items[i]);
4833 {$ifndef noautomatedbookmark}
4834 Bookmark := FList[i];
4835 SetLength(TBookmark(Bookmark),0); // decrease reference count
4836 {$endif noautomatedbookmark}
4837 Flist.Delete(i);
4838 end;
4839 if Result then
4840 FGrid.Invalidate;
4841 end;
4842
4843 end.
4844