1 { $Id$}
2 {
3 /***************************************************************************
4 Grids.pas
5 ---------
6 An interface to DB aware Controls
7 Initial Revision : Sun Sep 14 2003
8
9
10 ***************************************************************************/
11
12 *****************************************************************************
13 This file is part of the Lazarus Component Library (LCL)
14
15 See the file COPYING.modifiedLGPL.txt, included in this distribution,
16 for details about the license.
17 *****************************************************************************
18 }
19 {
20
21 TCustomGrid, TDrawGrid and TStringGrid for Lazarus
22 Copyright (C) 2002 Jesus Reyes Aguilar.
23 email: jesusrmx@yahoo.com.mx
24
25 }
26
27 unit Grids;
28
29 {$mode objfpc}{$H+}
30 {$modeswitch nestedprocvars}
31 {$define NewCols}
32
33 interface
34
35 uses
36 // RTL + FCL
37 Classes, SysUtils, Types, TypInfo, Math, FPCanvas, HtmlDefs, StrUtils,
38 // LCL
39 LCLStrConsts, LCLType, LCLIntf, Controls, Graphics, Forms,
40 LMessages, StdCtrls, LResources, MaskEdit, Buttons, Clipbrd, Themes, imglist,
41 // LazUtils
42 LazFileUtils, DynamicArray, Maps, LazUTF8, Laz2_XMLCfg,
43 LazLoggerBase, LazUtilities, LCSVUtils, IntegerList
44 {$ifdef WINDOWS}
45 ,messages, imm
46 {$endif}
47 ;
48
49 const
50 //GRIDFILEVERSION = 1; // Original
51 //GRIDFILEVERSION = 2; // Introduced goSmoothScroll
52 GRIDFILEVERSION = 3; // Introduced Col/Row FixedAttr and NormalAttr
53
54 const
55 GM_SETVALUE = LM_INTERFACELAST + 100;
56 GM_GETVALUE = LM_INTERFACELAST + 101;
57 GM_SETGRID = LM_INTERFACELAST + 102;
58 GM_SETBOUNDS = LM_INTERFACELAST + 103;
59 GM_SELECTALL = LM_INTERFACELAST + 104;
60 GM_SETMASK = LM_INTERFACELAST + 105;
61 GM_SETPOS = LM_INTERFACELAST + 106;
62 GM_READY = LM_INTERFACELAST + 107;
63 GM_GETGRID = LM_INTERFACELAST + 108;
64
65
66 const
67 EO_AUTOSIZE = $1;
68 EO_HOOKKEYDOWN = $2;
69 EO_HOOKKEYPRESS = $4;
70 EO_HOOKKEYUP = $8;
71 EO_SELECTALL = $10;
72 EO_IMPLEMENTED = $20;
73
74 const
75 DEFCOLWIDTH = 64;
76 DEFBUTTONWIDTH = 25;
77 DEFIMAGEPADDING = 2;
78
79 type
80 EGridException = class(Exception);
81
82 type
83 TGridOption = (
84 goFixedVertLine, // Ya
85 goFixedHorzLine, // Ya
86 goVertLine, // Ya
87 goHorzLine, // Ya
88 goRangeSelect, // Ya
89 goDrawFocusSelected, // Ya
90 goRowSizing, // Ya
91 goColSizing, // Ya
92 goRowMoving, // Ya
93 goColMoving, // Ya
94 goEditing, // Ya
95 goAutoAddRows, // JuMa
96 goTabs, // Ya
97 goRowSelect, // Ya
98 goAlwaysShowEditor, // Ya
99 goThumbTracking, // ya
100 // Additional Options
101 goColSpanning, // Enable cellextent calcs
102 goRelaxedRowSelect, // User can see focused cell on goRowSelect
103 goDblClickAutoSize, // dblclicking columns borders (on hdrs) resize col.
104 goSmoothScroll, // Switch scrolling mode (pixel scroll is by default)
105 goFixedRowNumbering, // Ya
106 goScrollKeepVisible, // keeps focused cell visible while scrolling
107 goHeaderHotTracking, // Header cells change look when mouse is over them
108 goHeaderPushedLook, // Header cells looks pushed when clicked
109 goSelectionActive, // Setting grid.Selection moves also cell cursor
110 goFixedColSizing, // Allow to resize fixed columns
111 goDontScrollPartCell, // clicking partially visible cells will not scroll
112 goCellHints, // show individual cell hints
113 goTruncCellHints, // show cell hints if cell text is too long
114 goCellEllipsis, // show "..." if cell text is too long
115 goAutoAddRowsSkipContentCheck,//BB Also add a row (if AutoAddRows in Options) if last row is empty
116 goRowHighlight // Highlight the current Row
117 );
118 TGridOptions = set of TGridOption;
119
120 TGridOption2 = (
121 goScrollToLastCol, // allow scrolling to last column (so that last column can be leftcol)
122 goScrollToLastRow // allow scrolling to last row (so that last row can be toprow)
123 );
124 TGridOptions2 = set of TGridOption2;
125
126 TGridSaveOptions = (
127 soDesign, // Save grid structure (col/row count and Options)
128 soAttributes, // Save grid attributes (Font,Brush,TextStyle)
129 soContent, // Save Grid Content (Text in stringgrid)
130 soPosition // Save Grid cursor and selection position
131 );
132 TSaveOptions = set of TGridSaveOptions;
133
134 TGridDrawState = set of (gdSelected, gdFocused, gdFixed, gdHot, gdPushed, gdRowHighlight);
135 TGridState =(gsNormal, gsSelecting, gsRowSizing, gsColSizing, gsRowMoving,
136 gsColMoving, gsHeaderClicking, gsButtonColumnClicking);
137
138 TGridZone = (gzNormal, gzFixedCols, gzFixedRows, gzFixedCells, gzInvalid);
139 TGridZoneSet = set of TGridZone;
140
141 TAutoAdvance = (aaNone,aaDown,aaRight,aaLeft, aaRightDown, aaLeftDown,
142 aaRightUp, aaLeftUp);
143
144 { Option goRangeSelect: --> select a single range only, or multiple ranges }
145 TRangeSelectMode = (rsmSingle, rsmMulti);
146
147 TItemType = (itNormal,itCell,itColumn,itRow,itFixed,itFixedColumn,itFixedRow,itSelected);
148
149 TColumnButtonStyle = (
150 cbsAuto,
151 cbsEllipsis,
152 cbsNone,
153 cbsPickList,
154 cbsCheckboxColumn,
155 cbsButton,
156 cbsButtonColumn
157 );
158
159 TTitleStyle = (tsLazarus, tsStandard, tsNative);
160
161 TGridFlagsOption = (gfEditorUpdateLock, gfNeedsSelectActive, gfEditorTab,
162 gfRevEditorTab, gfVisualChange, gfColumnsLocked,
163 gfEditingDone, gfSizingStarted, gfPainting, gfUpdatingSize, gfClientRectChange,
164 gfAutoEditPending, gfUpdatingScrollbar);
165 TGridFlags = set of TGridFlagsOption;
166
167 TSortOrder = (soAscending, soDescending);
168
169 TPrefixOption = (poNone, poHeaderClick);
170
171 TMouseWheelOption = (mwCursor, mwGrid);
172
173 TCellHintPriority = (chpAll, chpAllNoDefault, chpTruncOnly);
174 // The grid can display three types of hint: the default hint (Hint property),
175 // individual cell hints (OnCellHint event), and hints for truncated cells.
176 // TCellHintPriority determines how the overall hint is combined when more
177 // multiple hint texts are to be displayed.
178
179 TCellProcessType = (cpCopy, cpPaste);
180
181 const
182 soAll: TSaveOptions = [soDesign, soAttributes, soContent, soPosition];
183
184 DefaultGridOptions = [goFixedVertLine, goFixedHorzLine,
185 goVertLine, goHorzLine, goRangeSelect, goSmoothScroll ];
186 DefaultGridOptions2 = [];
187
188 constRubberSpace: byte = 2;
189 constCellPadding: byte = 3;
190 constColRowBorderTolerance: byte = 3;
191
192 var
193 // Values to be used after HighDPI scaling
194 varRubberSpace: byte;
195 varCellpadding: byte;
196 varColRowBorderTolerance: byte;
197
198 type
199
200 TCustomGrid = class;
201 TGridColumn = class;
202
203 PCellProps= ^TCellProps;
204 TCellProps=record
205 Attr: pointer;
206 Data: TObject;
207 Text: pchar;
208 end;
209
210 PColRowProps= ^TColRowProps;
211 TColRowProps=record
212 Size: Integer;
213 FixedAttr: pointer;
214 NormalAttr: pointer;
215 end;
216
217 PGridMessage=^TGridMessage;
218 TGridMessage=record
219 LclMsg: TLMessage;
220 Grid: TCustomGrid;
221 Col,Row: Integer;
222 Value: string;
223 CellRect: TRect;
224 Options: Integer;
225 end;
226
227 type
228 { Default cell editor for TStringGrid }
229 { TStringCellEditor }
230
231 TStringCellEditor=class(TCustomMaskEdit)
232 private
233 FGrid: TCustomGrid;
234 FCol,FRow:Integer;
235 protected
236 procedure WndProc(var TheMessage : TLMessage); override;
237 procedure Change; override;
238 procedure KeyDown(var Key : Word; Shift : TShiftState); override;
239 procedure msg_SetMask(var Msg: TGridMessage); message GM_SETMASK;
240 procedure msg_SetValue(var Msg: TGridMessage); message GM_SETVALUE;
241 procedure msg_GetValue(var Msg: TGridMessage); message GM_GETVALUE;
242 procedure msg_SetGrid(var Msg: TGridMessage); message GM_SETGRID;
243 procedure msg_SelectAll(var Msg: TGridMessage); message GM_SELECTALL;
244 procedure msg_SetPos(var Msg: TGridMessage); message GM_SETPOS;
245 procedure msg_GetGrid(var Msg: TGridMessage); message GM_GETGRID;
246 public
247 constructor Create(Aowner : TComponent); override;
248 procedure EditingDone; override;
249 property EditText;
250 property OnEditingDone;
251 end;
252
253 { TButtonCellEditor }
254
255 TButtonCellEditor = class(TButton)
256 private
257 FGrid: TCustomGrid;
258 FCol,FRow: Integer;
259 protected
260 procedure msg_SetGrid(var Msg: TGridMessage); message GM_SETGRID;
261 procedure msg_SetBounds(var Msg: TGridMessage); message GM_SETBOUNDS;
262 procedure msg_SetPos(var Msg: TGridMessage); message GM_SETPOS;
263 procedure msg_Ready(var Msg: TGridMessage); message GM_READY;
264 procedure msg_GetGrid(var Msg: TGridMessage); message GM_GETGRID;
265 public
266 property Col: Integer read FCol;
267 property Row: Integer read FRow;
268 end;
269
270 { TPickListCellEditor }
271
272 TPickListCellEditor = class(TCustomComboBox)
273 private
274 FGrid: TCustomGrid;
275 FCol,FRow: Integer;
276 protected
277 procedure WndProc(var TheMessage : TLMessage); override;
278 procedure KeyDown(var Key : Word; Shift : TShiftState); override;
279 procedure DropDown; override;
280 procedure CloseUp; override;
281 procedure Select; override;
282 procedure Change; override;
283 procedure msg_GetValue(var Msg: TGridMessage); message GM_GETVALUE;
284 procedure msg_SetGrid(var Msg: TGridMessage); message GM_SETGRID;
285 procedure msg_SetValue(var Msg: TGridMessage); message GM_SETVALUE;
286 procedure msg_SetPos(var Msg: TGridMessage); message GM_SETPOS;
287 procedure msg_GetGrid(var Msg: TGridMessage); message GM_GETGRID;
288 public
289 procedure EditingDone; override;
290 property BorderStyle;
291 property OnEditingDone;
292 end;
293
294 { TCompositeCellEditor }
295
296 TEditorItem = record
297 Editor: TWinControl;
298 Align: TAlign;
299 ActiveControl: boolean;
300 end;
301
302 TCompositeCellEditor = class(TWinControl)
303 private
304 FGrid: TCustomGrid;
305 FCol,FRow: Integer;
306 FEditors: array of TEditorItem;
307 procedure DispatchMsg(msg: TGridMessage);
GetMaxLengthnull308 function GetMaxLength: Integer;
309 procedure SetMaxLength(AValue: Integer);
310 protected
DoUTF8KeyPressnull311 function DoUTF8KeyPress(var UTF8Key: TUTF8Char): boolean; override;
312 procedure msg_GetValue(var Msg: TGridMessage); message GM_GETVALUE;
313 procedure msg_SetGrid(var Msg: TGridMessage); message GM_SETGRID;
314 procedure msg_SetValue(var Msg: TGridMessage); message GM_SETVALUE;
315 procedure msg_SetBounds(var Msg: TGridMessage); message GM_SETBOUNDS;
316 procedure msg_SetMask(var Msg: TGridMessage); message GM_SETMASK;
317 procedure msg_SelectAll(var Msg: TGridMessage); message GM_SELECTALL;
318 procedure CMControlChange(var Message: TLMEssage); message CM_CONTROLCHANGE;
319 procedure msg_SetPos(var Msg: TGridMessage); message GM_SETPOS;
320 procedure msg_GetGrid(var Msg: TGridMessage); message GM_GETGRID;
GetActiveControlnull321 function GetActiveControl: TWinControl;
322 procedure VisibleChanging; override;
SendCharnull323 function SendChar(AChar: TUTF8Char): Integer;
324 procedure WndProc(var TheMessage : TLMessage); override;
325 public
326 destructor Destroy; override;
327 procedure AddEditor(aEditor: TWinControl; aAlign: TAlign; ActiveCtrl:boolean);
328 procedure SetFocus; override;
Focusednull329 function Focused: Boolean; override;
330 property MaxLength: Integer read GetMaxLength write SetMaxLength;
331 property ActiveControl: TWinControl read GetActiveControl;
332 end;
333
334
335 TOnDrawCell =
336 procedure(Sender: TObject; aCol, aRow: Integer; aRect: TRect;
337 aState:TGridDrawState) of object;
338
339 TOnSelectCellEvent =
340 procedure(Sender: TObject; aCol, aRow: Integer;
341 var CanSelect: Boolean) of object;
342
343 TOnSelectEvent =
344 procedure(Sender: TObject; aCol, aRow: Integer) of object;
345
346 TGridOperationEvent =
347 procedure (Sender: TObject; IsColumn:Boolean;
348 sIndex, tIndex: Integer) of object;
349
350 THdrEvent =
351 procedure(Sender: TObject; IsColumn: Boolean; Index: Integer) of object;
352
353 TOnCompareCells =
354 procedure (Sender: TObject; ACol, ARow, BCol,BRow: Integer;
355 var Result: integer) of object;
356
357 TSelectEditorEvent =
358 procedure(Sender: TObject; aCol, aRow: Integer;
359 var Editor: TWinControl) of object;
360
361 TOnPrepareCanvasEvent =
362 procedure(sender: TObject; aCol, aRow: Integer;
363 aState: TGridDrawState) of object;
364
365 TUserCheckBoxBitmapEvent =
366 procedure(Sender: TObject; const aCol, aRow: Integer;
367 const CheckedState: TCheckboxState;
368 var ABitmap: TBitmap) of object;
369
370 TUserCheckBoxImageEvent =
371 procedure(Sender: TObject; const aCol, aRow: Integer;
372 const CheckedState: TCheckBoxState;
373 var ImageList: TCustomImageList;
374 var ImageIndex: TImageIndex) of object;
375
376 TValidateEntryEvent =
377 procedure(sender: TObject; aCol, aRow: Integer;
378 const OldValue: string; var NewValue: String) of object;
379
380 TToggledCheckboxEvent = procedure(sender: TObject; aCol, aRow: Integer;
381 aState: TCheckboxState) of object;
382
383 THeaderSizingEvent = procedure(sender: TObject; const IsColumn: boolean;
384 const aIndex, aSize: Integer) of object;
385
386 TCellProcessEvent = procedure(Sender: TObject; aCol, aRow: Integer;
387 processType: TCellProcessType;
388 var aValue: string) of object;
389
390 TGetCellHintEvent = procedure (Sender: TObject; ACol, ARow: Integer;
391 var HintText: String) of object;
392
393 TSaveColumnEvent = procedure (Sender, aColumn: TObject; aColIndex: Integer;
394 aCfg: TXMLConfig; const aVersion: integer;
395 const aPath: string) of object;
396
397 { TVirtualGrid }
398
399 TVirtualGrid=class
400 private
401 FColCount: Integer;
402 FRowCount: Integer;
403 FCellArr, FColArr, FRowArr: TPointerPointerArray;
GetCellsnull404 function GetCells(Col, Row: Integer): PCellProps;
GetRowsnull405 function GetRows(Row: Integer): PColRowProps;
GetColsnull406 function GetCols(Col: Integer): PColRowProps;
407 procedure SetCells(Col, Row: Integer; const AValue: PCellProps);
408 procedure SetRows(Row: Integer; const Avalue: PColRowProps);
409 procedure SetColCount(const Avalue: Integer);
410 procedure SetRowCount(const Avalue: Integer);
411 procedure SetCols(Col: Integer; const Avalue: PColRowProps);
412 protected
413 procedure doDestroyItem(Sender: TObject; Col,Row: Integer; var Item: Pointer);
414 procedure doNewItem(Sender: TObject; Col,Row: Integer; var Item: Pointer);
415 procedure DeleteColRow(IsColumn: Boolean; index: Integer);
416 procedure MoveColRow(IsColumn: Boolean; FromIndex, ToIndex: Integer);
417 procedure ExchangeColRow(IsColumn: Boolean; index, WithIndex: Integer);
418 procedure InsertColRow(IsColumn: Boolean; Index: Integer);
419 procedure DisposeCell(var P: PCellProps); virtual;
420 procedure DisposeColRow(var p: PColRowProps); virtual;
IsColumnIndexValidnull421 function IsColumnIndexValid(AIndex: Integer): boolean; inline;
IsRowIndexValidnull422 function IsRowIndexValid(AIndex: Integer): boolean; inline;
423 public
424 constructor Create;
425 destructor Destroy; override;
426 procedure Clear;
GetDefaultCellnull427 function GetDefaultCell: PcellProps;
GetDefaultColRownull428 function GetDefaultColRow: PColRowProps;
429
430 property ColCount: Integer read FColCount write SetColCount;
431 property RowCount: Integer read FRowCount write SetRowCount;
432
433 property Celda[Col,Row: Integer]: PCellProps read GetCells write SetCells;
434 property Cols[Col: Integer]: PColRowProps read GetCols write SetCols;
435 property Rows[Row: Integer]: PColRowProps read GetRows write SetRows;
436 end;
437
438 { TGridColumnTitle }
439
440 TGridColumnTitle = class(TPersistent)
441 private
442 FColumn: TGridColumn;
443 FCaption: PChar;
444 FColor: ^TColor;
445 FAlignment: ^TAlignment;
446 FFont: TFont;
447 FImageIndex: TImageIndex;
448 FImageLayout: TButtonLayout;
449 FIsDefaultTitleFont: boolean;
450 FLayout: ^TTextLayout;
451 FPrefixOption: TPrefixOption;
452 FMultiline: Boolean;
453 FIsDefaultCaption: boolean;
454 procedure FontChanged(Sender: TObject);
GetAlignmentnull455 function GetAlignment: TAlignment;
GetColornull456 function GetColor: TColor;
GetFontnull457 function GetFont: TFont;
GetLayoutnull458 function GetLayout: TTextLayout;
IsAlignmentStorednull459 function IsAlignmentStored: boolean;
IsCaptionStorednull460 function IsCaptionStored: boolean;
IsColorStorednull461 function IsColorStored: boolean;
IsFontStorednull462 function IsFontStored: boolean;
IsLayoutStorednull463 function IsLayoutStored: boolean;
464 procedure SetAlignment(const AValue: TAlignment);
465 procedure SetColor(const AValue: TColor);
466 procedure SetFont(const AValue: TFont);
467 procedure SetImageIndex(const AValue: TImageIndex);
468 procedure SetImageLayout(const AValue: TButtonLayout);
469 procedure SetLayout(const AValue: TTextLayout);
470 procedure SetMultiLine(const AValue: Boolean);
471 procedure SetPrefixOption(const AValue: TPrefixOption);
472 procedure WriteCaption(Writer: TWriter);
473
474 property IsDefaultFont: boolean read FIsDefaultTitleFont;
475 protected
GetDefaultCaptionnull476 function GetDefaultCaption: string; virtual;
GetDefaultAlignmentnull477 function GetDefaultAlignment: TAlignment;
GetDefaultColornull478 function GetDefaultColor: TColor;
GetDefaultLayoutnull479 function GetDefaultLayout: TTextLayout;
GetOwnernull480 function GetOwner: TPersistent; override;
GetCaptionnull481 function GetCaption: TCaption;
482 procedure SetCaption(const AValue: TCaption); virtual;
483 procedure DefineProperties(Filer: TFiler); override;
484 public
485 constructor Create(TheColumn: TGridColumn); virtual;
486 destructor Destroy; override;
487 procedure Assign(Source: TPersistent); override;
488 procedure FillTitleDefaultFont;
489 procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); virtual;
490 procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); virtual;
IsDefaultnull491 function IsDefault: boolean;
492 property Column: TGridColumn read FColumn;
493 published
494 property Alignment: TAlignment read GetAlignment write SetAlignment stored IsAlignmentStored;
495 property Caption: TCaption read GetCaption write SetCaption stored IsCaptionStored;
496 property Color: TColor read GetColor write SetColor stored IsColorStored;
497 property Font: TFont read GetFont write SetFont stored IsFontStored;
498 property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
499 property ImageLayout: TButtonLayout read FImageLayout write SetImageLayout default blGlyphRight;
500 property Layout: TTextLayout read GetLayout write SetLayout stored IsLayoutStored;
501 property MultiLine: Boolean read FMultiLine write SetMultiLine default false;
502 property PrefixOption: TPrefixOption read FPrefixOption write SetPrefixOption default poNone;
503 end;
504
505 { TGridColumn }
506
507 TGridColumn = class(TCollectionItem)
508 private
509 FButtonStyle: TColumnButtonStyle;
510 FDropDownRows: Longint;
511 FTitle: TGridColumnTitle;
512 FWidthChanged: boolean;
513 FAlignment: ^TAlignment;
514 FColor: ^TColor;
515 FLayout: ^TTextLayout;
516 FVisible: ^Boolean;
517 FReadOnly: ^Boolean;
518 FWidth: ^Integer;
519 FFont: TFont;
520 FisDefaultFont: Boolean;
521 FPickList: TStrings;
522 FMinSize, FMaxSize, FSizePriority: ^Integer;
523 FValueChecked,FValueUnchecked: PChar;
524 FTag: PtrInt;
525 procedure FontChanged(Sender: TObject);
GetAlignmentnull526 function GetAlignment: TAlignment;
GetColornull527 function GetColor: TColor;
GetExpandednull528 function GetExpanded: Boolean;
GetFontnull529 function GetFont: TFont;
GetGridnull530 function GetGrid: TCustomGrid;
GetLayoutnull531 function GetLayout: TTextLayout;
GetMaxSizenull532 function GetMaxSize: Integer;
GetMinSizenull533 function GetMinSize: Integer;
GetSizePrioritynull534 function GetSizePriority: Integer;
GetReadOnlynull535 function GetReadOnly: Boolean;
GetStoredWidthnull536 function GetStoredWidth: Integer;
GetVisiblenull537 function GetVisible: Boolean;
GetWidthnull538 function GetWidth: Integer;
IsAlignmentStorednull539 function IsAlignmentStored: boolean;
IsColorStorednull540 function IsColorStored: boolean;
IsFontStorednull541 function IsFontStored: boolean;
IsLayoutStorednull542 function IsLayoutStored: boolean;
IsMinSizeStorednull543 function IsMinSizeStored: boolean;
IsMaxSizeStorednull544 function IsMaxSizeStored: boolean;
IsReadOnlyStorednull545 function IsReadOnlyStored: boolean;
IsSizePriorityStorednull546 function IsSizePriorityStored: boolean;
IsValueCheckedStorednull547 function IsValueCheckedStored: boolean;
IsValueUncheckedStorednull548 function IsValueUncheckedStored: boolean;
IsVisibleStorednull549 function IsVisibleStored: boolean;
IsWidthStorednull550 function IsWidthStored: boolean;
551 procedure SetAlignment(const AValue: TAlignment);
552 procedure SetButtonStyle(const AValue: TColumnButtonStyle);
553 procedure SetColor(const AValue: TColor);
554 procedure SetExpanded(const AValue: Boolean);
555 procedure SetFont(const AValue: TFont);
556 procedure SetLayout(const AValue: TTextLayout);
557 procedure SetMaxSize(const AValue: Integer);
558 procedure SetMinSize(const Avalue: Integer);
559 procedure SetPickList(const AValue: TStrings);
560 procedure SetReadOnly(const AValue: Boolean);
561 procedure SetSizePriority(const AValue: Integer);
562 procedure SetTitle(const AValue: TGridColumnTitle);
563 procedure SetValueChecked(const AValue: string);
564 procedure SetValueUnchecked(const AValue: string);
565 procedure SetVisible(const AValue: Boolean);
566 procedure SetWidth(const AValue: Integer);
567 protected
GetDisplayNamenull568 function GetDisplayName: string; override;
GetDefaultAlignmentnull569 function GetDefaultAlignment: TAlignment; virtual;
GetDefaultColornull570 function GetDefaultColor: TColor; virtual;
GetDefaultLayoutnull571 function GetDefaultLayout: TTextLayout; virtual;
GetDefaultMaxSizenull572 function GetDefaultMaxSize: Integer; virtual;
GetDefaultMinSizenull573 function GetDefaultMinSize: Integer; virtual;
GetDefaultReadOnlynull574 function GetDefaultReadOnly: boolean; virtual;
GetDefaultSizePrioritynull575 function GetDefaultSizePriority: Integer;
GetDefaultVisiblenull576 function GetDefaultVisible: boolean; virtual;
GetDefaultValueCheckednull577 function GetDefaultValueChecked: string; virtual;
GetDefaultValueUncheckednull578 function GetDefaultValueUnchecked: string; virtual;
GetDefaultWidthnull579 function GetDefaultWidth: Integer; virtual;
GetPickListnull580 function GetPickList: TStrings; virtual;
GetValueCheckednull581 function GetValueChecked: string;
GetValueUncheckednull582 function GetValueUnchecked: string;
583 procedure ColumnChanged; virtual;
584 procedure AllColumnsChange;
CreateTitlenull585 function CreateTitle: TGridColumnTitle; virtual;
586 procedure SetIndex(Value: Integer); override;
587
588 property IsDefaultFont: boolean read FIsDefaultFont;
589 public
590 constructor Create(ACollection: TCollection); override;
591 destructor Destroy; override;
592 procedure Assign(Source: TPersistent); override;
593 procedure FillDefaultFont;
594 procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); virtual;
595 procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); virtual;
IsDefaultnull596 function IsDefault: boolean; virtual;
597 property Grid: TCustomGrid read GetGrid;
598 property DefaultWidth: Integer read GetDefaultWidth;
599 property StoredWidth: Integer read GetStoredWidth;
600 property WidthChanged: boolean read FWidthChanged;
601
602 published
603 property Alignment: TAlignment read GetAlignment write SetAlignment stored IsAlignmentStored;
604 property ButtonStyle: TColumnButtonStyle read FButtonStyle write SetButtonStyle default cbsAuto;
605 property Color: TColor read GetColor write SetColor stored IsColorStored;
606 property DropDownRows: Longint read FDropDownRows write FDropDownRows default 7;
607 property Expanded: Boolean read GetExpanded write SetExpanded default True;
608 property Font: TFont read GetFont write SetFont stored IsFontStored;
609 property Layout: TTextLayout read GetLayout write SetLayout stored IsLayoutStored;
610 property MinSize: Integer read GetMinSize write SetMinSize stored IsMinSizeStored;
611 property MaxSize: Integer read GetMaxSize write SetMaxSize stored isMaxSizeStored;
612 property PickList: TStrings read GetPickList write SetPickList;
613 property ReadOnly: Boolean read GetReadOnly write SetReadOnly stored IsReadOnlyStored;
614 property SizePriority: Integer read GetSizePriority write SetSizePriority stored IsSizePriorityStored;
615 property Tag: PtrInt read FTag write FTag default 0;
616 property Title: TGridColumnTitle read FTitle write SetTitle;
617 property Width: Integer read GetWidth write SetWidth stored IsWidthStored;
618 property Visible: Boolean read GetVisible write SetVisible stored IsVisibleStored;
619 property ValueChecked: string read GetValueChecked write SetValueChecked
620 stored IsValueCheckedStored;
621 property ValueUnchecked: string read GetValueUnchecked write SetValueUnchecked
622 stored IsValueUncheckedStored;
623 end;
624
625 TGridPropertyBackup=record
626 ValidData: boolean;
627 FixedRowCount: Integer;
628 FixedColCount: Integer;
629 RowCount: Integer;
630 ColCount: Integer;
631 end;
632
633 { TGridColumns }
634
635 TGridColumns = class(TCollection)
636 private
637 FGrid: TCustomGrid;
GetColumnnull638 function GetColumn(Index: Integer): TGridColumn;
GetEnablednull639 function GetEnabled: Boolean;
640 procedure SetColumn(Index: Integer; Value: TGridColumn);
GetVisibleCountnull641 function GetVisibleCount: Integer;
642 protected
GetOwnernull643 function GetOwner: TPersistent; override;
644 procedure Update(Item: TCollectionItem); override;
645 procedure TitleFontChanged;
646 procedure FontChanged;
647 procedure RemoveColumn(Index: Integer);
648 procedure MoveColumn(FromIndex,ToIndex: Integer); virtual;
649 procedure ExchangeColumn(Index,WithIndex: Integer);
650 procedure InsertColumn(Index: Integer);
651 public
652 constructor Create(AGrid: TCustomGrid; aItemClass: TCollectionItemClass);
Addnull653 function Add: TGridColumn;
654 procedure Clear;
ColumnByTitlenull655 function ColumnByTitle(const aTitle: string): TGridColumn;
RealIndexnull656 function RealIndex(Index: Integer): Integer;
IndexOfnull657 function IndexOf(Column: TGridColumn): Integer;
IsDefaultnull658 function IsDefault: boolean;
HasIndexnull659 function HasIndex(Index: Integer): boolean;
VisibleIndexnull660 function VisibleIndex(Index: Integer): Integer;
661 property Grid: TCustomGrid read FGrid;
662 property Items[Index: Integer]: TGridColumn read GetColumn write SetColumn; default;
663 property VisibleCount: Integer read GetVisibleCount;
664 property Enabled: Boolean read GetEnabled;
665 end;
666
667 type
668 TGridCoord = TPoint;
669 TGridRect = TRect;
670 TGridRectArray = array of TGridRect;
671
672 TSizingRec = record
673 Index: Integer;
674 OffIni,OffEnd: Integer;
675 DeltaOff: Integer;
676 PrevLine: boolean;
677 PrevOffset: Integer;
678 end;
679
680 TGridDataCache=record
681 FixedWidth: Integer; // Sum( Fixed ColsWidths[i] )
682 FixedHeight: Integer; // Sum( Fixed RowsHeights[i] )
683 GridWidth: Integer; // Sum( ColWidths[i] )
684 GridHeight: Integer; // Sum( RowHeights[i] )
685 ClientWidth: Integer; // Width-VertScrollbar.Size
686 ClientHeight: Integer; // Height-HorzScrollbar.Size
687 ClientRect: TRect; // Cache for ClientRect - GetBorderWidth need for Bidi
688 ScrollWidth: Integer; // ClientWidth-FixedWidth
689 ScrollHeight: Integer; // ClientHeight-FixedHeight
690 HScrollBarNetRange: Integer;//ScrollBar Range-Page
691 VisibleGrid: TRect; // Visible non fixed rectangle of cellcoordinates
692 MaxClientXY: Tpoint; // VisibleGrid.BottomRight (pixel) coordinates
693 ValidRows: boolean; // true if there are not fixed columns to show
694 ValidCols: boolean; // true if there are not fixed rows to show
695 ValidGrid: boolean; // true if there are not fixed cells to show
696 AccumWidth: TIntegerList; // Accumulated width per column
697 AccumHeight: TIntegerList; // Accumulated Height per row
698 TLColOff,TLRowOff: Integer; // TopLeft Offset in pixels
699 MaxTopLeft: TPoint; // Max Top left ( cell coorditates)
700 MaxTLOffset: TPoint; // Max Top left offset of the last cell
701 HotCell: TPoint; // currently hot cell
702 HotCellPainted: boolean; // HotCell was already painter?
703 HotGridZone: TGridZone; // GridZone of last MouseMove
704 ClickCell: TPoint; // Cell coords of the latest mouse click
705 ClickMouse: TPoint; // mouse coords of the latest mouse click
706 PushedCell: TPoint; // Cell coords of cell being pushed
707 PushedMouse: TPoint; // mouse Coords of the cell being pushed
708 ClickCellPushed: boolean; // Header Cell is currently pushed?
709 FullVisibleGrid: TRect; // visible cells excluding partially visible cells
710 MouseCell: TPoint; // Cell which contains the mouse
711 OldMaxTopLeft: TPoint; // previous MaxTopleft (before col sizing)
712 end;
713
714 TGridCursorState = (gcsDefault, gcsColWidthChanging, gcsRowHeightChanging, gcsDragging);
715
716 type
717
718 { TCustomGrid }
719
720 TCustomGrid=class(TCustomControl)
721 private
722 FAlternateColor: TColor;
723 FAutoAdvance: TAutoAdvance;
724 FAutoEdit: boolean;
725 FAutoFillColumns: boolean;
726 FBorderColor: TColor;
727 FDefaultDrawing: Boolean;
728 FEditor: TWinControl;
729 FEditorHidingCount: Integer;
730 FEditorMode: Boolean;
731 FEditorOldValue: string;
732 FEditorShowing: Boolean;
733 FEditorKey: Boolean;
734 FEditorOptions: Integer;
735 FExtendedSelect: boolean;
736 FFastEditing: boolean;
737 FAltColorStartNormal: boolean;
738 FFlat: Boolean;
739 FOnAfterSelection: TOnSelectEvent;
740 FOnLoadColumn: TSaveColumnEvent;
741 FOnSaveColumn: TSaveColumnEvent;
742 FRangeSelectMode: TRangeSelectMode;
743 FSelections: TGridRectArray;
744 FOnUserCheckboxBitmap: TUserCheckboxBitmapEvent;
745 FOnUserCheckboxImage: TUserCheckBoxImageEvent;
746 FSortOrder: TSortOrder;
747 FSortColumn: Integer;
748 FSortLCLImages: TLCLGlyphs;
749 FTabAdvance: TAutoAdvance;
750 FTitleImageList: TImageList;
751 FTitleImageListWidth: Integer;
752 FTitleStyle: TTitleStyle;
753 FAscImgInd: TImageIndex;
754 FDescImgInd: TImageIndex;
755 FOnCompareCells: TOnCompareCells;
756 FGridLineStyle: TPenStyle;
757 FGridLineWidth: Integer;
758 FDefColWidth, FDefRowHeight: Integer;
759 FRealizedDefColWidth, FRealizedDefRowHeight: Integer;
760 FCol,FRow, FFixedCols, FFixedRows: Integer;
761 FOnEditButtonClick: TNotifyEvent;
762 FOnButtonClick: TOnSelectEvent;
763 FOnPickListSelect: TNotifyEvent;
764 FOnCheckboxToggled: TToggledCheckboxEvent;
765 FOnPrepareCanvas: TOnPrepareCanvasEvent;
766 FOnSelectEditor: TSelectEditorEvent;
767 FOnValidateEntry: TValidateEntryEvent;
768 FGridLineColor, FFixedGridLineColor: TColor;
769 FFixedColor, FFixedHotColor, FFocusColor, FSelectedColor: TColor;
770 FDisabledFontColor: TColor;
771 FFocusRectVisible: boolean;
772 FCols,FRows: TIntegerList;
773 FsaveOptions: TSaveOptions;
774 FScrollBars: TScrollStyle;
775 FSelectActive: Boolean;
776 FTopLeft: TPoint;
777 FPivot: TPoint;
778 FRange: TRect;
779 FDragDx: Integer;
780 FMoveLast: TPoint;
781 FUpdateCount: Integer;
782 FGCache: TGridDataCache;
783 FOptions: TGridOptions;
784 FOptions2: TGridOptions2;
785 FOnDrawCell: TOnDrawcell;
786 FOnBeforeSelection: TOnSelectEvent;
787 FOnSelection: TOnSelectEvent;
788 FOnTopLeftChanged: TNotifyEvent;
789 FUseXORFeatures: boolean;
790 FValidateOnSetSelection: boolean;
791 FVSbVisible, FHSbVisible: ShortInt; // state: -1 not initialized, 0 hidden, 1 visible
792 FDefaultTextStyle: TTextStyle;
793 FLastWidth: Integer;
794 FTitleFont, FLastFont: TFont;
795 FTitleFontIsDefault: boolean;
796 FColumns: TGridColumns;
797 FButtonEditor: TButtonCellEditor;
798 FStringEditor: TStringCellEditor;
799 FButtonStringEditor: TCompositeCellEditor;
800 FPickListEditor: TPickListCellEditor;
801 FExtendedColSizing: boolean;
802 FExtendedRowSizing: boolean;
803 FUpdatingAutoFillCols: boolean;
804 FGridBorderStyle: TBorderStyle;
805 FGridFlags: TGridFlags;
806 FGridPropBackup: TGridPropertyBackup;
807 FStrictSort: boolean;
808 FIgnoreClick: boolean;
809 FAllowOutboundEvents: boolean;
810 FColumnClickSorts: boolean;
811 FHeaderHotZones: TGridZoneSet;
812 FHeaderPushZones: TGridZoneSet;
813 FCursorChangeLock: Integer;
814 FCursorState: TGridCursorState;
815 FColRowDragIndicatorColor: TColor;
816 FSavedCursor: TCursor;
817 FSpecialCursors: array[gcsColWidthChanging..gcsDragging] of TCursor;
818 FSizing: TSizingRec;
819 FRowAutoInserted: Boolean;
820 FMouseWheelOption: TMouseWheelOption;
821 FSavedHint: String;
822 FCellHintPriority: TCellHintPriority;
823 FOnGetCellHint: TGetCellHintEvent;
824 procedure AdjustCount(IsColumn:Boolean; OldValue, NewValue:Integer);
825 procedure CacheVisibleGrid;
826 procedure CancelSelection;
827 procedure CheckFixedCount(aCol,aRow,aFCol,aFRow: Integer);
828 procedure CheckCount(aNewColCount, aNewRowCount: Integer; FixEditor: boolean=true);
829 procedure CheckIndex(IsColumn: Boolean; Index: Integer);
CheckTopLeftnull830 function CheckTopLeft(aCol,aRow: Integer; CheckCols,CheckRows: boolean): boolean;
GetQuickColRownull831 function GetQuickColRow: TPoint;
832 procedure SetQuickColRow(AValue: TPoint);
IsCellButtonColumnnull833 function IsCellButtonColumn(ACell: TPoint): boolean;
GetSelectedColumnnull834 function GetSelectedColumn: TGridColumn;
835 procedure SetAlternateColor(const AValue: TColor);
836 procedure SetAutoFillColumns(const AValue: boolean);
837 procedure SetBorderColor(const AValue: TColor);
838 procedure SetColumnClickSorts(const AValue: boolean);
839 procedure SetColumns(const AValue: TGridColumns);
840 procedure SetEditorOptions(const AValue: Integer);
841 procedure SetEditorBorderStyle(const AValue: TBorderStyle);
842 procedure SetAltColorStartNormal(const AValue: boolean);
843 procedure SetFlat(const AValue: Boolean);
844 procedure SetFocusRectVisible(const AValue: Boolean);
845 procedure SetTitleImageList(const AValue: TImageList);
846 procedure SetTitleImageListWidth(const aTitleImageListWidth: Integer);
847 procedure SetTitleFont(const AValue: TFont);
848 procedure SetTitleStyle(const AValue: TTitleStyle);
849 procedure SetUseXorFeatures(const AValue: boolean);
doColSizingnull850 function doColSizing(X,Y: Integer): Boolean;
doRowSizingnull851 function doRowSizing(X,Y: Integer): Boolean;
852 procedure doColMoving(X,Y: Integer);
853 procedure doPushCell;
854 procedure doRowMoving(X,Y: Integer);
855 procedure doTopleftChange(DimChg: Boolean);
856 procedure DrawXORVertLine(X: Integer);
857 procedure DrawXORHorzLine(Y: Integer);
EditorGetValuenull858 function EditorGetValue(validate:boolean=false): boolean;
859 procedure EditorPos;
860 procedure EditorShowChar(Ch: TUTF8Char);
861 procedure EditorSetMode(const AValue: Boolean);
862 procedure EditorSetValue;
EditorAlwaysShownnull863 function EditorAlwaysShown: Boolean;
864 procedure FixPosition(IsColumn: Boolean; aIndex: Integer);
865 procedure FixScroll;
GetLeftColnull866 function GetLeftCol: Integer;
GetColCountnull867 function GetColCount: Integer;
GetColWidthsnull868 function GetColWidths(Acol: Integer): Integer;
GetColumnsnull869 function GetColumns: TGridColumns;
GetDefColWidthnull870 function GetDefColWidth: Integer;
GetDefRowHeightnull871 function GetDefRowHeight: Integer;
GetEditorBorderStylenull872 function GetEditorBorderStyle: TBorderStyle;
GetBorderWidthnull873 function GetBorderWidth: Integer;
874 procedure GetTitleImageInfo(aColumnIndex:Integer; out ImgIndex: Integer; out ImgLayout: TButtonLayout);
875 procedure GetSortTitleImageInfo(aColumnIndex:Integer; out ImgList: TCustomImageList;
876 out ImgIndex, ImgListWidth: Integer; out NativeSortGlyphs: Boolean);
GetRowCountnull877 function GetRowCount: Integer;
GetRowHeightsnull878 function GetRowHeights(Arow: Integer): Integer;
GetSelectedRangenull879 function GetSelectedRange(AIndex: Integer): TGridRect;
GetSelectedRangeCountnull880 function GetSelectedRangeCount: Integer;
GetSelectionnull881 function GetSelection: TGridRect;
GetSpecialCursornull882 function GetSpecialCursor(ACursorState: TGridCursorState): TCursor;
GetTopRownull883 function GetTopRow: Longint;
GetVisibleColCountnull884 function GetVisibleColCount: Integer;
GetVisibleGridnull885 function GetVisibleGrid: TRect;
GetVisibleRowCountnull886 function GetVisibleRowCount: Integer;
887 procedure HeadersMouseMove(const X,Y:Integer);
888 procedure InternalAutoFillColumns;
InternalNeedBordernull889 function InternalNeedBorder: boolean;
890 procedure InternalSetColWidths(aCol,aValue: Integer);
891 procedure InternalUpdateColumnWidths;
892 procedure InvalidateMovement(DCol,DRow: Integer; OldRange: TRect);
IsAltColorStorednull893 function IsAltColorStored: boolean;
IsColumnsStorednull894 function IsColumnsStored: boolean;
IsPushCellActivenull895 function IsPushCellActive: boolean;
896 procedure LoadColumns(cfg: TXMLConfig; Version: integer);
LoadResBitmapImagenull897 function LoadResBitmapImage(const ResName: string): TBitmap;
898 procedure LoadSub(ACfg: TXMLConfig);
899 procedure OnTitleFontChanged(Sender: TObject);
900 procedure ReadColumns(Reader: TReader);
901 procedure ReadColWidths(Reader: TReader);
902 procedure ReadRowHeights(Reader: TReader);
903 procedure ResetHotCell;
904 procedure ResetPushedCell(ResetColRow: boolean=True);
905 procedure RestoreCursor;
906 procedure SaveColumns(cfg: TXMLConfig; Version: integer);
ScrollToCellnull907 function ScrollToCell(const aCol,aRow: Integer; const ForceFullyVisible: Boolean = True): Boolean;
ScrollGridnull908 function ScrollGrid(Relative:Boolean; DCol,DRow: Integer): TPoint;
909 procedure SetCol(AValue: Integer);
910 procedure SetColWidths(Acol: Integer; Avalue: Integer);
911 procedure SetColRowDragIndicatorColor(const AValue: TColor);
912 procedure SetDefColWidth(AValue: Integer);
913 procedure SetDefRowHeight(AValue: Integer);
914 procedure SetDefaultDrawing(const AValue: Boolean);
915 procedure SetEditor(AValue: TWinControl);
916 procedure SetFocusColor(const AValue: TColor);
917 procedure SetGridLineColor(const AValue: TColor);
918 procedure SetFixedGridLineColor(const AValue: TColor);
919 procedure SetGridLineStyle(const AValue: TPenStyle);
920 procedure SetGridLineWidth(const AValue: Integer);
921 procedure SetLeftCol(const AValue: Integer);
922 procedure SetOptions(const AValue: TGridOptions);
923 procedure SetOptions2(const AValue: TGridOptions2);
924 procedure SetRangeSelectMode(const AValue: TRangeSelectMode);
925 procedure SetRow(AValue: Integer);
926 procedure SetRowCount(AValue: Integer);
927 procedure SetRowHeights(Arow: Integer; Avalue: Integer);
928 procedure SetScrollBars(const AValue: TScrollStyle);
929 procedure SetSelectActive(const AValue: Boolean);
930 procedure SetSelection(const AValue: TGridRect);
931 procedure SetSpecialCursor(ACursorState: TGridCursorState; const AValue: TCursor);
932 procedure SetTopRow(const AValue: Integer);
StartColSizingnull933 function StartColSizing(const X, Y: Integer): boolean;
934 procedure ChangeCursor(ACursor: TCursor; ASaveCurrentCursor: Boolean = true);
TitleFontIsStorednull935 function TitleFontIsStored: Boolean;
TrySmoothScrollBynull936 function TrySmoothScrollBy(aColDelta, aRowDelta: Integer): Boolean;
937 procedure TryScrollTo(aCol,aRow: Integer; ClearColOff, ClearRowOff: Boolean);
938 procedure UpdateCachedSizes;
939 procedure UpdateSBVisibility;
940 procedure UpdateSizes;
941 procedure WriteColumns(Writer: TWriter);
942 procedure WriteColWidths(Writer: TWriter);
943 procedure WriteRowHeights(Writer: TWriter);
944 procedure WMEraseBkgnd(var message: TLMEraseBkgnd); message LM_ERASEBKGND;
945 procedure WMGetDlgCode(var Msg: TLMNoParams); message LM_GETDLGCODE;
946 protected
947 fGridState: TGridState;
RTLSignnull948 function RTLSign: Integer;
949 class procedure WSRegisterClass; override;
950 procedure AddSelectedRange;
951 procedure AdjustClientRect(var ARect: TRect); override;
952 procedure AdjustEditorBounds(NewCol,NewRow:Integer); virtual;
953 procedure AfterMoveSelection(const prevCol,prevRow: Integer); virtual;
954 procedure AssignTo(Dest: TPersistent); override;
955 procedure AutoAdjustColumn(aCol: Integer); virtual;
956 procedure BeforeMoveSelection(const DCol,DRow: Integer); virtual;
957 procedure BeginAutoDrag; override;
BoxRectnull958 function BoxRect(ALeft,ATop,ARight,ABottom: Longint): TRect;
959 procedure CacheMouseDown(const X,Y:Integer);
960 procedure CalcAutoSizeColumn(const Index: Integer; var AMin,AMax,APriority: Integer); virtual;
961 procedure CalcCellExtent(acol, aRow: Integer; var aRect: TRect); overload; virtual; deprecated 'old function';
962 procedure CalcFocusRect(var ARect: TRect; adjust: boolean = true);
963 procedure CalcMaxTopLeft;
964 procedure CalcScrollbarsRange;
965 procedure CalculatePreferredSize(var PreferredWidth,
966 PreferredHeight: integer; WithThemeSpace: Boolean); override;
CanEditShownull967 function CanEditShow: Boolean; virtual;
CanGridAcceptKeynull968 function CanGridAcceptKey(Key: Word; Shift: TShiftState): Boolean; virtual;
969 procedure CellClick(const aCol,aRow: Integer; const Button:TMouseButton); virtual;
970 procedure CellExtent(const aCol,aRow: Integer; var R: TRect; out exCol:Integer);
971 procedure CheckLimits(var aCol,aRow: Integer);
972 procedure CheckLimitsWithError(const aCol, aRow: Integer);
973 procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED;
974 procedure CMMouseEnter(var Message: TLMessage); message CM_MOUSEENTER;
975 procedure CMMouseLeave(var Message :TLMessage); message CM_MouseLeave;
976 procedure ColRowDeleted(IsColumn: Boolean; index: Integer); virtual;
977 procedure ColRowExchanged(IsColumn: Boolean; index,WithIndex: Integer); virtual;
978 procedure ColRowInserted(IsColumn: boolean; index: integer); virtual;
979 procedure ColRowMoved(IsColumn: Boolean; FromIndex,ToIndex: Integer); virtual;
ColRowToOffsetnull980 function ColRowToOffset(IsCol, Relative: Boolean; Index:Integer;
981 out StartPos, EndPos: Integer): Boolean;
ColumnIndexFromGridColumnnull982 function ColumnIndexFromGridColumn(Column: Integer): Integer;
ColumnFromGridColumnnull983 function ColumnFromGridColumn(Column: Integer): TGridColumn;
984 procedure ColumnsChanged(aColumn: TGridColumn);
985 procedure ColWidthsChanged; virtual;
CreateColumnsnull986 function CreateColumns: TGridColumns; virtual;
987 procedure CheckNewCachedSizes(var AGCache:TGridDataCache); virtual;
988 procedure CreateWnd; override;
989 procedure CreateParams(var Params: TCreateParams); override;
990 procedure Click; override;
991 procedure DblClick; override;
DefaultColWidthIsStorednull992 function DefaultColWidthIsStored: Boolean;
DefaultRowHeightIsStorednull993 function DefaultRowHeightIsStored: Boolean;
994 procedure DefineProperties(Filer: TFiler); override;
995 procedure DestroyHandle; override;
DialogCharnull996 function DialogChar(var Message: TLMKey): boolean; override;
DoCompareCellsnull997 function DoCompareCells(Acol,ARow,Bcol,BRow: Integer): Integer; virtual;
998 procedure DoCopyToClipboard; virtual;
999 procedure DoCutToClipboard; virtual;
1000 procedure DoEditButtonClick(const ACol,ARow: Integer); virtual;
1001 procedure DoEditorHide; virtual;
1002 procedure DoEditorShow; virtual;
1003 procedure DoExit; override;
1004 procedure DoEnter; override;
1005 procedure DoLoadColumn(sender: TCustomGrid; aColumn: TGridColumn; aColIndex: Integer;
1006 aCfg: TXMLConfig; aVersion: Integer; aPath: string); virtual;
1007 procedure DoSaveColumn(sender: TCustomGrid; aColumn: TGridColumn; aColIndex: Integer;
1008 aCfg: TXMLConfig; aVersion: Integer; aPath: string); virtual;
DoMouseWheelnull1009 function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
DoMouseWheelDownnull1010 function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
DoMouseWheelUpnull1011 function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
DoMouseWheelLeftnull1012 function DoMouseWheelLeft(Shift: TShiftState; MousePos: TPoint): Boolean; override;
DoMouseWheelRightnull1013 function DoMouseWheelRight(Shift: TShiftState; MousePos: TPoint): Boolean; override;
1014 procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
1015 const AXProportion, AYProportion: Double); override;
1016 procedure DoOnChangeBounds; override;
1017 procedure DoOPDeleteColRow(IsColumn: Boolean; index: Integer);
1018 procedure DoOPExchangeColRow(IsColumn: Boolean; index, WithIndex: Integer);
1019 procedure DoOPInsertColRow(IsColumn: boolean; index: integer);
1020 procedure DoOPMoveColRow(IsColumn: Boolean; FromIndex, ToIndex: Integer);
1021 procedure DoPasteFromClipboard; virtual;
1022 procedure DoPrepareCanvas(aCol,aRow:Integer; aState: TGridDrawState); virtual;
1023 procedure DoOnResize; override;
1024 procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
DoUTF8KeyPressnull1025 function DoUTF8KeyPress(var UTF8Key: TUTF8Char): boolean; override;
1026 procedure DrawBorder;
1027 procedure DrawAllRows; virtual;
1028 procedure DrawFillRect(aCanvas:TCanvas; R:TRect);// Use FillRect after calc the new rect depened on Right To Left
1029 procedure DrawCell(aCol,aRow:Integer; aRect:TRect; aState:TGridDrawState); virtual;
1030 procedure DrawCellGrid(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState); virtual;
1031 procedure DrawTextInCell(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState); virtual;
1032 procedure DrawThemedCell(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState);
1033 procedure DrawCellText(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState; aText: String); virtual;
1034 procedure DrawGridCheckboxBitmaps(const aCol,aRow: Integer; const aRect: TRect;
1035 const aState: TCheckboxState); virtual;
1036 procedure DrawButtonCell(const aCol,aRow: Integer; aRect: TRect; const aState:TGridDrawState);
1037 procedure DrawColRowMoving;
1038 procedure DrawColumnText(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState); virtual;
1039 procedure DrawColumnTitleImage(var ARect: TRect; AColumnIndex: Integer);
1040 procedure DrawEdges;
1041 procedure DrawFocusRect(aCol,aRow:Integer; ARect:TRect); virtual;
1042 procedure DrawRow(aRow: Integer); virtual;
1043 procedure EditButtonClicked(Sender: TObject);
1044 procedure EditordoGetValue; virtual;
1045 procedure EditordoResetValue; virtual;
1046 procedure EditordoSetValue; virtual;
EditorCanAcceptKeynull1047 function EditorCanAcceptKey(const ch: TUTF8Char): boolean; virtual;
EditorIsReadOnlynull1048 function EditorIsReadOnly: boolean; virtual;
1049 procedure EditorHide; virtual;
EditorLockednull1050 function EditorLocked: boolean;
EditingAllowednull1051 Function EditingAllowed(ACol : Integer = -1) : Boolean; virtual; // Returns true if grid and current column allow editing
1052 procedure EditorSelectAll;
1053 procedure EditorShow(const SelAll: boolean); virtual;
1054 procedure EditorShowInCell(const aCol,aRow:Integer); virtual;
1055 procedure EditorWidthChanged(aCol,aWidth: Integer); virtual;
FirstGridColumnnull1056 function FirstGridColumn: integer; virtual;
FixedGridnull1057 function FixedGrid: boolean;
1058 procedure FontChanged(Sender: TObject); override;
1059 procedure GetAutoFillColumnInfo(const Index: Integer; var aMin,aMax,aPriority: Integer); virtual;
GetCellHintTextnull1060 function GetCellHintText(ACol, ARow: Integer): string; virtual;
GetCellsnull1061 function GetCells(ACol, ARow: Integer): string; virtual;
GetColumnAlignmentnull1062 function GetColumnAlignment(Column: Integer; ForTitle: Boolean): TAlignment;
GetColumnColornull1063 function GetColumnColor(Column: Integer; ForTitle: Boolean): TColor;
GetColumnFontnull1064 function GetColumnFont(Column: Integer; ForTitle: Boolean): TFont;
GetColumnLayoutnull1065 function GetColumnLayout(Column: Integer; ForTitle: boolean): TTextLayout;
GetColumnReadonlynull1066 function GetColumnReadonly(Column: Integer): boolean;
GetColumnTitlenull1067 function GetColumnTitle(Column: Integer): string;
GetColumnWidthnull1068 function GetColumnWidth(Column: Integer): Integer;
GetDeltaMoveNextnull1069 function GetDeltaMoveNext(const Inverse: boolean; var ACol,ARow: Integer; const AAutoAdvance: TAutoAdvance): boolean; virtual;
GetDefaultColumnAlignmentnull1070 function GetDefaultColumnAlignment(Column: Integer): TAlignment; virtual;
GetDefaultColumnWidthnull1071 function GetDefaultColumnWidth(Column: Integer): Integer; virtual;
GetDefaultColumnLayoutnull1072 function GetDefaultColumnLayout(Column: Integer): TTextLayout; virtual;
GetDefaultColumnReadOnlynull1073 function GetDefaultColumnReadOnly(Column: Integer): boolean; virtual;
GetDefaultColumnTitlenull1074 function GetDefaultColumnTitle(Column: Integer): string; virtual;
GetDefaultEditornull1075 function GetDefaultEditor(Column: Integer): TWinControl; virtual;
GetDefaultRowHeightnull1076 function GetDefaultRowHeight: integer; virtual;
GetGridDrawStatenull1077 function GetGridDrawState(ACol, ARow: Integer): TGridDrawState;
1078 procedure GetImageForCheckBox(const aCol,aRow: Integer;
1079 CheckBoxView: TCheckBoxState; var ImageList: TCustomImageList;
1080 var ImageIndex: TImageIndex; var Bitmap: TBitmap); virtual;
GetScrollBarPositionnull1081 function GetScrollBarPosition(Which: integer): Integer;
GetSmoothScrollnull1082 function GetSmoothScroll(Which: Integer): Boolean; virtual;
1083 procedure GetSBVisibility(out HsbVisible,VsbVisible:boolean);virtual;
1084 procedure GetSBRanges(const HsbVisible,VsbVisible: boolean;
1085 out HsbRange,VsbRange,HsbPage,VsbPage,HsbPos,VsbPos:Integer); virtual;
1086 procedure GetSelectedState(AState: TGridDrawState; out IsSelected:boolean); virtual;
GetEditMasknull1087 function GetEditMask(ACol, ARow: Longint): string; virtual;
GetEditTextnull1088 function GetEditText(ACol, ARow: Longint): string; virtual;
GetFixedcolornull1089 function GetFixedcolor: TColor; virtual;
GetFirstVisibleColumnnull1090 function GetFirstVisibleColumn: Integer;
GetFirstVisibleRownull1091 function GetFirstVisibleRow: Integer;
GetLastVisibleColumnnull1092 function GetLastVisibleColumn: Integer;
GetLastVisibleRownull1093 function GetLastVisibleRow: Integer;
GetSelectedColornull1094 function GetSelectedColor: TColor; virtual;
GetTitleShowPrefixnull1095 function GetTitleShowPrefix(Column: Integer): boolean;
GetPxTopLeftnull1096 function GetPxTopLeft: TPoint;
GetTruncCellHintTextnull1097 function GetTruncCellHintText(ACol, ARow: Integer): string; virtual;
GridColumnFromColumnIndexnull1098 function GridColumnFromColumnIndex(ColumnIndex: Integer): Integer;
1099 procedure GridMouseWheel(Shift: TShiftState; Delta: Integer); virtual;
1100 procedure HeaderClick(IsColumn: Boolean; index: Integer); virtual;
1101 procedure HeaderSized(IsColumn: Boolean; index: Integer); virtual;
1102 procedure HeaderSizing(const IsColumn:boolean; const AIndex,ASize:Integer); virtual;
1103 procedure HideCellHintWindow;
1104 procedure InternalSetColCount(ACount: Integer);
1105 procedure InvalidateCell(aCol, aRow: Integer; Redraw: Boolean); overload;
1106 procedure InvalidateFromCol(ACol: Integer);
1107 procedure InvalidateGrid;
1108 procedure InvalidateFocused;
IsColumnIndexValidnull1109 function IsColumnIndexValid(AIndex: Integer): boolean;
IsRowIndexValidnull1110 function IsRowIndexValid(AIndex: Integer): boolean;
IsColumnIndexVariablenull1111 function IsColumnIndexVariable(AIndex: Integer): boolean;
IsRowIndexVariablenull1112 function IsRowIndexVariable(AIndex: Integer): boolean;
GetIsCellTitlenull1113 function GetIsCellTitle(aCol,aRow: Integer): boolean; virtual;
GetIsCellSelectednull1114 function GetIsCellSelected(aCol, aRow: Integer): boolean; virtual;
IsEmptyRownull1115 function IsEmptyRow(ARow: Integer): Boolean;
IsMouseOverCellButtonnull1116 function IsMouseOverCellButton(X,Y: Integer): boolean;
1117 procedure KeyDown(var Key : Word; Shift : TShiftState); override;
1118 procedure KeyUp(var Key : Word; Shift : TShiftState); override;
1119 procedure KeyPress(var Key: char); override;
1120 procedure LoadContent(cfg: TXMLConfig; Version: Integer); virtual;
1121 procedure LoadGridOptions(cfg: TXMLConfig; Version: Integer); virtual;
1122 procedure Loaded; override;
1123 procedure LockEditor;
MouseButtonAllowednull1124 function MouseButtonAllowed(Button: TMouseButton): boolean; virtual;
1125 procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
1126 procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
1127 procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
MoveExtendnull1128 function MoveExtend(Relative: Boolean; DCol, DRow: Integer; ForceFullyVisible: Boolean = True): Boolean;
MoveNextAutonull1129 function MoveNextAuto(const Inverse: boolean): boolean;
MoveNextSelectablenull1130 function MoveNextSelectable(Relative:Boolean; DCol, DRow: Integer): Boolean; virtual;
1131 procedure MoveSelection; virtual;
OffsetToColRownull1132 function OffsetToColRow(IsCol, Physical: Boolean; Offset: Integer;
1133 out Index, Rest: Integer): Boolean;
1134 procedure Paint; override;
1135 procedure PickListItemSelected(Sender: TObject);
1136 procedure PrepareCanvas(aCol,aRow: Integer; aState:TGridDrawState); virtual;
1137 procedure PrepareCellHints(ACol, ARow: Integer); virtual;
1138 procedure ResetDefaultColWidths; virtual;
1139 procedure ResetEditor;
1140 procedure ResetLastMove;
ResetOffsetnull1141 function ResetOffset(chkCol, ChkRow: Boolean): Boolean;
1142 procedure ResetSizes; virtual;
1143 procedure ResizeColumn(aCol, aWidth: Integer);
1144 procedure ResizeRow(aRow, aHeight: Integer);
1145 procedure RowHeightsChanged; virtual;
1146 procedure SaveContent(cfg: TXMLConfig); virtual;
1147 procedure SaveGridOptions(cfg: TXMLConfig); virtual;
1148 procedure ScrollBarRange(Which:Integer; aRange,aPage,aPos: Integer);
1149 procedure ScrollBarPosition(Which, Value: integer);
ScrollBarIsVisiblenull1150 function ScrollBarIsVisible(Which:Integer): Boolean;
1151 procedure ScrollBarPage(Which: Integer; aPage: Integer);
1152 procedure ScrollBarShow(Which: Integer; aValue: boolean);
ScrollBarAutomaticnull1153 function ScrollBarAutomatic(Which: TScrollStyle): boolean; virtual;
1154 procedure ScrollBy(DeltaX, DeltaY: Integer); override;
1155 procedure SelectEditor; virtual;
SelectCellnull1156 function SelectCell(ACol, ARow: Integer): Boolean; virtual;
1157 procedure SetCanvasFont(aFont: TFont);
1158 procedure SetColCount(AValue: Integer); virtual;
1159 procedure SetColor(Value: TColor); override;
1160 procedure SetColRow(const ACol,ARow: Integer; withEvents: boolean = false);
1161 procedure SetCursor(AValue: TCursor); override;
1162 procedure SetEditText(ACol, ARow: Longint; const Value: string); virtual;
1163 procedure SetBorderStyle(NewStyle: TBorderStyle); override;
1164 procedure SetFixedcolor(const AValue: TColor); virtual;
1165 procedure SetFixedCols(const AValue: Integer); virtual;
1166 procedure SetFixedRows(const AValue: Integer); virtual;
1167 procedure SetRawColWidths(ACol: Integer; AValue: Integer);
1168 procedure SetSelectedColor(const AValue: TColor); virtual;
1169 procedure ShowCellHintWindow(APoint: TPoint);
1170 procedure SizeChanged(OldColCount, OldRowCount: Integer); virtual;
1171 procedure Sort(ColSorting: Boolean; index,IndxFrom,IndxTo:Integer); virtual;
1172 procedure StartPushCell;
1173 procedure TopLeftChanged; virtual;
TryMoveSelectionnull1174 function TryMoveSelection(Relative: Boolean; var DCol, DRow: Integer): Boolean;
1175 procedure UnLockEditor;
1176 procedure UnprepareCellHints; virtual;
1177 procedure UpdateHorzScrollBar(const aVisible: boolean; const aRange,aPage,aPos: Integer); virtual;
1178 procedure UpdateSelectionRange;
1179 procedure UpdateVertScrollbar(const aVisible: boolean; const aRange,aPage,aPos: Integer); virtual;
1180 procedure UpdateBorderStyle;
ValidateEntrynull1181 function ValidateEntry(const ACol,ARow:Integer; const OldValue:string; var NewValue:string): boolean; virtual;
1182 procedure VisualChange; virtual;
1183 procedure WMSize(var Message: TLMSize); message LM_SIZE;
1184 procedure WMHScroll(var message : TLMHScroll); message LM_HSCROLL;
1185 procedure WMVScroll(var message : TLMVScroll); message LM_VSCROLL;
1186 procedure WMKillFocus(var message: TLMKillFocus); message LM_KILLFOCUS;
1187 procedure WMSetFocus(var message: TLMSetFocus); message LM_SETFOCUS;
1188 procedure WndProc(var TheMessage : TLMessage); override;
1189
1190 property AllowOutboundEvents: boolean read FAllowOutboundEvents write FAllowOutboundEvents default true;
1191 property AlternateColor: TColor read FAlternateColor write SetAlternateColor stored IsAltColorStored;
1192 property AutoAdvance: TAutoAdvance read FAutoAdvance write FAutoAdvance default aaRight;
1193 property AutoEdit: boolean read FAutoEdit write FAutoEdit default true;
1194 property AutoFillColumns: boolean read FAutoFillColumns write SetAutoFillColumns default false;
1195 property BorderStyle:TBorderStyle read FGridBorderStyle write SetBorderStyle default bsSingle;
1196 property BorderColor: TColor read FBorderColor write SetBorderColor default cl3DDKShadow;
1197 property CellHintPriority: TCellHintPriority read FCellHintPriority write FCellHintPriority default chpAllNoDefault;
1198 property Col: Integer read FCol write SetCol;
1199 property ColCount: Integer read GetColCount write SetColCount default 5;
1200 property ColRow: TPoint read GetQuickColRow write SetQuickColRow;
1201 property ColRowDraggingCursor: TCursor index gcsDragging read GetSpecialCursor write SetSpecialCursor default crMultiDrag;
1202 property ColRowDragIndicatorColor: TColor read FColRowDragIndicatorColor write SetColRowDragIndicatorColor default clRed;
1203 property ColSizingCursor: TCursor index gcsColWidthChanging read GetSpecialCursor write SetSpecialCursor default crHSplit;
1204 property ColumnClickSorts: boolean read FColumnClickSorts write SetColumnClickSorts default false;
1205 property Columns: TGridColumns read GetColumns write SetColumns stored IsColumnsStored;
1206 property ColWidths[aCol: Integer]: Integer read GetColWidths write SetColWidths;
1207 property DefaultColWidth: Integer read GetDefColWidth write SetDefColWidth stored DefaultColWidthIsStored;
1208 property DefaultRowHeight: Integer read GetDefRowHeight write SetDefRowHeight stored DefaultRowHeightIsStored;
1209 property DefaultDrawing: Boolean read FDefaultDrawing write SetDefaultDrawing default True;
1210 property DefaultTextStyle: TTextStyle read FDefaultTextStyle write FDefaultTextStyle;
1211 property DisabledFontColor: TColor read FDisabledFontColor write FDisabledFontColor default clGrayText;
1212 property DragDx: Integer read FDragDx write FDragDx;
1213 property Editor: TWinControl read FEditor write SetEditor;
1214 property EditorBorderStyle: TBorderStyle read GetEditorBorderStyle write SetEditorBorderStyle;
1215 property EditorMode: Boolean read FEditorMode write EditorSetMode;
1216 property EditorKey: boolean read FEditorKey write FEditorKey;
1217 property EditorOptions: Integer read FEditorOptions write SetEditorOptions;
1218 property EditorShowing: boolean read FEditorShowing write FEditorShowing;
1219 property ExtendedColSizing: boolean read FExtendedColSizing write FExtendedColSizing;
1220 property ExtendedRowSizing: boolean read FExtendedRowSizing write FExtendedRowSizing;
1221 property ExtendedSelect: boolean read FExtendedSelect write FExtendedSelect default true;
1222 property FastEditing: boolean read FFastEditing write FFastEditing;
1223 property AltColorStartNormal: boolean read FAltColorStartNormal write SetAltColorStartNormal;
1224 property FixedCols: Integer read FFixedCols write SetFixedCols default 1;
1225 property FixedRows: Integer read FFixedRows write SetFixedRows default 1;
1226 property FixedColor: TColor read GetFixedColor write SetFixedcolor default clBtnFace;
1227 property FixedGridLineColor: TColor read FFixedGridLineColor write SetFixedGridLineColor default cl3DDKShadow;
1228 property FixedHotColor: TColor read FFixedHotColor write FFixedHotColor default cl3DLight;
1229 property Flat: Boolean read FFlat write SetFlat default false;
1230 property FocusColor: TColor read FFocusColor write SetFocusColor;
1231 property FocusRectVisible: Boolean read FFocusRectVisible write SetFocusRectVisible;
1232 property GCache: TGridDataCache read FGCAChe;
1233 property GridFlags: TGridFlags read FGridFlags write FGridFlags;
1234 property GridHeight: Integer read FGCache.GridHeight;
1235 property GridLineColor: TColor read FGridLineColor write SetGridLineColor default clSilver;
1236 property GridLineStyle: TPenStyle read FGridLineStyle write SetGridLineStyle default psSolid;
1237 property GridLineWidth: Integer read FGridLineWidth write SetGridLineWidth default 1;
1238 property GridWidth: Integer read FGCache.GridWidth;
1239 property HeaderHotZones: TGridZoneSet read FHeaderHotZones write FHeaderHotZones default [gzFixedCols];
1240 property HeaderPushZones: TGridZoneSet read FHeaderPushZones write FHeaderPushZones default [gzFixedCols];
1241 property ImageIndexSortAsc: TImageIndex read FAscImgInd write FAscImgInd default -1;
1242 property ImageIndexSortDesc: TImageIndex read FDescImgInd write FDescImgInd default -1;
1243 property TabAdvance: TAutoAdvance read FTabAdvance write FTabAdvance default aaRightDown;
1244 property TitleImageList: TImageList read FTitleImageList write SetTitleImageList;
1245 property TitleImageListWidth: Integer read FTitleImageListWidth write SetTitleImageListWidth default 0;
1246 property InplaceEditor: TWinControl read FEditor;
1247 property IsCellSelected[aCol,aRow: Integer]: boolean read GetIsCellSelected;
1248 property LeftCol:Integer read GetLeftCol write SetLeftCol;
1249 property MouseWheelOption: TMouseWheelOption read FMouseWheelOption write FMouseWheelOption default mwCursor;
1250 property Options: TGridOptions read FOptions write SetOptions default DefaultGridOptions;
1251 property Options2: TGridOptions2 read FOptions2 write SetOptions2 default DefaultGridOptions2;
1252 property RangeSelectMode: TRangeSelectMode read FRangeSelectMode write SetRangeSelectMode default rsmSingle;
1253 property Row: Integer read FRow write SetRow;
1254 property RowCount: Integer read GetRowCount write SetRowCount default 5;
1255 property RowSizingCursor: TCursor index gcsRowHeightChanging read GetSpecialCursor write SetSpecialCursor default crVSplit;
1256 property RowHeights[aRow: Integer]: Integer read GetRowHeights write SetRowHeights;
1257 property SaveOptions: TSaveOptions read FsaveOptions write FSaveOptions;
1258 property SelectActive: Boolean read FSelectActive write SetSelectActive;
1259 property SelectedColor: TColor read GetSelectedColor write SetSelectedColor;
1260 property SelectedColumn: TGridColumn read GetSelectedColumn;
1261 property Selection: TGridRect read GetSelection write SetSelection;
1262 property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssAutoBoth;
1263 property StrictSort: boolean read FStrictSort write FStrictSort;
1264 property TitleFont: TFont read FTitleFont write SetTitleFont stored TitleFontIsStored;
1265 property TitleStyle: TTitleStyle read FTitleStyle write SetTitleStyle default tsLazarus;
1266 property TopRow: Integer read GetTopRow write SetTopRow;
1267 property UseXORFeatures: boolean read FUseXORFeatures write SetUseXorFeatures default false;
1268 property ValidateOnSetSelection: boolean read FValidateOnSetSelection write FValidateOnSetSelection;
1269 property VisibleColCount: Integer read GetVisibleColCount stored false;
1270 property VisibleRowCount: Integer read GetVisibleRowCount stored false;
1271
1272 property OnAfterSelection: TOnSelectEvent read FOnAfterSelection write FOnAfterSelection;
1273 property OnBeforeSelection: TOnSelectEvent read FOnBeforeSelection write FOnBeforeSelection;
1274 property OnCheckboxToggled: TToggledCheckboxEvent read FOnCheckboxToggled write FOnCheckboxToggled;
1275 property OnCompareCells: TOnCompareCells read FOnCompareCells write FOnCompareCells;
1276 property OnPrepareCanvas: TOnPrepareCanvasEvent read FOnPrepareCanvas write FOnPrepareCanvas;
1277 property OnDrawCell: TOnDrawCell read FOnDrawCell write FOnDrawCell;
1278 // Deprecated in favor of OnButtonClick.
1279 property OnEditButtonClick: TNotifyEvent read FOnEditButtonClick write FOnEditButtonClick; deprecated;
1280 property OnButtonClick: TOnSelectEvent read FOnButtonClick write FOnButtonClick;
1281 property OnPickListSelect: TNotifyEvent read FOnPickListSelect write FOnPickListSelect;
1282 property OnSelection: TOnSelectEvent read fOnSelection write fOnSelection;
1283 property OnSelectEditor: TSelectEditorEvent read FOnSelectEditor write FOnSelectEditor;
1284 property OnTopLeftChanged: TNotifyEvent read FOnTopLeftChanged write FOnTopLeftChanged;
1285 property OnUserCheckboxBitmap: TUserCheckboxBitmapEvent read FOnUserCheckboxBitmap write FOnUserCheckboxBitmap;
1286 property OnUserCheckboxImage: TUserCheckBoxImageEvent read FOnUserCheckboxImage write FOnUserCheckboxImage;
1287 property OnValidateEntry: TValidateEntryEvent read FOnValidateEntry write FOnValidateEntry;
1288 // Bidi functions
FlipRectnull1289 function FlipRect(ARect: TRect): TRect;
FlipPointnull1290 function FlipPoint(P: TPoint): TPoint;
FlipXnull1291 function FlipX(X: Integer): Integer;
1292 // Hint-related
1293 property OnGetCellHint : TGetCellHintEvent read FOnGetCellHint write FOnGetCellHint;
1294 property OnSaveColumn: TSaveColumnEvent read FOnSaveColumn write FOnSaveColumn;
1295 property OnLoadColumn: TSaveColumnEvent read FOnLoadColumn write FOnLoadColumn;
1296 public
1297 constructor Create(AOwner: TComponent); override;
1298 destructor Destroy; override;
1299 procedure Invalidate; override;
1300 procedure EditingDone; override;
1301
1302 { Exposed procs }
1303 procedure AdjustInnerCellRect(var ARect: TRect);
1304 procedure AutoAdjustColumns; virtual;
1305 procedure BeginUpdate;
CellRectnull1306 function CellRect(ACol, ARow: Integer): TRect;
CellToGridZonenull1307 function CellToGridZone(aCol,aRow: Integer): TGridZone;
1308 procedure CheckPosition;
ClearColsnull1309 function ClearCols: Boolean;
ClearRowsnull1310 function ClearRows: Boolean;
1311 procedure Clear;
1312 procedure ClearSelections;
1313
EditorByStylenull1314 function EditorByStyle(Style: TColumnButtonStyle): TWinControl; virtual;
1315 procedure EditorKeyDown(Sender: TObject; var Key:Word; Shift:TShiftState);
1316 procedure EditorKeyPress(Sender: TObject; var Key: Char);
1317 procedure EditorUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
1318 procedure EditorKeyUp(Sender: TObject; var key:Word; shift:TShiftState);
1319 procedure EditorTextChanged(const aCol,aRow: Integer; const aText:string); virtual;
1320
1321 procedure EndUpdate(aRefresh: boolean = true);
1322 procedure EraseBackground(DC: HDC); override;
1323 procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); override;
Focusednull1324 function Focused: Boolean; override;
HasMultiSelectionnull1325 function HasMultiSelection: Boolean;
1326 procedure HideSortArrow;
1327 procedure InvalidateCell(aCol, aRow: Integer); overload;
1328 procedure InvalidateCol(ACol: Integer);
1329 procedure InvalidateRange(const aRange: TRect);
1330 procedure InvalidateRow(ARow: Integer);
IsCellVisiblenull1331 function IsCellVisible(aCol, aRow: Integer): Boolean;
IsFixedCellVisiblenull1332 function IsFixedCellVisible(aCol, aRow: Integer): boolean;
1333 procedure LoadFromFile(FileName: string); virtual;
1334 procedure LoadFromStream(AStream: TStream); virtual;
MouseCoordnull1335 function MouseCoord(X,Y: Integer): TGridCoord;
MouseToCellnull1336 function MouseToCell(const Mouse: TPoint): TPoint; overload;
1337 procedure MouseToCell(X,Y: Integer; out ACol,ARow: Longint); overload;
MouseToLogcellnull1338 function MouseToLogcell(Mouse: TPoint): TPoint;
MouseToGridZonenull1339 function MouseToGridZone(X,Y: Integer): TGridZone;
1340 procedure SaveToFile(FileName: string); virtual;
1341 procedure SaveToStream(AStream: TStream); virtual;
1342 procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); override;
1343 procedure SetFocus; override;
1344
1345 property CursorState: TGridCursorState read FCursorState;
1346 property SelectedRange[AIndex: Integer]: TGridRect read GetSelectedRange;
1347 property SelectedRangeCount: Integer read GetSelectedRangeCount;
1348 property SortOrder: TSortOrder read FSortOrder write FSortOrder;
1349 property SortColumn: Integer read FSortColumn;
1350 property TabStop default true;
1351 {$ifdef WINDOWS}
1352 protected
1353 procedure IMEStartComposition(var Msg:TMessage); message WM_IME_STARTCOMPOSITION;
1354 procedure IMEComposition(var Msg:TMessage); message WM_IME_COMPOSITION;
1355 procedure IMEEndComposition(var Msg:TMessage); message WM_IME_ENDCOMPOSITION;
1356 {$endif}
1357 end;
1358
1359 TGetEditEvent = procedure (Sender: TObject; ACol, ARow: Integer; var Value: string) of object;
1360 TSetEditEvent = procedure (Sender: TObject; ACol, ARow: Integer; const Value: string) of object;
1361 TGetCheckboxStateEvent = procedure (Sender: TObject; ACol, ARow: Integer; var Value: TCheckboxState) of object;
1362 TSetCheckboxStateEvent = procedure (Sender: TObject; ACol, ARow: Integer; const Value: TCheckboxState) of object;
1363
1364 { TCustomDrawGrid }
1365
1366 TCustomDrawGrid=class(TCustomGrid)
1367 private
1368 FEditorRow, FEditorCol: Integer;
1369 FOnColRowDeleted: TgridOperationEvent;
1370 FOnColRowExchanged: TgridOperationEvent;
1371 FOnColRowInserted: TGridOperationEvent;
1372 FOnColRowMoved: TgridOperationEvent;
1373 FOnGetCheckboxState: TGetCheckboxStateEvent;
1374 FOnGetEditMask: TGetEditEvent;
1375 FOnGetEditText: TGetEditEvent;
1376 FOnHeaderClick, FOnHeaderSized: THdrEvent;
1377 FOnHeaderSizing: THeaderSizingEvent;
1378 FOnSelectCell: TOnSelectcellEvent;
1379 FOnSetCheckboxState: TSetCheckboxStateEvent;
1380 FOnSetEditText: TSetEditEvent;
CellNeedsCheckboxBitmapsnull1381 function CellNeedsCheckboxBitmaps(const aCol,aRow: Integer): boolean;
1382 procedure DrawCellCheckboxBitmaps(const aCol,aRow: Integer; const aRect: TRect);
GetEditorValuenull1383 function GetEditorValue(ACol, ARow: Integer): String;
1384 protected
1385 FGrid: TVirtualGrid;
1386 procedure CellClick(const aCol,aRow: Integer; const Button:TMouseButton); override;
1387 procedure ColRowDeleted(IsColumn: Boolean; index: Integer); override;
1388 procedure ColRowExchanged(IsColumn: Boolean; index,WithIndex: Integer); override;
1389 procedure ColRowInserted(IsColumn: boolean; index: integer); override;
1390 procedure ColRowMoved(IsColumn: Boolean; FromIndex,ToIndex: Integer); override;
CreateVirtualGridnull1391 function CreateVirtualGrid: TVirtualGrid; virtual;
1392 procedure DrawCell(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState); override;
1393 procedure DrawCellAutonumbering(aCol,aRow: Integer; aRect: TRect; const aValue: string); virtual;
1394 procedure DrawFocusRect(aCol,aRow: Integer; ARect: TRect); override;
GetCellsnull1395 function GetCells(ACol, ARow: Integer): string; override;
1396 procedure GetCheckBoxState(const aCol, aRow:Integer; var aState:TCheckboxState); virtual;
GetEditMasknull1397 function GetEditMask(aCol, aRow: Longint): string; override;
GetEditTextnull1398 function GetEditText(aCol, aRow: Longint): string; override;
1399 procedure GridMouseWheel(shift: TShiftState; Delta: Integer); override;
1400 procedure HeaderClick(IsColumn: Boolean; index: Integer); override;
1401 procedure HeaderSized(IsColumn: Boolean; index: Integer); override;
1402 procedure HeaderSizing(const IsColumn:boolean; const AIndex,ASize:Integer); override;
1403 procedure KeyDown(var Key : Word; Shift : TShiftState); override;
1404 procedure NotifyColRowChange(WasInsert,IsColumn:boolean; FromIndex,ToIndex:Integer);
SelectCellnull1405 function SelectCell(aCol,aRow: Integer): boolean; override;
1406 procedure SetColor(Value: TColor); override;
1407 procedure SetCheckboxState(const aCol, aRow:Integer; const aState: TCheckboxState); virtual;
1408 procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
1409 procedure SizeChanged(OldColCount, OldRowCount: Integer); override;
1410 procedure ToggleCheckbox; virtual;
1411
1412 property OnGetCheckboxState: TGetCheckboxStateEvent
1413 read FOnGetCheckboxState write FOnGetCheckboxState;
1414 property OnSetCheckboxState: TSetCheckboxStateEvent
1415 read FOnSetCheckboxState write FOnSetCheckboxState;
1416
1417 public
1418
1419 // to easy user call
1420 constructor Create(AOwner: TComponent); override;
1421 destructor Destroy; override;
1422 procedure DeleteColRow(IsColumn: Boolean; index: Integer);
1423 procedure DeleteCol(Index: Integer); virtual;
1424 procedure DeleteRow(Index: Integer); virtual;
1425 procedure ExchangeColRow(IsColumn: Boolean; index, WithIndex: Integer); virtual;
1426 procedure InsertColRow(IsColumn: boolean; index: integer);
1427 procedure MoveColRow(IsColumn: Boolean; FromIndex, ToIndex: Integer);
1428 procedure SortColRow(IsColumn: Boolean; index:Integer); overload;
1429 procedure SortColRow(IsColumn: Boolean; Index,FromIndex,ToIndex: Integer); overload;
1430
1431 procedure DefaultDrawCell(aCol,aRow: Integer; var aRect: TRect; aState:TGridDrawState); virtual;
1432 // properties
1433 property AllowOutboundEvents;
1434 property BorderColor;
1435 property Canvas;
1436 property Col;
1437 property ColWidths;
1438 property ColRow;
1439 property DisabledFontColor;
1440 property Editor;
1441 property EditorBorderStyle;
1442 property EditorMode;
1443 property ExtendedColSizing;
1444 property AltColorStartNormal;
1445 property FastEditing;
1446 property FixedGridLineColor;
1447 property FocusColor;
1448 property FocusRectVisible;
1449 property GridHeight;
1450 property GridWidth;
1451 property IsCellSelected;
1452 property LeftCol;
1453 property Row;
1454 property RowHeights;
1455 property SaveOptions;
1456 property SelectedColor;
1457 property SelectedColumn;
1458 property Selection;
1459 property StrictSort;
1460 //property TabStops;
1461 property TopRow;
1462 property UseXORFeatures;
1463 public
1464 property Align;
1465 property Anchors;
1466 property AutoAdvance;
1467 property AutoFillColumns;
1468 //property BiDiMode;
1469 property BorderSpacing;
1470 property BorderStyle;
1471 property Color default clWindow;
1472 property ColCount;
1473 property Columns;
1474 property Constraints;
1475 property DefaultColWidth;
1476 property DefaultDrawing;
1477 property DefaultRowHeight;
1478 //property DragCursor;
1479 //property DragKind;
1480 //property DragMode;
1481 property Enabled;
1482 property FixedColor;
1483 property FixedCols;
1484 property FixedHotColor;
1485 property FixedRows;
1486 property Flat;
1487 property Font;
1488 property GridLineColor;
1489 property GridLineStyle;
1490 property GridLineWidth;
1491 property Options;
1492 property Options2;
1493 //property ParentBiDiMode;
1494 //property ParentColor;
1495 //property ParentFont;
1496 property ParentShowHint;
1497 property PopupMenu;
1498 property RowCount;
1499 property ScrollBars;
1500 property ShowHint;
1501 property TabAdvance;
1502 property TabOrder;
1503 property TabStop;
1504 property Visible;
1505 property VisibleColCount;
1506 property VisibleRowCount;
1507
1508 property OnAfterSelection;
1509 property OnBeforeSelection;
1510 property OnClick;
1511 property OnColRowDeleted: TgridOperationEvent read FOnColRowDeleted write FOnColRowDeleted;
1512 property OnColRowExchanged: TgridOperationEvent read FOnColRowExchanged write FOnColRowExchanged;
1513 property OnColRowInserted: TGridOperationEvent read FOnColRowInserted write FOnColRowInserted;
1514 property OnColRowMoved: TgridOperationEvent read FOnColRowMoved write FOnColRowMoved;
1515 property OnCompareCells;
1516 property OnContextPopup;
1517 property OnDblClick;
1518 property OnDragDrop;
1519 property OnDragOver;
1520 property OnDrawCell;
1521 property OnEditButtonClick; deprecated;
1522 property OnButtonClick;
1523 property OnEndDock;
1524 property OnEndDrag;
1525 property OnEnter;
1526 property OnExit;
1527 property OnGetEditMask: TGetEditEvent read FOnGetEditMask write FOnGetEditMask;
1528 property OnGetEditText: TGetEditEvent read FOnGetEditText write FOnGetEditText;
1529 property OnHeaderClick: THdrEvent read FOnHeaderClick write FOnHeaderClick;
1530 property OnHeaderSized: THdrEvent read FOnHeaderSized write FOnHeaderSized;
1531 property OnHeaderSizing: THeaderSizingEvent read FOnHeaderSizing write FOnHeaderSizing;
1532 property OnKeyDown;
1533 property OnKeyPress;
1534 property OnKeyUp;
1535 property OnMouseDown;
1536 property OnMouseEnter;
1537 property OnMouseLeave;
1538 property OnMouseMove;
1539 property OnMouseUp;
1540 property OnMouseWheel;
1541 property OnMouseWheelDown;
1542 property OnMouseWheelUp;
1543 property OnPickListSelect;
1544 property OnPrepareCanvas;
1545 property OnSelectEditor;
1546 property OnSelection;
1547 property OnSelectCell: TOnSelectCellEvent read FOnSelectCell write FOnSelectCell;
1548 property OnSetEditText: TSetEditEvent read FOnSetEditText write FOnSetEditText;
1549 property OnStartDock;
1550 property OnStartDrag;
1551 property OnTopleftChanged;
1552 property OnUTF8KeyPress;
1553 property OnValidateEntry;
1554 end;
1555
1556
1557
1558 { TDrawGrid }
1559
1560 TDrawGrid = class(TCustomDrawGrid)
1561 public
1562 property InplaceEditor;
1563 published
1564 property Align;
1565 property AlternateColor;
1566 property Anchors;
1567 property AutoAdvance;
1568 property AutoEdit;
1569 property AutoFillColumns;
1570 //property BiDiMode;
1571 property BorderSpacing;
1572 property BorderStyle;
1573 // property CellHintPriority;
1574 property Color;
1575 property ColCount;
1576 property ColRowDraggingCursor;
1577 property ColRowDragIndicatorColor;
1578 property ColSizingCursor;
1579 property ColumnClickSorts;
1580 property Columns;
1581 property Constraints;
1582 property DefaultColWidth;
1583 property DefaultDrawing;
1584 property DefaultRowHeight;
1585 property DoubleBuffered;
1586 property DragCursor;
1587 property DragKind;
1588 property DragMode;
1589 property Enabled;
1590 property ExtendedSelect;
1591 property FixedColor;
1592 property FixedCols;
1593 property FixedRows;
1594 property Flat;
1595 property Font;
1596 property GridLineColor;
1597 property GridLineStyle;
1598 property GridLineWidth;
1599 property HeaderHotZones;
1600 property HeaderPushZones;
1601 property ImageIndexSortAsc;
1602 property ImageIndexSortDesc;
1603 property MouseWheelOption;
1604 property Options;
1605 property Options2;
1606 //property ParentBiDiMode;
1607 property ParentColor default false;
1608 property ParentDoubleBuffered;
1609 property ParentFont;
1610 property ParentShowHint;
1611 property PopupMenu;
1612 property RangeSelectMode;
1613 property RowCount;
1614 property RowSizingCursor;
1615 property ScrollBars;
1616 property ShowHint;
1617 property TabAdvance;
1618 property TabOrder;
1619 property TabStop;
1620 property TitleFont;
1621 property TitleImageList;
1622 property TitleImageListWidth;
1623 property TitleStyle;
1624 property UseXORFeatures;
1625 property Visible;
1626 property VisibleColCount;
1627 property VisibleRowCount;
1628
1629 property OnAfterSelection;
1630 property OnBeforeSelection;
1631 property OnCheckboxToggled;
1632 property OnClick;
1633 property OnColRowDeleted;
1634 property OnColRowExchanged;
1635 property OnColRowInserted;
1636 property OnColRowMoved;
1637 property OnCompareCells;
1638 property OnContextPopup;
1639 property OnDblClick;
1640 property OnDragDrop;
1641 property OnDragOver;
1642 property OnDrawCell;
1643 property OnEditButtonClick; deprecated;
1644 property OnButtonClick;
1645 property OnEditingDone;
1646 property OnEndDock;
1647 property OnEndDrag;
1648 property OnEnter;
1649 property OnExit;
1650 property OnGetCellHint;
1651 property OnGetCheckboxState;
1652 property OnGetEditMask;
1653 property OnGetEditText;
1654 property OnHeaderClick;
1655 property OnHeaderSized;
1656 property OnHeaderSizing;
1657 property OnKeyDown;
1658 property OnKeyPress;
1659 property OnKeyUp;
1660 property OnMouseDown;
1661 property OnMouseEnter;
1662 property OnMouseLeave;
1663 property OnMouseMove;
1664 property OnMouseUp;
1665 property OnMouseWheel;
1666 property OnMouseWheelDown;
1667 property OnMouseWheelUp;
1668 property OnMouseWheelHorz;
1669 property OnMouseWheelLeft;
1670 property OnMouseWheelRight;
1671 property OnPickListSelect;
1672 property OnPrepareCanvas;
1673 property OnSelectEditor;
1674 property OnSelection;
1675 property OnSelectCell;
1676 property OnSetCheckboxState;
1677 property OnSetEditText;
1678 property OnStartDock;
1679 property OnStartDrag;
1680 property OnTopleftChanged;
1681 property OnUserCheckboxBitmap;
1682 property OnUserCheckboxImage;
1683 property OnUTF8KeyPress;
1684 property OnValidateEntry;
1685 end;
1686
1687 TCustomStringGrid = class;
1688
1689 { TStringGridStrings }
1690
1691 TStringGridStrings = class(TStrings)
1692 private
1693 FAddedCount: Integer;
1694 FGrid: TCustomStringGrid;
1695 FIsCol: Boolean;
1696 FIndex: Integer;
1697 FOwner: TMap;
ConvertIndexLineColnull1698 function ConvertIndexLineCol(Index: Integer; var Line, Col: Integer): boolean;
1699 protected
Getnull1700 function Get(Index: Integer): string; override;
GetCountnull1701 function GetCount: Integer; override;
GetObjectnull1702 function GetObject(Index: Integer): TObject; override;
1703 procedure Put(Index: Integer; const S: string); override;
1704 procedure PutObject(Index: Integer; aObject: TObject); override;
1705 public
1706 constructor Create(aGrid: TCustomStringGrid; OwnerMap:TMap; aIsCol: Boolean; aIndex: Longint);
1707 destructor Destroy; override;
Addnull1708 function Add(const S: string): Integer; override;
1709 procedure Assign(Source: TPersistent); override;
1710 procedure Clear; override;
1711 procedure Delete(Index: Integer); override;
1712 procedure Insert(Index: Integer; const S: string); override;
1713 end;
1714
1715
1716 { TCustomStringGrid }
1717
1718 TCustomStringGrid = class(TCustomDrawGrid)
1719 private
1720 FModified: boolean;
1721 FColsMap,FRowsMap: TMap;
1722 fOnCellProcess: TCellProcessEvent;
GetColsnull1723 function GetCols(index: Integer): TStrings;
GetObjectsnull1724 function GetObjects(ACol, ARow: Integer): TObject;
GetRowsnull1725 function GetRows(index: Integer): TStrings;
1726 procedure MapFree(var aMap: TMap);
MapGetColsRowsnull1727 function MapGetColsRows(IsCols: boolean; Index:Integer; var AMap:TMap):TStrings;
1728 procedure ReadCells(Reader: TReader);
1729 procedure SetCols(index: Integer; const AValue: TStrings);
1730 procedure SetObjects(ACol, ARow: Integer; AValue: TObject);
1731 procedure SetRows(index: Integer; const AValue: TStrings);
1732 procedure WriteCells(Writer: TWriter);
1733 procedure CopyCellRectToClipboard(const R:TRect);
1734 protected
1735 procedure AssignTo(Dest: TPersistent); override;
1736 procedure AutoAdjustColumn(aCol: Integer); override;
1737 procedure CalcCellExtent(acol, aRow: Integer; var aRect: TRect); override;
1738 procedure DefineProperties(Filer: TFiler); override;
1739 procedure DefineCellsProperty(Filer: TFiler); virtual;
DoCompareCellsnull1740 function DoCompareCells(Acol,ARow,Bcol,BRow: Integer): Integer; override;
1741 procedure DoCopyToClipboard; override;
1742 procedure DoCutToClipboard; override;
1743 procedure DoPasteFromClipboard; override;
1744 procedure DoCellProcess(aCol, aRow: Integer; processType: TCellProcessType; var aValue: string); virtual;
1745 procedure DrawColumnText(aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState); override;
1746 procedure DrawTextInCell(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState); override;
1747 procedure DrawCellAutonumbering(aCol,aRow: Integer; aRect: TRect; const aValue: string); override;
1748 //procedure EditordoGetValue; override;
1749 //procedure EditordoSetValue; override;
GetCellsnull1750 function GetCells(ACol, ARow: Integer): string; override;
1751 procedure GetCheckBoxState(const aCol, aRow:Integer; var aState:TCheckboxState); override;
GetEditTextnull1752 function GetEditText(aCol, aRow: Integer): string; override;
1753 procedure LoadContent(cfg: TXMLConfig; Version: Integer); override;
1754 procedure Loaded; override;
1755 procedure SaveContent(cfg: TXMLConfig); override;
1756 //procedure DrawInteriorCells; override;
1757 //procedure SelectEditor; override;
1758 procedure SelectionSetText(TheText: String);
1759 procedure SelectionSetHTML(TheHTML, TheText: String);
1760 procedure SetCells(ACol, ARow: Integer; const AValue: string); virtual;
1761 procedure SetCheckboxState(const aCol, aRow:Integer; const aState: TCheckboxState); override;
1762 procedure SetEditText(aCol, aRow: Longint; const aValue: string); override;
1763
1764 property Modified: boolean read FModified write FModified;
1765 property OnCellProcess: TCellProcessEvent read fOnCellProcess write fOnCellProcess;
1766
1767 public
1768 constructor Create(AOwner: TComponent); override;
1769 destructor Destroy; override;
1770 procedure AutoSizeColumn(aCol: Integer);
1771 procedure AutoSizeColumns;
1772 procedure Clean; overload;
1773 procedure Clean(CleanOptions: TGridZoneSet); overload;
1774 procedure Clean(aRect: TRect; CleanOptions: TGridZoneSet); overload;
1775 procedure Clean(StartCol,StartRow,EndCol,EndRow: integer; CleanOptions: TGridZoneSet); overload;
1776 procedure CopyToClipboard(AUseSelection: boolean = false);
1777 procedure InsertRowWithValues(Index: Integer; Values: array of String);
1778 procedure LoadFromCSVStream(AStream: TStream; ADelimiter: Char=',';
1779 UseTitles: boolean=true; FromLine: Integer=0; SkipEmptyLines: Boolean=true); virtual;
1780 procedure LoadFromCSVFile(AFilename: string; ADelimiter: Char=',';
1781 UseTitles: boolean=true; FromLine: Integer=0; SkipEmptyLines: Boolean=true);
1782 procedure SaveToCSVStream(AStream: TStream; ADelimiter: Char=',';
1783 WriteTitles: boolean=true; VisibleColumnsOnly: boolean=false);
1784 procedure SaveToCSVFile(AFileName: string; ADelimiter: Char=',';
1785 WriteTitles: boolean=true; VisibleColumnsOnly: boolean=false);
1786
1787 property Cells[ACol, ARow: Integer]: string read GetCells write SetCells;
1788 property Cols[index: Integer]: TStrings read GetCols write SetCols;
1789 property DefaultTextStyle;
1790 property EditorMode;
1791 property ExtendedSelect;
1792 property Objects[ACol, ARow: Integer]: TObject read GetObjects write SetObjects;
1793 property Rows[index: Integer]: TStrings read GetRows write SetRows;
1794 property UseXORFeatures;
1795 property ValidateOnSetSelection;
1796 end;
1797
1798
1799 { TStringGrid }
1800
1801 TStringGrid = class(TCustomStringGrid)
1802 protected
1803 class procedure WSRegisterClass; override;
1804 public
1805 property Modified;
1806 property InplaceEditor;
1807 published
1808 property Align;
1809 property AlternateColor;
1810 property Anchors;
1811 property AutoAdvance;
1812 property AutoEdit;
1813 property AutoFillColumns;
1814 property BiDiMode;
1815 property BorderSpacing;
1816 property BorderStyle;
1817 property CellHintPriority;
1818 property Color;
1819 property ColCount;
1820 property ColRowDraggingCursor;
1821 property ColRowDragIndicatorColor;
1822 property ColSizingCursor;
1823 property ColumnClickSorts;
1824 property Columns;
1825 property Constraints;
1826 property DefaultColWidth;
1827 property DefaultDrawing;
1828 property DefaultRowHeight;
1829 property DoubleBuffered;
1830 property DragCursor;
1831 property DragKind;
1832 property DragMode;
1833 property Enabled;
1834 property ExtendedSelect;
1835 property FixedColor;
1836 property FixedCols;
1837 property FixedRows;
1838 property Flat;
1839 property Font;
1840 property GridLineColor;
1841 property GridLineStyle;
1842 property GridLineWidth;
1843 property HeaderHotZones;
1844 property HeaderPushZones;
1845 property ImageIndexSortAsc;
1846 property ImageIndexSortDesc;
1847 property MouseWheelOption;
1848 property Options;
1849 property Options2;
1850 property ParentBiDiMode;
1851 property ParentColor default false;
1852 property ParentDoubleBuffered;
1853 property ParentFont;
1854 property ParentShowHint;
1855 property PopupMenu;
1856 property RangeSelectMode;
1857 property RowCount;
1858 property RowSizingCursor;
1859 property ScrollBars;
1860 property ShowHint;
1861 property TabAdvance;
1862 property TabOrder;
1863 property TabStop;
1864 property TitleFont;
1865 property TitleImageList;
1866 property TitleStyle;
1867 property UseXORFeatures;
1868 property Visible;
1869 property VisibleColCount;
1870 property VisibleRowCount;
1871
1872 property OnAfterSelection;
1873 property OnBeforeSelection;
1874 property OnCellProcess;
1875 property OnChangeBounds;
1876 property OnCheckboxToggled;
1877 property OnClick;
1878 property OnColRowDeleted;
1879 property OnColRowExchanged;
1880 property OnColRowInserted;
1881 property OnColRowMoved;
1882 property OnCompareCells;
1883 property OnContextPopup;
1884 property OnDragDrop;
1885 property OnDragOver;
1886 property OnDblClick;
1887 property OnDrawCell;
1888 property OnEditButtonClick; deprecated;
1889 property OnButtonClick;
1890 property OnEditingDone;
1891 property OnEndDock;
1892 property OnEndDrag;
1893 property OnEnter;
1894 property OnExit;
1895 property OnGetCellHint;
1896 property OnGetCheckboxState;
1897 property OnGetEditMask;
1898 property OnGetEditText;
1899 property OnHeaderClick;
1900 property OnHeaderSized;
1901 property OnHeaderSizing;
1902 property OnKeyDown;
1903 property OnKeyPress;
1904 property OnKeyUp;
1905 property OnMouseDown;
1906 property OnMouseEnter;
1907 property OnMouseLeave;
1908 property OnMouseMove;
1909 property OnMouseUp;
1910 property OnMouseWheel;
1911 property OnMouseWheelDown;
1912 property OnMouseWheelUp;
1913 property OnMouseWheelHorz;
1914 property OnMouseWheelLeft;
1915 property OnMouseWheelRight;
1916 property OnPickListSelect;
1917 property OnPrepareCanvas;
1918 property OnResize;
1919 property OnSelectEditor;
1920 property OnSelection;
1921 property OnSelectCell;
1922 property OnSetCheckboxState;
1923 property OnSetEditText;
1924 property OnShowHint;
1925 property OnStartDock;
1926 property OnStartDrag;
1927 property OnTopLeftChanged;
1928 property OnUserCheckboxBitmap;
1929 property OnUserCheckboxImage;
1930 property OnUTF8KeyPress;
1931 property OnValidateEntry;
1932 end;
1933
1934 procedure DrawRubberRect(Canvas: TCanvas; aRect: TRect; Color: TColor; DrawBits:Byte=BF_RECT);
GetWorkingCanvasnull1935 function GetWorkingCanvas(const Canvas: TCanvas): TCanvas;
1936 procedure FreeWorkingCanvas(canvas: TCanvas);
1937
1938 procedure Register;
1939
1940 implementation
1941
1942 {$R lcl_grid_images.res}
1943
1944 uses
1945 WSGrids;
1946
1947 {$WARN SYMBOL_DEPRECATED OFF}
1948 {$IFDEF FPC_HAS_CPSTRING}
1949 {$WARN IMPLICIT_STRING_CAST OFF}
1950 {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
1951 {$ENDIF}
1952
1953 const
1954 MULTISEL_MODIFIER = {$IFDEF Darwin}ssMeta{$ELSE}ssCtrl{$ENDIF};
1955
BidiFlipXnull1956 function BidiFlipX(X: Integer; const Width: Integer; const Flip: Boolean): Integer;
1957 begin
1958 if Flip then
1959 //-1 because it zero based
1960 Result := Width - X - 1
1961 else
1962 Result := X;
1963 end;
1964
BidiFlipXnull1965 function BidiFlipX(X: Integer; const ParentRect: TRect; const Flip: Boolean): Integer;
1966 begin
1967 Result := BidiFlipX(X, ParentRect.Right, Flip);
1968 end;
1969
BidiFlipPointnull1970 function BidiFlipPoint(P: TPoint; const ParentRect: TRect; const Flip: Boolean): TPoint;
1971 begin
1972 Result := P;
1973 Result.Y := BidiFlipX(Result.Y, ParentRect, Flip);
1974 end;
1975
PointIgualnull1976 function PointIgual(const P1,P2: TPoint): Boolean;
1977 begin
1978 result:=(P1.X=P2.X)and(P1.Y=P2.Y);
1979 end;
1980
NormalizarRectnull1981 function NormalizarRect(const R:TRect): TRect;
1982 begin
1983 Result.Left:=Min(R.Left, R.Right);
1984 Result.Top:=Min(R.Top, R.Bottom);
1985 Result.Right:=Max(R.Left, R.Right);
1986 Result.Bottom:=Max(R.Top, R.Bottom);
1987 end;
1988
1989 procedure SwapInt(var I1,I2: Integer);
1990 var
1991 Tmp: Integer;
1992 begin
1993 Tmp:=I1;
1994 I1:=I2;
1995 I2:=Tmp;
1996 end;
1997
1998 {$ifdef GridTraceMsg}
TransMsgnull1999 function TransMsg(const S: String; const TheMsg: TLMessage): String;
2000 begin
2001 case TheMsg.Msg of
2002 CM_BASE..CM_MOUSEWHEEL:
2003 case TheMsg.Msg of
2004 CM_MOUSEENTER: exit; //Result := 'CM_MOUSEENTER';
2005 CM_MOUSELEAVE: exit; //Result := 'CM_MOUSELEAVE';
2006 CM_TEXTCHANGED: Result := 'CM_TEXTCHANGED';
2007 CM_UIACTIVATE: Result := 'CM_UIACTIVATE';
2008 CM_CONTROLLISTCHANGE: Result := 'CM_CONTROLLISTCHANGE';
2009
2010 CM_PARENTCOLORCHANGED: Result := 'CM_PARENTCOLORCHANGED';
2011 CM_PARENTSHOWHINTCHANGED: Result := 'CM_PARENTSHOWHINTCHANGED';
2012 CM_PARENTBIDIMODECHANGED: Result := 'CM_PARENTBIDIMODECHANGED';
2013 CM_CONTROLCHANGE: Result := 'CM_CONTROLCHANGE';
2014 CM_SHOWINGCHANGED: Result := 'CM_SHOWINGCHANGED';
2015 CM_VISIBLECHANGED: Result := 'CM_VISIBLECHANGED';
2016 CM_HITTEST: exit;//Result := 'CM_HITTEST';
2017 else Result := 'CM_BASE + '+ IntToStr(TheMsg.Msg - CM_BASE);
2018 end;
2019 else
2020 case TheMsg.Msg of
2021 //CN_BASE MESSAGES
2022 CN_COMMAND: Result := 'CN_COMMAND';
2023 CN_KEYDOWN: Result := 'CN_KEYDOWN';
2024 CN_KEYUP: Result := 'CN_KEYUP';
2025 CN_CHAR: Result := 'CN_CHAR';
2026
2027 // NORMAL MESSAGES
2028 LM_SETFOCUS: Result := 'LM_SetFocus';
2029 LM_LBUTTONDOWN: Result := 'LM_MOUSEDOWN';
2030 LM_LBUTTONUP: Result := 'LM_LBUTTONUP';
2031 LM_LBUTTONDBLCLK: Result := 'LM_LBUTTONDBLCLK';
2032 LM_RBUTTONDOWN: Result := 'LM_RBUTTONDOWN';
2033 LM_RBUTTONUP: Result := 'LM_RBUTTONUP';
2034 LM_RBUTTONDBLCLK: Result := 'LM_RBUTTONDBLCLK';
2035 LM_GETDLGCODE: Result := 'LM_GETDLGCODE';
2036 LM_KEYDOWN: Result := 'LM_KEYDOWN';
2037 LM_KEYUP: Result := 'LM_KEYUP';
2038 LM_CAPTURECHANGED: Result := 'LM_CAPTURECHANGED';
2039 LM_ERASEBKGND: Result := 'LM_ERASEBKGND';
2040 LM_KILLFOCUS: Result := 'LM_KILLFOCUS';
2041 LM_CHAR: Result := 'LM_CHAR';
2042 LM_SHOWWINDOW: Result := 'LM_SHOWWINDOW';
2043 LM_SIZE: Result := 'LM_SIZE';
2044 LM_WINDOWPOSCHANGED: Result := 'LM_WINDOWPOSCHANGED';
2045 LM_HSCROLL: Result := 'LM_HSCROLL';
2046 LM_VSCROLL: Result := 'LM_VSCROLL';
2047 LM_MOUSEMOVE: exit;//Result := 'LM_MOUSEMOVE';
2048 LM_MOUSEWHEEL: Result := 'LM_MOUSEWHEEL';
2049 1105: exit;//Result := '?EM_SETWORDBREAKPROCEX?';
2050 else Result := GetMessageName(TheMsg.Msg);
2051 end;
2052 end;
2053 Result:= S + '['+IntToHex(TheMsg.msg, 8)+'] W='+IntToHex(TheMsg.WParam,8)+
2054 ' L='+IntToHex(TheMsg.LParam,8)+' '+Result;
2055 DebugLn(Result);
2056 end;
2057 {$Endif GridTraceMsg}
2058
dbgsnull2059 function dbgs(zone: TGridZone):string; overload;
2060 begin
2061 case Zone of
2062 gzFixedCells: Result := 'gzFixedCells';
2063 gzFixedCols: Result := 'gzFixedCols';
2064 gzFixedRows: Result := 'gzFixedRows';
2065 gzNormal: Result := 'gzNormal';
2066 gzInvalid: Result := 'gzInvalid';
2067 else
2068 result:= 'gz-error';
2069 end;
2070 end;
2071
dbgsnull2072 function dbgs(zones: TGridZoneSet):string; overload;
2073 procedure add(const s:string);
2074 begin
2075 if result<>'' then
2076 result := result + ',' + s
2077 else
2078 result := s;
2079 end;
2080 begin
2081 result:='';
2082 if gzFixedCells in zones then add('gzFixedCells');
2083 if gzFixedCols in zones then add('gzFixedCols');
2084 if gzFixedRows in zones then add('gzFixedRows');
2085 if gzNormal in zones then add('gzNormal');
2086 if gzInvalid in zones then add('gzInvalid');
2087 result := '['+result+']';
2088 end;
2089
2090 {$ifdef DbgScroll}
SbToStrnull2091 function SbToStr(Which: Integer): string;
2092 begin
2093 case Which of
2094 SB_VERT: result := 'vert';
2095 SB_HORZ: result := 'horz';
2096 SB_BOTH: result := 'both';
2097 else
2098 result := '????';
2099 end;
2100 end;
2101 {$endif}
2102
2103 procedure CfgSetFontValue(cfg: TXMLConfig; AKey: WideString; AFont: TFont);
2104 begin
2105 cfg.SetValue(AKey + '/name/value', AFont.Name);
2106 cfg.SetValue(AKey + '/size/value', AFont.Size);
2107 cfg.SetValue(AKey + '/color/value', ColorToString(AFont.Color));
2108 cfg.SetValue(AKey + '/style/value', Integer(AFont.Style));
2109 end;
2110
2111 procedure CfgGetFontValue(cfg: TXMLConfig; AKey: WideString; AFont: TFont);
2112 begin
2113 AFont.Name := cfg.GetValue(AKey + '/name/value', 'default');
2114 AFont.Size := cfg.GetValue(AKey + '/size/value', 0);
2115 AFont.Color:= StringToColor(cfg.GetValue(AKey + '/color/value', 'clWindowText'));
2116 AFont.Style:= TFontStyles(cfg.GetValue(AKey + '/style/value', 0));
2117 end;
2118
2119 // Draws a dotted rectangle by drawing each enabled side. By default all sides are
2120 // enabled. The DrawBits parameter set sides to drawn, it has this layout: xxxxBRTL
2121 procedure DrawRubberRect(Canvas: TCanvas; aRect: TRect; Color: TColor;
2122 DrawBits: Byte);
2123 procedure DrawVertLine(X1,Y1,Y2: integer);
2124 begin
2125 if Y2<Y1 then
2126 while Y2<Y1 do begin
2127 Canvas.Pixels[X1, Y1] := Color;
2128 dec(Y1, varRubberSpace);
2129 end
2130 else
2131 while Y1<Y2 do begin
2132 Canvas.Pixels[X1, Y1] := Color;
2133 inc(Y1, varRubberSpace);
2134 end;
2135 end;
2136 procedure DrawHorzLine(X1,Y1,X2: integer);
2137 begin
2138 if X2<X1 then
2139 while X2<X1 do begin
2140 Canvas.Pixels[X1, Y1] := Color;
2141 dec(X1, varRubberSpace);
2142 end
2143 else
2144 while X1<X2 do begin
2145 Canvas.Pixels[X1, Y1] := Color;
2146 inc(X1, varRubberSpace);
2147 end;
2148 end;
2149 begin
2150 with aRect do begin
2151 if (DrawBits and BF_TOP = BF_TOP) then DrawHorzLine(Left, Top, Right-1);
2152 if (DrawBits and BF_RIGHT = BF_RIGHT) then DrawVertLine(Right-1, Top, Bottom-1);
2153 if (DrawBits and BF_BOTTOM = BF_BOTTOM) then DrawHorzLine(Right-1, Bottom-1, Left);
2154 if (DrawBits and BF_LEFT = BF_LEFT) then DrawVertLine(Left, Bottom-1, Top);
2155 end;
2156 end;
2157
GetWorkingCanvasnull2158 function GetWorkingCanvas(const Canvas: TCanvas): TCanvas;
2159 var
2160 DC: HDC;
2161 begin
2162
2163 if (Canvas=nil) or (not Canvas.HandleAllocated) then begin
2164 DC := GetDC(0);
2165 Result := TCanvas.Create;
2166 Result.Handle := DC;
2167 end else
2168 Result := Canvas;
2169
2170 end;
2171
2172 procedure FreeWorkingCanvas(canvas: TCanvas);
2173 begin
2174
2175 ReleaseDC(0, Canvas.Handle);
2176 Canvas.Free;
2177
2178 end;
2179
Betweennull2180 function Between(const AValue,AMin,AMax: Integer): boolean;
2181 begin
2182 if AMin<AMax then
2183 result := InRange(AValue, AMin, AMax)
2184 else
2185 result := InRange(AValue, AMax, AMin);
2186 end;
2187
2188 { TCustomGrid }
2189
GetRowHeightsnull2190 function TCustomGrid.GetRowHeights(Arow: Integer): Integer;
2191 begin
2192 if IsRowIndexValid(aRow) then
2193 Result:=FRows[aRow]
2194 else
2195 Result:=-1;
2196 if Result<0 then
2197 Result:=DefaultRowHeight;
2198 end;
2199
GetTopRownull2200 function TCustomGrid.GetTopRow: Longint;
2201 begin
2202 Result:=fTopLeft.y;
2203 end;
2204
TCustomGrid.GetVisibleColCountnull2205 function TCustomGrid.GetVisibleColCount: Integer;
2206 begin
2207 with FGCache do begin
2208 Result := VisibleGrid.Right-VisibleGrid.Left;
2209 if GridWidth<=ClientWidth then
2210 inc(Result)
2211 end;
2212 end;
2213
TCustomGrid.GetVisibleRowCountnull2214 function TCustomGrid.GetVisibleRowCount: Integer;
2215 begin
2216 with FGCache do begin
2217 Result:=VisibleGrid.bottom-VisibleGrid.top;
2218 if GridHeight<=ClientHeight then
2219 inc(Result);
2220 end;
2221 end;
2222
2223 procedure TCustomGrid.HeadersMouseMove(const X, Y: Integer);
2224 var
2225 P: TPoint;
2226 Gz: TGridZone;
2227 ButtonColumn: boolean;
2228 begin
2229
2230 with FGCache do begin
2231
2232 Gz := MouseToGridZone(X,Y);
2233 ButtonColumn := IsMouseOverCellButton(X, Y);
2234 P := MouseToCell(Point(X, Y));
2235
2236 if (gz<>HotGridZone) or (P.x<>HotCell.x) or (P.y<>HotCell.y) then begin
2237 ResetHotCell;
2238 if (P.x>=0) and (P.y>=0) then begin
2239 if ButtonColumn or (goHeaderHotTracking in Options) then begin
2240 InvalidateCell(P.X, P.Y);
2241 HotCell := P;
2242 end;
2243 end;
2244 end;
2245
2246 if ButtonColumn or (goHeaderPushedLook in Options) then begin
2247 if ClickCellPushed then begin
2248 if (P.X<>PushedCell.x) or (P.Y<>PushedCell.Y) then
2249 ResetPushedCell(False);
2250 end else
2251 if IsPushCellActive() then begin
2252 if (P.X=PushedCell.X) and (P.Y=PushedCell.Y) then begin
2253 ClickCellPushed:=True;
2254 InvalidateCell(P.X, P.Y);
2255 end;
2256 end;
2257 end;
2258
2259 HotGridZone := Gz;
2260 end;
2261 end;
2262
2263 procedure TCustomGrid.InternalAutoFillColumns;
2264
2265 procedure SetColumnWidth(aCol,aWidth: Integer);
2266 begin
2267 if csLoading in ComponentState then
2268 SetRawColWidths(aCol, aWidth)
2269 else
2270 SetColWidths(aCol, aWidth);
2271 end;
2272
2273 var
2274 I, ForcedIndex: Integer;
2275 Count: Integer;
2276 aPriority, aMin, aMax: Integer;
2277 AvailableSize: Integer;
2278 TotalWidth: Integer; // total grid's width
2279 FixedSizeWidth: Integer; // total width of Fixed Sized Columns
2280 begin
2281 if not AutoFillColumns then
2282 exit;
2283
2284 if FUpdatingAutoFillCols then
2285 exit;
2286
2287 FUpdatingAutoFillCols:=True;
2288 try
2289 // if needed, last size can be obtained from FLastWidth
2290 // when InternalAutoFillColumns is called from DoChangeBounds
2291 // for example.
2292
2293 // Insert the algorithm that modify ColWidths accordingly
2294 //
2295 // For testing purposes, a simple algortihm is implemented:
2296 // if SizePriority=0, column size should be unmodified
2297 // if SizePriority<>0 means variable size column, its size
2298 // is the average avalilable size.
2299
2300 Count := 0;
2301 FixedSizeWidth := 0;
2302 TotalWidth := 0;
2303 for i:=0 to ColCount-1 do begin
2304 GetAutoFillColumnInfo(i, aMin, aMax, aPriority);
2305 AvailableSize := GetColWidths(i);
2306 if aPriority>0 then
2307 Inc(Count)
2308 else
2309 Inc(FixedSizeWidth, AvailableSize);
2310 Inc(TotalWidth, AvailableSize);
2311 end;
2312
2313 if Count=0 then begin
2314 //it's an autofillcolumns grid, so at least one
2315 // of the columns must fill completely the grid's
2316 // available width, let it be that column the last
2317 ForcedIndex := ColCount-1;
2318 if ForcedIndex>=FixedCols then
2319 Dec(FixedSizeWidth, GetColWidths(ForcedIndex));
2320 Count := 1;
2321 end else
2322 ForcedIndex := -1;
2323
2324 AvailableSize := ClientWidth - FixedSizeWidth - GetBorderWidth;
2325 if AvailableSize<0 then begin
2326 // There is no space available to fill with
2327 // Variable Size Columns, what to do?
2328
2329 // Simply set all Variable Size Columns
2330 // to 0, decreasing the size beyond this
2331 // shouldn't be allowed.
2332 for i:=0 to ColCount-1 do begin
2333 GetAutoFillColumnInfo(i, aMin, aMax, aPriority);
2334 if aPriority>0 then
2335 SetColumnWidth(i, 0);
2336 end;
2337 end else begin
2338 // Simpler case: There is actually available space to
2339 // to be shared for variable size columns.
2340 FixedSizeWidth := AvailableSize mod Count; // space left after filling columns
2341 AvailableSize := AvailableSize div Count;
2342 for i:=0 to ColCount-1 do begin
2343 GetAutoFillColumnInfo(i, aMin, aMax, aPriority);
2344 if (APriority>0) or (i=ForcedIndex) then begin
2345 if i=ColCount-1 then
2346 // the last column gets all space left
2347 SetColumnWidth(i, AvailableSize + FixedSizeWidth)
2348 else
2349 SetColumnWidth(i, AvailableSize);
2350 end;
2351 end;
2352 end;
2353 finally
2354 FUpdatingAutoFillCols:=False;
2355 end;
2356 end;
2357
InternalNeedBordernull2358 function TCustomGrid.InternalNeedBorder: boolean;
2359 begin
2360 result := FFlat and (FGridBorderStyle = bsSingle);
2361 end;
2362
2363 procedure TCustomGrid.InternalSetColCount(ACount: Integer);
2364 var
2365 OldC: Integer;
2366 NewRowCount: Integer;
2367 begin
2368 OldC := FCols.Count;
2369 if ACount=OldC then
2370 Exit;
2371 if ACount<1 then
2372 Clear
2373 else begin
2374 if EditorMode and (ACount<=Col) then
2375 EditorMode:=False;
2376 NewRowCount := RowCount;
2377 if (OldC=0) and FGridPropBackup.ValidData then begin
2378 NewRowCount := FGridPropBackup.RowCount;
2379 FFixedRows := Min(FGridPropBackup.FixedRowCount, NewRowCount);
2380 FFixedCols := Min(FGridPropBackup.FixedColCount, ACount);
2381 end;
2382 CheckFixedCount(ACount, NewRowCount, FFixedCols, FFixedRows);
2383 CheckCount(ACount, NewRowCount);
2384 AdjustCount(True, OldC, ACount);
2385 FGridPropBackup.ValidData := false;
2386 end;
2387 end;
2388
2389 procedure TCustomGrid.InternalSetColWidths(aCol, aValue: Integer);
2390 var
2391 OldSize,NewSize: Integer;
2392 R: TRect;
2393 Bigger: boolean;
2394 begin
2395 NewSize := AValue;
2396 if NewSize<0 then begin
2397 AValue:=-1;
2398 NewSize := DefaultColWidth;
2399 end;
2400
2401 OldSize := FCols[ACol];
2402 if NewSize<>OldSize then begin
2403
2404 if OldSize<0 then
2405 OldSize := DefaultColWidth;
2406
2407 Bigger := NewSize>OldSize;
2408 SetRawColWidths(ACol, AValue);
2409
2410 if not (csLoading in ComponentState) and HandleAllocated then begin
2411
2412 if FUpdateCount=0 then begin
2413 UpdateSizes;
2414 R := CellRect(aCol, 0);
2415 R.Bottom := FGCache.MaxClientXY.Y+GetBorderWidth+1;
2416 if UseRightToLeftAlignment then begin
2417 //Bigger or not bigger i will refresh
2418 R.Left := FGCache.ClientRect.Left;
2419 if aCol=FTopLeft.x then
2420 R.Right := FGCache.ClientRect.Right - FGCache.FixedWidth;
2421 end
2422 else begin
2423 if Bigger then
2424 R.Right := FGCache.MaxClientXY.X+GetBorderWidth+1
2425 else
2426 R.Right := FGCache.ClientWidth;
2427 if aCol=FTopLeft.x then
2428 R.Left := FGCache.FixedWidth;
2429 end;
2430 InvalidateRect(handle, @R, False);
2431 end;
2432
2433 if (FEditor<>nil)and(Feditor.Visible)and(ACol<=FCol) then
2434 EditorWidthChanged(aCol, aValue);
2435 ColWidthsChanged;
2436 end;
2437
2438 end;
2439 end;
2440
2441 procedure TCustomGrid.InternalUpdateColumnWidths;
2442 var
2443 i: Integer;
2444 C: TGridColumn;
2445 begin
2446 for i:= FixedCols to ColCount-1 do begin
2447 C := ColumnFromGridColumn(i);
2448 if C<>nil then
2449 SetRawColWidths(i, C.Width);
2450 end;
2451 end;
2452
2453 procedure TCustomGrid.InvalidateMovement(DCol, DRow: Integer; OldRange: TRect);
2454
2455 procedure doInvalidateRange(Col1,Row1,Col2,Row2: Integer);
2456 begin
2457 InvalidateRange(Rect(Col1,Row1,Col2,Row2));
2458 end;
2459
2460 begin
2461 if (goRowHighlight in Options) then
2462 OldRange := Rect(FFixedCols, OldRange.Top, Colcount-1, OldRange.Bottom);
2463 if SelectActive then begin
2464
2465 if DCol>FCol then begin
2466 // expanded cols
2467 if not (goRowSelect in Options) then
2468 doInvalidateRange(FCol, OldRange.Top, DCol, Oldrange.Bottom)
2469
2470 else if (goRelaxedRowSelect in Options) and (DRow=FRow) then
2471 InvalidateRow(DRow)
2472
2473 end else if DCol<FCol then begin
2474 // shrunk cols
2475 if not (goRowSelect in Options) then
2476 doInvalidateRange(DCol,OldRange.Top,FCol,OldRange.Bottom)
2477
2478 else if (goRelaxedRowSelect in Options) and (DRow=FRow) then
2479 InvalidateRow(DRow)
2480
2481 end;
2482
2483 if DRow>FRow then
2484 // expanded rows
2485 doInvalidateRange(OldRange.Left, FRow, OldRange.Right, DRow)
2486
2487 else if DRow<FRow then
2488 // shrunk rows
2489 doInvalidateRange(OldRange.Left, DRow, OldRange.Right, FRow);
2490
2491 if not ((goRowSelect in Options) or (goRowHighlight in Options)) then begin
2492
2493 // Above rules do work only if either rows or cols remain
2494 // constant, if both rows and cols change there may be gaps
2495 //
2496 // four cases are left.
2497 //
2498
2499 if (DCol>FCol)and(DRow<FRow) then // (1: I Cuadrant)
2500 // Rect(FCol+1,FRow-1,DCol,DRow) normalized -v
2501 doInvalidateRange(FCol+1, DRow, DCol, FRow-1)
2502 else
2503 if (DCol<FCol)and(DRow<FRow) then // (2: II Cuadrant)
2504 // Rect(FCol-1,FRow-1,DCol,DRow) normalized -v
2505 doInvalidateRange(DCol, DRow, FCol-1, FRow-1)
2506 else
2507 if (DCol<FCol)and(DRow>FRow) then // (3: III Cuadrant)
2508 // Rect(FCol-1,FRow+1,DCol,DRow) normalized -v
2509 doInvalidateRange(DCol, FRow+1, FCol-1, DRow)
2510 else
2511 if (DCol>FCol)and(DRow>FRow) then // (4: IV Cuadrant)
2512 // normalization not needed
2513 doInvalidateRange(FCol+1,FRow+1,DCol,DRow);
2514
2515 end;
2516
2517 end else begin
2518
2519 if (OldRange.Right-OldRange.Left>0) or
2520 (OldRange.Bottom-OldRange.Top>0) then
2521 // old selected range gone, invalidate old area
2522 InvalidateRange(OldRange)
2523 else
2524 // Single cell
2525 InvalidateCell(FCol, FRow);
2526
2527 // and invalidate current selecion, cell or full row
2528 if ((goRowSelect in Options) or (goRowHighlight in Options)) then
2529 InvalidateRow(Drow)
2530 else
2531 InvalidateCell(DCol, DRow);
2532
2533 end;
2534
2535 end;
2536
TCustomGrid.IsColumnsStorednull2537 function TCustomGrid.IsColumnsStored: boolean;
2538 begin
2539 result := Columns.Enabled;
2540 end;
2541
IsPushCellActivenull2542 function TCustomGrid.IsPushCellActive: boolean;
2543 begin
2544 with FGCache do
2545 result := (PushedCell.X<>-1) and (PushedCell.Y<>-1);
2546 end;
2547
LoadResBitmapImagenull2548 function TCustomGrid.LoadResBitmapImage(const ResName: string): TBitmap;
2549 var
2550 C: TPortableNetworkGraphic;
2551 begin
2552 C := TPortableNetworkGraphic.Create;
2553 try
2554 C.LoadFromResourceName(hInstance, ResName);
2555 Result := TBitmap.Create;
2556 Result.Assign(C);
2557 finally
2558 C.Free;
2559 end;
2560 end;
2561
TCustomGrid.MouseButtonAllowednull2562 function TCustomGrid.MouseButtonAllowed(Button: TMouseButton): boolean;
2563 begin
2564 result := (Button=mbLeft);
2565 end;
2566
TCustomGrid.GetLeftColnull2567 function TCustomGrid.GetLeftCol: Integer;
2568 begin
2569 result:=fTopLeft.x;
2570 end;
2571
GetPxTopLeftnull2572 function TCustomGrid.GetPxTopLeft: TPoint;
2573 begin
2574 if (FTopLeft.x >= 0) and (FTopLeft.x < FGCache.AccumWidth.Count) then
2575 Result.x := FGCache.AccumWidth[FTopLeft.x]+FGCache.TLColOff-FGCache.FixedWidth
2576 else if FTopLeft.x > 0 then
2577 Result.x := FGCache.GridWidth+FGCache.TLColOff-FGCache.FixedWidth
2578 else
2579 Result.x := 0;
2580
2581 if (FTopLeft.y >= 0) and (FTopLeft.y < FGCache.AccumHeight.Count) then
2582 Result.y := FGCache.AccumHeight[FTopLeft.y]+FGCache.TLRowOff-FGCache.FixedHeight
2583 else if FTopLeft.y > 0 then
2584 Result.y := FGCache.GridHeight+FGCache.TLRowOff-FGCache.FixedHeight
2585 else
2586 Result.y := 0;
2587 end;
2588
TCustomGrid.GetColCountnull2589 function TCustomGrid.GetColCount: Integer;
2590 begin
2591 Result:=FCols.Count;
2592 end;
2593
TCustomGrid.GetRowCountnull2594 function TCustomGrid.GetRowCount: Integer;
2595 begin
2596 Result:=FRows.Count;
2597 end;
2598
IsColumnIndexValidnull2599 function TCustomGrid.IsColumnIndexValid(AIndex: Integer): boolean;
2600 begin
2601 Result := (AIndex>=0) and (AIndex<ColCount);
2602 end;
2603
TCustomGrid.IsRowIndexValidnull2604 function TCustomGrid.IsRowIndexValid(AIndex: Integer): boolean;
2605 begin
2606 Result := (AIndex>=0) and (AIndex<RowCount);
2607 end;
2608
IsColumnIndexVariablenull2609 function TCustomGrid.IsColumnIndexVariable(AIndex: Integer): boolean;
2610 begin
2611 Result := (AIndex>=FFixedCols) and (AIndex<ColCount);
2612 end;
2613
TCustomGrid.IsRowIndexVariablenull2614 function TCustomGrid.IsRowIndexVariable(AIndex: Integer): boolean;
2615 begin
2616 Result := (AIndex>=FFixedRows) and (AIndex<RowCount);
2617 end;
2618
GetColWidthsnull2619 function TCustomGrid.GetColWidths(Acol: Integer): Integer;
2620 var
2621 C: TGridColumn;
2622 begin
2623 if not Columns.Enabled or (aCol<FirstGridColumn) then
2624 begin
2625 if IsColumnIndexValid(aCol) then
2626 Result:=FCols[aCol]
2627 else
2628 Result:=-1;
2629 end else
2630 begin
2631 C := ColumnFromGridColumn(Acol);
2632 if C<>nil then
2633 Result:=C.Width
2634 else
2635 Result:=-1;
2636 end;
2637 if Result<0 then
2638 Result:=DefaultColWidth;
2639 end;
2640
2641 procedure TCustomGrid.SetEditor(AValue: TWinControl);
2642 var
2643 Msg: TGridMessage;
2644 begin
2645 if FEditor=AValue then exit;
2646
2647 {$ifdef DbgGrid}
2648 DebugLnEnter('TCustomGrid.SetEditor %s oldEd=%s newEd=%s INIT',[dbgsName(self),dbgsName(FEditor),dbgsName(Avalue)]);
2649 {$endif}
2650 if (FEditor<>nil) and FEditor.Visible then
2651 EditorHide;
2652
2653 FEditor:=AValue;
2654 if FEditor<>nil then begin
2655
2656 if FEditor.Parent=nil then
2657 FEditor.Visible:=False;
2658
2659 if FEditor.Parent<>Self then
2660 FEditor.Parent:=Self;
2661
2662 Msg.LclMsg.msg:=GM_SETGRID;
2663 Msg.Grid:=Self;
2664 Msg.Options:=0;
2665 FEditor.Dispatch(Msg);
2666
2667 FEditorOptions := Msg.Options + 1; // force new editor setup
2668 SetEditorOptions(Msg.Options);
2669 end;
2670 {$ifdef DbgGrid}
2671 DebugLnExit('TCustomGrid.SetEditor DONE');
2672 {$endif}
2673 end;
2674
2675 procedure TCustomGrid.SetFixedCols(const AValue: Integer);
2676 begin
2677 if FFixedCols=AValue then begin
2678 if FixedGrid and FGridPropBackup.ValidData then begin
2679 // user modified fixed properties in fixed grid
2680 // update stored values
2681 FGridPropBackup.FixedColCount := AValue;
2682 end;
2683 exit;
2684 end;
2685 CheckFixedCount(ColCount, RowCount, AValue, FFixedRows);
2686
2687 if EditorMode then
2688 EditorMode:=False;
2689
2690 FFixedCols:=AValue;
2691 FTopLeft.x:=AValue;
2692
2693 if Columns.Enabled then begin
2694
2695 FCol:=AValue;
2696 UpdateSelectionRange;
2697 if not (csLoading in componentState) then
2698 doTopleftChange(true);
2699
2700 ColumnsChanged(nil)
2701
2702 end else begin
2703
2704 if not (csLoading in componentState) then
2705 doTopleftChange(true);
2706
2707 MoveNextSelectable(False, FixedCols, FRow);
2708 UpdateSelectionRange;
2709 end;
2710 end;
2711
2712 procedure TCustomGrid.SetFixedRows(const AValue: Integer);
2713 begin
2714 if FFixedRows=AValue then begin
2715 if FixedGrid and FGridPropBackup.ValidData then begin
2716 // user modified fixed properties in fixed grid
2717 // update stored values
2718 FGridPropBackup.FixedRowCount := AValue;
2719 end;
2720 exit;
2721 end;
2722 CheckFixedCount(ColCount, RowCount, FFixedCols, AValue);
2723
2724 if EditorMode then
2725 EditorMode:=False;
2726
2727 FFixedRows:=AValue;
2728 FTopLeft.y:=AValue;
2729
2730 if not (csLoading in ComponentState) then
2731 doTopleftChange(true);
2732
2733 MoveNextSelectable(False, FCol, FixedRows);
2734 UpdateSelectionRange;
2735 end;
2736
2737 procedure TCustomGrid.SetGridLineColor(const AValue: TColor);
2738 begin
2739 if FGridLineColor=AValue then exit;
2740 FGridLineColor:=AValue;
2741 Invalidate;
2742 end;
2743
2744 procedure TCustomGrid.SetFixedGridLineColor(const AValue: TColor);
2745 begin
2746 if FFixedGridLineColor=AValue then exit;
2747 FFixedGridLineColor:=AValue;
2748 Invalidate;
2749 end;
2750
2751 procedure TCustomGrid.SetLeftCol(const AValue: Integer);
2752 begin
2753 TryScrollTo(AValue, FTopLeft.Y, True, False);
2754 end;
2755
2756 procedure TCustomGrid.SetOptions(const AValue: TGridOptions);
2757 begin
2758 if FOptions=AValue then exit;
2759 FOptions:=AValue;
2760 UpdateSelectionRange;
2761 if goEditing in Options then
2762 SelectEditor;
2763 if goAlwaysShowEditor in Options then
2764 EditorShow(true)
2765 else
2766 EditorHide;
2767 if goAutoAddRowsSkipContentCheck in Options then
2768 FRowAutoInserted := False;
2769 VisualChange;
2770 end;
2771
2772 procedure TCustomGrid.SetOptions2(const AValue: TGridOptions2);
2773 begin
2774 if FOptions2=AValue then exit;
2775 FOptions2:=AValue;
2776 VisualChange;
2777 end;
2778
2779 procedure TCustomGrid.SetScrollBars(const AValue: TScrollStyle);
2780 begin
2781 if FScrollBars=AValue then exit;
2782 FScrollBars:=AValue;
2783 VisualChange;
2784 end;
2785
2786 procedure TCustomGrid.SetTopRow(const AValue: Integer);
2787 begin
2788 TryScrollTo(FTopLeft.X, Avalue, False, True);
2789 end;
2790
StartColSizingnull2791 function TCustomGrid.StartColSizing(const X, Y: Integer):boolean;
2792 var
2793 OrgIndex, TmpIndex: Integer;
2794 ACase: Integer;
2795 begin
2796
2797 result := false;
2798 with FSizing do begin
2799
2800 OrgIndex := FGCache.ClickCell.X;
2801 if OrgIndex<0 then begin
2802 // invalid starting cell
2803 if not AllowOutBoundEvents and (FCursorState=gcsColWidthChanging) then
2804 // resizing still allowed if mouse is within "resizeable region"
2805 OrgIndex := Index
2806 else
2807 exit;
2808 end;
2809
2810 Index := OrgIndex;
2811 ColRowToOffset(true, true, Index, OffIni, OffEnd);
2812
2813 if (Min(OffEnd, FGCache.ClientRect.Right)-FGCache.ClickMouse.X) < (FGCache.ClickMouse.X-OffIni) then begin
2814 if X>FGCache.ClickMouse.X then
2815 ACase := 4 // dragging right side to the right
2816 else
2817 ACase := 3; // dragging right side to the left
2818 end else begin
2819 if X>FGCache.ClickMouse.X then
2820 ACase := 2 // dragging left side to the right
2821 else
2822 ACase := 1; // dragging left side to the left
2823 end;
2824
2825 if UseRightToLeftAlignment then begin
2826 case ACase of
2827 1: ACase := 4;
2828 2: ACase := 3;
2829 3: ACase := 2;
2830 4: ACase := 1;
2831 end;
2832 end;
2833
2834 case ACase of
2835 3: ; // current column is the right one to resize
2836 4: // find following covered column (visible 0-width) at the right side
2837 begin
2838 TmpIndex := Index;
2839 while (TmpIndex<ColCount-1) and (ColWidths[TmpIndex+1]=0) do begin
2840 Inc(TmpIndex);
2841 if not Columns.Enabled or ColumnFromGridColumn(TmpIndex).Visible then
2842 Index := TmpIndex;
2843 end;
2844 end;
2845 2: // find previous visible (width>0) or covered column
2846 begin
2847 Dec(Index);
2848 while (Index>FixedCols) do begin
2849 if not Columns.Enabled or ColumnFromGridColumn(Index).Visible then
2850 break;
2851 Dec(Index);
2852 end;
2853 end;
2854 1: // find previous visible (width>0) column
2855 begin
2856 Dec(Index);
2857 while (Index>FixedCols) do begin
2858 if ColWidths[Index]>0 then
2859 break;
2860 Dec(Index);
2861 end;
2862 end;
2863 end;
2864
2865 if OrgIndex<>Index then
2866 ColRowToOffset(True, True, Index, OffIni, OffEnd);
2867
2868 // if precision on changing cursor from normal to split is expanded, there
2869 // will be a starting big jump on size, to fix it, uncomment next lines
2870 // TODO: check for RTL
2871 //DeltaOff := OffEnd - FGCache.ClickMouse.X;
2872 DeltaOff := 0;
2873
2874 if goFixedColSizing in Options then
2875 result := (Index>=0)
2876 else
2877 result := (Index>=FixedCols);
2878 end;
2879
2880 end;
2881
2882 procedure TCustomGrid.ChangeCursor(ACursor: TCursor;
2883 ASaveCurrentCursor: Boolean = true);
2884 begin
2885 if FCursorChangeLock = 0 then
2886 begin
2887 if ASaveCurrentCursor then
2888 FSavedCursor := Cursor;
2889 inc(FCursorChangeLock);
2890 Cursor := ACursor;
2891 dec(FCursorChangeLock);
2892 end;
2893 end;
2894
2895 procedure TCustomGrid.RestoreCursor;
2896 begin
2897 Cursor := FSavedCursor;
2898 FCursorState := gcsDefault;
2899 end;
2900
2901 procedure TCustomGrid.SetRowHeights(Arow: Integer; Avalue: Integer);
2902 var
2903 OldSize,NewSize: Integer;
2904 R: TRect;
2905 Bigger: boolean;
2906 begin
2907
2908 NewSize := AValue;
2909 if NewSize<0 then begin
2910 AValue:=-1;
2911 NewSize := DefaultRowHeight;
2912 end;
2913
2914 OldSize := FRows[ARow];
2915 if AValue<>OldSize then begin
2916
2917 if OldSize<0 then
2918 OldSize := DefaultRowHeight;
2919
2920 bigger := NewSize > OldSize;
2921
2922 FRows[ARow]:=AValue;
2923
2924 if not (csLoading in ComponentState) and HandleAllocated then begin
2925 if FUpdateCount=0 then begin
2926 UpdateSizes;
2927
2928 R := CellRect(0, aRow);
2929 if UseRightToLeftAlignment then
2930 begin
2931 R.Left := FlipX(FGCache.MaxClientXY.X+GetBorderWidth);
2932 R.Right := R.Right + 1;
2933 end
2934 else
2935 R.Right := FGCache.MaxClientXY.X+GetBorderWidth+1;
2936 if bigger then
2937 R.Bottom := FGCache.MaxClientXY.Y+GetBorderWidth+1
2938 else
2939 R.Bottom := FGCache.ClientHeight;
2940 if aRow=FTopLeft.y then
2941 R.Top := FGCache.FixedHeight;
2942
2943 InvalidateRect(handle, @R, False);
2944 end;
2945
2946 if (FEditor<>nil)and(Feditor.Visible)and(ARow<=FRow) then EditorPos;
2947 RowHeightsChanged;
2948 end;
2949
2950 end;
2951 end;
2952
2953 procedure TCustomGrid.SetColWidths(Acol: Integer; Avalue: Integer);
2954 var
2955 c: TGridColumn;
2956 OldWidth: Integer;
2957 begin
2958 if not Columns.Enabled or (aCol<FFixedCols) then
2959 internalSetColWidths(aCol, aValue)
2960 else begin
2961 C := ColumnFromGridColumn(ACol);
2962 if C<>nil then begin
2963 OldWidth := C.Width;
2964 C.Width := AValue;
2965 SetRawColWidths(ACol, AValue);
2966 if OldWidth<>C.Width then
2967 EditorWidthChanged(aCol, C.Width);
2968 end;
2969 end;
2970 end;
2971
2972 procedure TCustomGrid.SetRawColWidths(ACol: Integer; AValue: Integer);
2973 begin
2974 if ACol < FCols.Count then // Prevent a range error in case of a bug.
2975 FCols[ACol]:=Avalue
2976 else
2977 DebugLn(['TCustomGrid.SetRawColWidths with Range Error: ACol=', ACol, ', Cols.Count=', FCols.Count]);
2978 end;
2979
2980 procedure TCustomGrid.AdjustCount(IsColumn: Boolean; OldValue, NewValue: Integer);
2981
2982 procedure AddDel(Lst: TIntegerList; aCount: Integer);
2983 begin
2984 while lst.Count<aCount do
2985 Lst.Add(-1); // default width/height
2986 Lst.Count:=aCount;
2987 end;
2988
2989 var
2990 OldCount, NewCount: integer;
2991 begin
2992 if IsColumn then begin
2993 AddDel(FCols, NewValue);
2994 FGCache.AccumWidth.Count:=NewValue;
2995 OldCount:=RowCount;
2996 if (OldValue=0)and(NewValue>=0) then begin
2997 FTopLeft.X:=FFixedCols;
2998 if RowCount=0 then begin
2999 if FGridPropBackup.ValidData then begin
3000 NewCount := FGridPropBackup.RowCount;
3001 FFixedRows := Min(FGridPropBackup.FixedRowCount, NewCount);
3002 end
3003 else
3004 NewCount := 1;
3005 FTopLeft.Y:=FFixedRows;
3006 AddDel(FRows, NewCount);
3007 FGCache.AccumHeight.Count:=NewCount;
3008 end;
3009 end;
3010 UpdateCachedSizes;
3011 SizeChanged(OldValue, OldCount);
3012 // if new count makes current col out of range, adjust position
3013 // if not, position should not change (fake changed col to be the last one)
3014 Dec(NewValue);
3015 if NewValue<Col then
3016 NewValue:=Col;
3017 FixPosition(True, NewValue);
3018 end else begin
3019 AddDel(FRows, NewValue);
3020 FGCache.AccumHeight.Count:=NewValue;
3021 OldCount:=ColCount;
3022 if (OldValue=0)and(NewValue>=0) then begin
3023 FTopleft.Y:=FFixedRows;
3024 //DebugLn('TCustomGrid.AdjustCount B ',DbgSName(Self),' FTopLeft=',dbgs(FTopLeft));
3025 if FCols.Count=0 then begin
3026 if FGridPropBackup.ValidData then begin
3027 NewCount := FGridPropBackup.ColCount;
3028 FFixedCols := Min(FGridPropBackup.FixedColCount, NewCount);
3029 end
3030 else begin
3031 NewCount := 1;
3032 FFixedCols := 0;
3033 end;
3034 FTopLeft.X:=FFixedCols;
3035 AddDel(FCols, NewCount);
3036 FGCache.AccumWidth.Count:=NewCount;
3037 end;
3038 end;
3039 UpdateCachedSizes;
3040 SizeChanged(OldCount, OldValue);
3041 // if new count makes current row out of range, adjust position
3042 // if not, position should not change (fake changed row to be the last one)
3043 Dec(NewValue);
3044 if NewValue<Row then
3045 NewValue:=Row;
3046 FixPosition(False, NewValue);
3047 end;
3048 end;
3049
3050 procedure TCustomGrid.AdjustEditorBounds(NewCol,NewRow:Integer);
3051 begin
3052 SetColRow(NewCol,NewRow);
3053 if EditorMode then
3054 EditorPos;
3055 end;
3056
3057 procedure TCustomGrid.AfterMoveSelection(const prevCol, prevRow: Integer);
3058 begin
3059 if Assigned(OnAfterSelection) then
3060 OnAfterSelection(Self, prevCol, prevRow);
3061 end;
3062
3063 procedure TCustomGrid.AssignTo(Dest: TPersistent);
3064 var
3065 Target: TCustomGrid;
3066 begin
3067 if Dest is TCustomGrid then begin
3068
3069 Target := TCustomGrid(Dest);
3070 Target.BeginUpdate;
3071
3072 // structure
3073 Target.FixedCols := 0;
3074 Target.FixedRows := 0;
3075 if Columns.Enabled then
3076 Target.Columns.Assign(Columns)
3077 else begin
3078 Target.ColCount :=ColCount;
3079 end;
3080 Target.RowCount := RowCount;
3081 Target.FixedCols := FixedCols;
3082 Target.FixedRows := FixedRows;
3083 if DefaultRowHeightIsStored then
3084 Target.DefaultRowHeight := DefaultRowHeight
3085 else
3086 Target.DefaultRowHeight := -1;
3087 if DefaultColWidthIsStored then
3088 Target.DefaultColWidth := DefaultColWidth
3089 else
3090 Target.DefaultColWidth := -1;
3091 if not Columns.Enabled then
3092 Target.FCols.Assign(FCols);
3093 Target.FRows.Assign(FRows);
3094
3095 // Options
3096 Target.Options := Options;
3097 Target.Color := Color;
3098 Target.FixedColor := FixedColor;
3099 Target.AlternateColor := AlternateColor;
3100 Target.Font := Font;
3101 Target.TitleFont := TitleFont;
3102
3103 // position
3104 Target.TopRow := TopRow;
3105 Target.LeftCol := LeftCol;
3106 Target.Col := Col;
3107 Target.Row := Row;
3108 Target.FRange := FRange;
3109
3110 Target.EndUpdate;
3111
3112 end else
3113 inherited AssignTo(Dest);
3114 end;
3115
3116 procedure TCustomGrid.SetColCount(AValue: Integer);
3117 begin
3118 if Columns.Enabled then
3119 raise EGridException.Create('Use Columns property to add/remove columns');
3120 InternalSetColCount(AValue);
3121 end;
3122
3123 procedure TCustomGrid.SetRowCount(AValue: Integer);
3124 var
3125 OldR, NewColCount: Integer;
3126 begin
3127 OldR := FRows.Count;
3128 if AValue<>OldR then begin
3129 if AValue>=0 then begin
3130 if EditorMode and (AValue<=Row) then
3131 EditorMode:=False;
3132 NewColCount := ColCount;
3133 if (OldR=0) and FGridPropBackup.ValidData then begin
3134 NewColCount := FGridPropBackup.ColCount;
3135 FFixedCols := Min(FGridPropBackup.FixedColCount, NewColCount);
3136 FFixedRows := Min(FGridPropBackup.FixedRowCount, AValue);
3137 FTopLeft.X := FFixedCols;
3138 FTopLeft.Y := FFixedRows;
3139 // ignore backedup value of rowcount because
3140 // finally rowcount will be AValue
3141 FGridPropBackup.RowCount := AValue;
3142 end;
3143 if Columns.Enabled then begin
3144 // setup custom columns
3145 Self.ColumnsChanged(nil);
3146 FGridPropBackup.ValidData := false;
3147 // still need to adjust rowcount?
3148 if AValue=FRows.Count then
3149 exit;
3150 end;
3151 CheckFixedCount(NewColCount, AValue, FFixedCols, FFixedRows);
3152 CheckCount(NewColCount, AValue);
3153 AdjustCount(False, OldR, AValue);
3154 end
3155 else
3156 ClearRows;
3157 end;
3158 end;
3159
3160 procedure TCustomGrid.SetDefColWidth(AValue: Integer);
3161 var
3162 OldLeft,OldRight,NewLeft,NewRight: Integer;
3163 begin
3164 if AValue=fDefColwidth then
3165 Exit;
3166 FDefColWidth:=AValue;
3167 FRealizedDefColWidth := 0;
3168
3169 if EditorMode then
3170 ColRowToOffset(True, True, FCol, OldLeft, OldRight);
3171
3172 ResetDefaultColWidths;
3173
3174 if EditorMode then begin
3175 ColRowToOffset(True, True, FCol, NewLeft, NewRight);
3176 if (NewLeft<>OldLeft) or (NewRight<>OldRight) then
3177 EditorWidthChanged(FCol, GetColWidths(FCol));
3178 end;
3179 end;
3180
3181 procedure TCustomGrid.SetDefRowHeight(AValue: Integer);
3182 var
3183 i: Integer;
3184 OldTop,OldBottom,NewTop,NewBottom: Integer;
3185 begin
3186 if (AValue<>fDefRowHeight) or (csLoading in ComponentState) then
3187 begin
3188 FDefRowheight:=AValue;
3189 FRealizedDefRowHeight := 0;
3190
3191 if EditorMode then
3192 ColRowToOffSet(False,True, FRow, OldTop, OldBottom);
3193
3194 for i:=0 to RowCount-1 do
3195 FRows[i] := -1;
3196 VisualChange;
3197
3198 if EditorMode then
3199 begin
3200 ColRowToOffSet(False,True, FRow, NewTop, NewBottom);
3201 if (NewTop<>OldTOp) or (NewBottom<>OldBottom) then
3202 EditorPos;
3203 end;
3204 end;
3205 end;
3206
3207 procedure TCustomGrid.SetCol(AValue: Integer);
3208 begin
3209 if AValue=FCol then Exit;
3210 if not AllowOutboundEvents then
3211 CheckLimitsWithError(AValue, FRow);
3212 MoveExtend(False, AValue, FRow, True);
3213 Click;
3214 end;
3215
3216 procedure TCustomGrid.SetRangeSelectMode(const AValue: TRangeSelectMode);
3217 begin
3218 if FRangeSelectMode=AValue then exit;
3219 FRangeSelectMode := AValue;
3220 ClearSelections;
3221 end;
3222
3223 procedure TCustomGrid.SetRow(AValue: Integer);
3224 begin
3225 if AValue=FRow then Exit;
3226 if not AllowOutBoundEvents then
3227 CheckLimitsWithError(FCol, AValue);
3228 MoveExtend(False, FCol, AValue, True);
3229 Click;
3230 end;
3231
3232 procedure TCustomGrid.Sort(ColSorting: Boolean; index, IndxFrom, IndxTo: Integer);
3233 procedure QuickSort(L,R: Integer);
3234 var
3235 I,J: Integer;
3236 P{,Q}: Integer;
3237 begin
3238 repeat
3239 I:=L;
3240 J:=R;
3241 P:=(L+R) div 2;
3242 repeat
3243 if ColSorting then begin
3244 while DoCompareCells(index, P, index, I)>0 do I:=I+1;
3245 while DoCompareCells(index, P, index, J)<0 do J:=J-1;
3246 end else begin
3247 while DoCompareCells(P, index, I, index)>0 do I:=I+1;
3248 while DoCompareCells(P, index, J, index)<0 do J:=J-1;
3249 end;
3250 if I<=J then begin
3251
3252 if I<>J then
3253 if not FStrictSort or
3254 (ColSorting and (DoCompareCells(index, I, index, J)<>0)) or
3255 (not ColSorting and (DoCompareCells(I, index, J, index)<>0))
3256 then
3257 DoOPExchangeColRow(not ColSorting, I,J);
3258
3259 if P=I then
3260 P:=J
3261 else if P=J then
3262 P:=I;
3263
3264 I:=I+1;
3265 J:=J-1;
3266 end;
3267 until I>J;
3268
3269 if L<J then
3270 QuickSort(L,J);
3271
3272 L:=I;
3273 until I>=R;
3274 end;
3275 begin
3276 if RowCount>FixedRows then begin
3277 CheckIndex(ColSorting, Index);
3278 CheckIndex(not ColSorting, IndxFrom);
3279 CheckIndex(not ColSorting, IndxTo);
3280 BeginUpdate;
3281 QuickSort(IndxFrom, IndxTo);
3282 EndUpdate;
3283 end;
3284 end;
3285
3286 procedure TCustomGrid.HideSortArrow;
3287 begin
3288 FSortColumn := -1;
3289 InvalidateGrid;
3290 end;
3291
3292 procedure TCustomGrid.doTopleftChange(DimChg: Boolean);
3293 begin
3294 TopLeftChanged;
3295 VisualChange;
3296 end;
3297
3298 procedure TCustomGrid.DrawXORVertLine(X: Integer);
3299 var
3300 OldPenMode: TPenMode;
3301 OldPenColor: TColor;
3302 begin
3303 OldPenMode := Canvas.Pen.Mode;
3304 OldPenColor := Canvas.Pen.Color;
3305 Canvas.Pen.Color := clWhite;
3306 Canvas.Pen.Mode := pmXOR;
3307 Canvas.MoveTo(X,0);
3308 Canvas.LineTo(X,FGCache.MaxClientXY.Y);
3309 Canvas.Pen.Mode := OldPenMode;
3310 Canvas.Pen.Color := OldPenColor;
3311 end;
3312
3313 procedure TCustomGrid.DrawXORHorzLine(Y: Integer);
3314 var
3315 OldPenMode: TPenMode;
3316 OldPenColor: TColor;
3317 begin
3318 OldPenMode := Canvas.Pen.Mode;
3319 OldPenColor := Canvas.Pen.Color;
3320 Canvas.Pen.Color := clWhite;
3321 Canvas.Pen.Mode := pmXOR;
3322 if UseRightToLeftAlignment then begin
3323 Canvas.MoveTo(FlipX(FGCache.MaxClientXY.X)+1,Y);
3324 Canvas.LineTo(FGCache.ClientRect.Right,Y);
3325 end
3326 else begin
3327 Canvas.MoveTo(0,Y);
3328 Canvas.LineTo(FGCache.MaxClientXY.X,Y);
3329 end;
3330 Canvas.Pen.Mode := OldPenMode;
3331 Canvas.Pen.Color := OldPenColor;
3332 end;
3333
3334 procedure TCustomGrid.VisualChange;
3335 begin
3336 if (FUpdateCount<>0) then
3337 exit;
3338
3339 {$ifdef DbgVisualChange}
3340 DebugLn('TCustomGrid.VisualChange INIT ',DbgSName(Self));
3341 {$endif}
3342
3343 UpdateSizes;
3344
3345 Invalidate;
3346 {$ifdef DbgVisualChange}
3347 DebugLn('TCustomGrid.VisualChange END ',DbgSName(Self));
3348 {$endif}
3349 end;
3350
3351 procedure TCustomGrid.ResetSizes;
3352 begin
3353 //DebugLn('TCustomGrid.VisualChange ',DbgSName(Self));
3354 if (FCols=nil) or ([csLoading,csDestroying]*ComponentState<>[])
3355 or (not HandleAllocated) then
3356 exit; // not yet initialized or already destroyed
3357
3358 UpdateCachedSizes;
3359 CheckNewCachedSizes(FGCache);
3360 CacheVisibleGrid;
3361 {$Ifdef DbgVisualChange}
3362 DebugLn('TCustomGrid.ResetSizes %s Width=%d Height=%d',[DbgSName(Self),Width,Height]);
3363 DebugLn(' Cache: ClientWidth=%d ClientHeight=%d GWidth=%d GHeight=%d',
3364 [FGCAche.ClientWidth, FGCache.ClientHeight,FGCache.GridWidth, FGCache.GridHeight]);
3365 DebugLn(' Reald: ClientWidth=%d ClientHeight=%d',[ClientWidth, ClientHeight]);
3366 DebugLn(' MaxTopLeft',dbgs(FGCache.MaxTopLeft));
3367 {$Endif}
3368 end;
3369
3370 procedure TCustomGrid.CreateParams(var Params: TCreateParams);
3371 const
3372 ClassStylesOff = CS_VREDRAW or CS_HREDRAW;
3373 begin
3374 inherited CreateParams(Params);
3375 with Params do begin
3376 WindowClass.Style := WindowClass.Style and DWORD(not ClassStylesOff);
3377 Style := Style or WS_VSCROLL or WS_HSCROLL or WS_CLIPCHILDREN;
3378 end;
3379 end;
3380
3381 procedure TCustomGrid.Click;
3382 begin
3383 {$IFDEF dbgGrid} DebugLn('FIgnoreClick=', dbgs(FIgnoreClick)); {$ENDIF}
3384 if not FIgnoreClick then
3385 inherited Click;
3386 end;
3387
3388 procedure TCustomGrid.ScrollBarRange(Which: Integer; aRange,aPage,aPos: Integer);
3389 var
3390 ScrollInfo: TScrollInfo;
3391 begin
3392 if HandleAllocated then begin
3393 {$Ifdef DbgScroll}
3394 DebugLn('ScrollbarRange: Which=%s Range=%d Page=%d Pos=%d',
3395 [SbToStr(Which),aRange,aPage,aPos]);
3396 {$endif}
3397 FillChar(ScrollInfo, SizeOf(ScrollInfo), 0);
3398 ScrollInfo.cbSize := SizeOf(ScrollInfo);
3399 ScrollInfo.fMask := SIF_RANGE or SIF_PAGE or SIF_DISABLENOSCROLL;
3400 if not (gfPainting in FGridFlags) then
3401 ScrollInfo.fMask := ScrollInfo.fMask or SIF_POS;
3402 {$ifdef Unix}
3403 ScrollInfo.fMask := ScrollInfo.fMask or SIF_UPDATEPOLICY;
3404 if goThumbTracking in Options then
3405 ScrollInfo.ntrackPos := SB_POLICY_CONTINUOUS
3406 else
3407 ScrollInfo.ntrackPos := SB_POLICY_DISCONTINUOUS;
3408 {$endif}
3409 ScrollInfo.nMin := 0;
3410 ScrollInfo.nMax := aRange;
3411 ScrollInfo.nPos := aPos;
3412 if APage<0 then
3413 APage := 0;
3414 ScrollInfo.nPage := APage;
3415 if (Which=SB_HORZ) and UseRightToLeftAlignment then begin
3416 ScrollInfo.nPos := ScrollInfo.nMax-ScrollInfo.nPage-ScrollInfo.nPos;
3417 {$Ifdef DbgScroll}
3418 DebugLn('ScrollbarRange: RTL nPos=%d',[ScrollInfo.nPos]);
3419 {$endif}
3420 end;
3421 SetScrollInfo(Handle, Which, ScrollInfo, True);
3422 end;
3423 end;
3424
3425 procedure TCustomGrid.ScrollBarPosition(Which, Value: integer);
3426 var
3427 ScrollInfo: TScrollInfo;
3428 Vis: Boolean;
3429 begin
3430 if HandleAllocated then begin
3431 {$Ifdef DbgScroll}
3432 DebugLn('ScrollbarPosition: Which=',SbToStr(Which), ' Value= ',IntToStr(Value));
3433 {$endif}
3434 Vis := ScrollBarIsVisible(Which);
3435 FillChar(ScrollInfo, SizeOf(ScrollInfo), 0);
3436 ScrollInfo.cbSize := SizeOf(ScrollInfo);
3437 if (Which=SB_HORZ) and Vis and UseRightToLeftAlignment then begin
3438 ScrollInfo.fMask := SIF_PAGE or SIF_RANGE;
3439 GetScrollInfo(Handle, SB_HORZ, ScrollInfo);
3440 Value := (ScrollInfo.nMax-ScrollInfo.nPage)-Value;
3441 {$Ifdef DbgScroll}
3442 DebugLn('ScrollbarPosition: Which=',SbToStr(Which), ' RTL Value= ',IntToStr(Value));
3443 {$endif}
3444 end;
3445 ScrollInfo.fMask := SIF_POS;
3446 ScrollInfo.nPos:= Value;
3447 SetScrollInfo(Handle, Which, ScrollInfo, Vis);
3448 end;
3449 end;
3450
TCustomGrid.ScrollBarIsVisiblenull3451 function TCustomGrid.ScrollBarIsVisible(Which: Integer): Boolean;
3452 begin
3453 Result:=false;
3454 if HandleAllocated then begin
3455 // Don't use GetScrollbarvisible from the widgetset - it sends WM_PAINT message (Gtk2). Issue #30160
3456 if Which = SB_VERT then result := (FVSbVisible=1) else
3457 if Which = SB_HORZ then result := (FHsbVisible=1) else
3458 if Which = SB_BOTH then result := (FVSbVisible=1) and (FHsbVisible=1);
3459 end;
3460 end;
3461
3462 procedure TCustomGrid.ScrollBarPage(Which: Integer; aPage: Integer);
3463 var
3464 ScrollInfo: TScrollInfo;
3465 begin
3466 if HandleAllocated then begin
3467 {$Ifdef DbgScroll}
3468 DebugLn('Scrollbar Page: Which=',SbToStr(Which), ' Avalue=',dbgs(aPage));
3469 {$endif}
3470 ScrollInfo.cbSize := SizeOf(ScrollInfo);
3471 ScrollInfo.fMask := SIF_PAGE;
3472 ScrollInfo.nPage:= aPage;
3473 SetScrollInfo(Handle, Which, ScrollInfo, True);
3474 end;
3475 end;
3476
3477 procedure TCustomGrid.ScrollBarShow(Which: Integer; aValue: boolean);
3478 begin
3479 if HandleAllocated then begin
3480 {$Ifdef DbgScroll}
3481 DebugLn('ScrollbarShow: Which=',SbToStr(Which), ' Avalue=',dbgs(AValue));
3482 {$endif}
3483 Include(FGridFlags, gfUpdatingScrollbar);
3484 try
3485 ShowScrollBar(Handle,Which,aValue);
3486 finally
3487 Exclude(FGridFlags, gfUpdatingScrollbar);
3488 end;
3489 if Which in [SB_BOTH, SB_VERT] then FVSbVisible := Ord(AValue);
3490 if Which in [SB_BOTH, SB_HORZ] then FHSbVisible := Ord(AValue);
3491 end;
3492 end;
3493
3494 procedure TCustomGrid.ScrollBy(DeltaX, DeltaY: Integer);
3495 var
3496 ClipArea: TRect;
3497 ScrollFlags: Integer;
3498 begin
3499 if (DeltaX=0) and (DeltaY=0) then
3500 Exit;
3501
3502 ScrollFlags := SW_INVALIDATE or SW_ERASE;
3503 if DeltaX<>0 then
3504 begin
3505 ClipArea := ClientRect;
3506 if Flat then
3507 InflateRect(ClipArea, -1, -1);
3508 if BiDiMode <> bdRightToLeft then
3509 Inc(ClipArea.Left, FGCache.FixedWidth)
3510 else
3511 Dec(ClipArea.Right, FGCache.FixedWidth);
3512 ScrollWindowEx(Handle, DeltaX, 0, @ClipArea, @ClipArea, 0, nil, ScrollFlags);
3513 end;
3514 if DeltaY<>0 then
3515 begin
3516 ClipArea := ClientRect;
3517 if Flat then
3518 InflateRect(ClipArea, -1, -1);
3519 Inc(ClipArea.Top, FGCache.FixedHeight);
3520 ScrollWindowEx(Handle, 0, DeltaY, @ClipArea, @ClipArea, 0, nil, ScrollFlags);
3521 end;
3522
3523 CacheVisibleGrid;
3524 CalcScrollbarsRange;
3525 end;
3526
ScrollBarAutomaticnull3527 function TCustomGrid.ScrollBarAutomatic(Which: TScrollStyle): boolean;
3528 begin
3529 result:=false;
3530 if (Which=ssVertical)or(Which=ssHorizontal) then begin
3531 if Which=ssVertical then Which:=ssAutoVertical
3532 else Which:=ssAutoHorizontal;
3533 Result:= FScrollBars in [Which, ssAutoBoth];
3534 end;
3535 end;
3536
3537 // Returns a rectagle corresponding to a physical cell[aCol,aRow]
CellRectnull3538 function TCustomGrid.CellRect(ACol, ARow: Integer): TRect;
3539 var
3540 ok: Boolean;
3541 begin
3542 ok := ColRowToOffset(True, True, ACol, Result.Left, Result.Right);
3543 if ok then begin
3544 ok := ColRowToOffSet(False, True, ARow, Result.Top, Result.Bottom);
3545 if ok and (goColSpanning in Options) then
3546 CalcCellExtent(ACol, ARow, Result);
3547 end;
3548
3549 if not ok then
3550 Result:=Rect(0,0,0,0);
3551 end;
3552
3553 // The visible grid Depends on TopLeft and ClientWidht,ClientHeight,
3554 // Col/Row Count, So it Should be called inmediately after changing
3555 // those properties.
GetVisibleGridnull3556 function TCustomGrid.GetVisibleGrid: TRect;
3557 var
3558 W, H: Integer;
3559 begin
3560
3561 if (FTopLeft.X<0)or(FTopLeft.y<0)or(csLoading in ComponentState) then begin
3562 Result := Rect(0,0,-1,-1);
3563 FGCache.MaxClientXY := point(0,0);
3564 Exit;
3565 end;
3566 // visible TopLeft Cell
3567 Result.TopLeft:=fTopLeft;
3568 Result.BottomRight:=Result.TopLeft;
3569
3570 // Left Margin of next visible Column and Rightmost visible cell
3571 if ColCount>FixedCols then begin
3572 W:=GetColWidths(Result.Left) + FGCache.FixedWidth;
3573 if GetSmoothScroll(SB_Horz) then
3574 W := W - FGCache.TLColOff;
3575 while (Result.Right<ColCount-1)and(W<FGCache.ClientWidth) do begin
3576 Inc(Result.Right);
3577 W:=W+GetColWidths(Result.Right);
3578 end;
3579 FGCache.MaxClientXY.X := W;
3580 end else begin
3581 FGCache.MaxClientXY.X := FGCache.FixedWidth;
3582 Result.Right := Result.Left - 1; // no visible cells here
3583 end;
3584
3585 // Top Margin of next visible Row and Bottom most visible cell
3586 if RowCount>FixedRows then begin
3587 H:=GetRowheights(Result.Top) + FGCache.FixedHeight;
3588 if GetSmoothScroll(SB_Vert) then
3589 H := H - FGCache.TLRowOff;
3590 while (Result.Bottom<RowCount-1)and(H<FGCache.ClientHeight) do begin
3591 Inc(Result.Bottom);
3592 H:=H+GetRowHeights(Result.Bottom);
3593 end;
3594 FGCache.MaxClientXY.Y := H;
3595 end else begin
3596 FGCache.MaxClientXY.Y := FGCache.FixedHeight;
3597 Result.Bottom := Result.Top - 1; // no visible cells here
3598 end;
3599 end;
3600
3601 { Scroll the grid until cell[aCol,aRow] is shown }
ScrollToCellnull3602 function TCustomGrid.ScrollToCell(const aCol, aRow: Integer;
3603 const ForceFullyVisible: Boolean): Boolean;
3604 var
3605 RNew, RNewStored: TRect;
3606 OldTopLeft:TPoint;
3607 Xinc,YInc: Integer;
3608 CHeight,CWidth: Integer;
3609 TLRowOffChanged, TLColOffChanged: Boolean;
3610 begin
3611 OldTopLeft:=fTopLeft;
3612 TLRowOffChanged:=False;
3613 TLColOffChanged:=False;
3614
3615 CHeight := FGCache.ClientHeight + GetBorderWidth;
3616 CWidth := FGCache.ClientWidth + GetBorderWidth;
3617
3618 {$IFDEF dbgGridScroll}
3619 DebugLn('aCol=%d aRow=%d FixHeight=%d CHeight=%d FixWidth=%d CWidth=%d',
3620 [aCol,aRow,FGCache.FixedHeight,CHeight, FGCache.FixedWidth, CWidth]);
3621 {$Endif}
3622
3623 while IsColumnIndexValid(fTopLeft.x) and
3624 IsRowIndexValid(fTopLeft.y) do
3625 begin
3626 RNew:=CellRect(aCol,aRow);
3627 if UseRightToLeftAlignment then begin
3628 XInc := RNew.Right;
3629 RNew.Right := FlipX(RNew.Left)+1;
3630 RNew.Left := FlipX(XInc)+1;
3631 end;
3632 RNewStored := RNew;
3633
3634 Xinc := 0;
3635 if RNew.Right <= FGCache.FixedWidth+GetBorderWidth then
3636 Xinc := -1 // hidden at the left of fixedwidth line
3637 else
3638 if (RNew.Left > FGCache.FixedWidth+GetBorderWidth) and (RNew.Left >= CWidth) and not GetSmoothScroll(SB_Horz) then
3639 Xinc := 1 // hidden at the right of clientwidth line
3640 else
3641 if (RNew.Left > FGCache.FixedWidth+GetBorderWidth) and
3642 (CWidth < RNew.Right) and
3643 (not (goDontScrollPartCell in Options) or ForceFullyVisible) then
3644 begin // hidden / partially visible at the right
3645 if not GetSmoothScroll(SB_Horz) then
3646 Xinc := 1
3647 else
3648 begin
3649 Inc(FGCache.TLColOff, RNew.Right-CWidth); // support smooth scroll
3650 TLColOffChanged := True;
3651 end;
3652 end;
3653
3654 Yinc := 0;
3655 if RNew.Bottom <= FGCache.FixedHeight+GetBorderWidth then
3656 Yinc := -1 // hidden at the top of fixedheight line
3657 else
3658 if (RNew.Top > FGCache.FixedHeight+GetBorderWidth) and (RNew.Top >= CHeight) and not GetSmoothScroll(SB_Vert) then
3659 YInc := 1 // hidden at the bottom of clientheight line
3660 else
3661 if (RNew.Top > FGCache.FixedHeight+GetBorderWidth) and
3662 (CHeight < RNew.Bottom) and
3663 (not (goDontScrollPartCell in Options) or ForceFullyVisible) then
3664 begin // hidden / partially visible at bottom
3665 if not GetSmoothScroll(SB_Vert) then
3666 Yinc := 1
3667 else
3668 begin
3669 Inc(FGCache.TLRowOff, RNew.Bottom-CHeight); // support smooth scroll
3670 TLRowOffChanged := True;
3671 end;
3672 end;
3673
3674 {$IFDEF dbgGridScroll}
3675 with FTopLeft,RNew,FGCache do
3676 DebugLn(' TL.C=%d TL.R=%d RNew:L=%d T=%d R=%d B=%d Xinc=%d YInc=%d ColOff=%d RowOff=%d',
3677 [X,Y,Left,Top,Right,Bottom,XInc,YInc,TLColOff,TLRowOff]);
3678 {$ENDIF}
3679
3680 if ((XInc=0)and(YInc=0)) or // the cell is already visible
3681 ((FTopLeft.X=aCol)and(FTopLeft.Y=aRow)) or // the cell is visible by definition
3682 not IsColumnIndexValid(FTopLeft.X+XInc) or
3683 not IsRowIndexValid(FTopLeft.Y+YInc)
3684 then
3685 Break;
3686 Inc(FTopLeft.x, XInc);
3687 if XInc<>0 then
3688 FGCache.TLColOff := 0; // cancel col-offset for next calcs
3689 Inc(FTopLeft.y, YInc);
3690 if YInc<>0 then
3691 FGCache.TLRowOff := 0; // cancel row-offset for next calcs
3692 end;
3693
3694 // fix offsets
3695 while (FTopLeft.x < ColCount-1) and (FGCache.TLColOff > ColWidths[FTopLeft.x]) do
3696 begin
3697 Dec(FGCache.TLColOff, ColWidths[FTopLeft.x]);
3698 Inc(FTopLeft.x);
3699 TLColOffChanged := True;
3700 end;
3701 while (FTopLeft.y < RowCount-1) and (FGCache.TLRowOff > RowHeights[FTopLeft.y]) do
3702 begin
3703 Dec(FGCache.TLRowOff, RowHeights[FTopLeft.y]);
3704 Inc(FTopLeft.y);
3705 TLRowOffChanged := True;
3706 end;
3707
3708 Result:=not PointIgual(OldTopleft,FTopLeft)
3709 or TLColOffChanged or TLRowOffChanged;
3710
3711 BeginUpdate;
3712 try
3713 if Result then begin
3714 if not PointIgual(OldTopleft,FTopLeft) then
3715 doTopleftChange(False)
3716 else
3717 VisualChange;
3718 end;
3719 if not (goDontScrollPartCell in Options) or ForceFullyVisible then
3720 begin
3721 RNew := RNewStored;
3722 if ResetOffset(
3723 not GetSmoothScroll(SB_Horz) or
3724 (RNew.Left < FGCache.FixedWidth+GetBorderWidth), // partially visible on left
3725 (not GetSmoothScroll(SB_Vert) or
3726 (RNew.Top < FGCache.FixedHeight+GetBorderWidth))) // partially visible on top
3727 then
3728 Result := True;
3729 end;
3730 finally
3731 EndUpdate(Result);
3732 end;
3733 end;
3734
3735 {Returns a valid TopLeft from a proposed TopLeft[DCol,DRow] which are
3736 relative or absolute coordinates }
ScrollGridnull3737 function TCustomGrid.ScrollGrid(Relative: Boolean; DCol, DRow: Integer): TPoint;
3738 begin
3739 Result:=FTopLeft;
3740 if not Relative then begin
3741 DCol:=DCol-Result.x;
3742 DRow:=DRow-Result.y;
3743 end;
3744
3745 if DCol<>0 then begin
3746 if DCol+Result.x<FFixedCols then DCol:=Result.x-FFixedCols else
3747 if DCol+Result.x>ColCount-1 then DCol:=ColCount-1-Result.x;
3748 end;
3749 if DRow<>0 then begin
3750 if DRow+Result.y<FFixedRows then DRow:=Result.y-FFixedRows else
3751 if DRow+Result.y>RowCount-1 then DRow:=RowCount-1-Result.y;
3752 end;
3753
3754 Inc(Result.x, DCol);
3755 Inc(Result.y, DRow);
3756
3757 Result.x := Max(FixedCols, Min(Result.x, FGCache.MaxTopLeft.x));
3758 Result.y := Max(FixedRows, Min(Result.y, FGCache.MaxTopLeft.y));
3759 end;
3760
3761 procedure TCustomGrid.TopLeftChanged;
3762 begin
3763 if Assigned(OnTopLeftChanged) and not (csDesigning in ComponentState) then
3764 OnTopLeftChanged(Self);
3765 end;
3766
3767 procedure TCustomGrid.HeaderClick(IsColumn: Boolean; index: Integer);
3768 var
3769 ColOfs: Integer;
3770 begin
3771 if IsColumn and FColumnClickSorts then begin
3772 // Determine the sort order.
3773 if index = FSortColumn then begin
3774 case FSortOrder of // Same column clicked again -> invert the order.
3775 soAscending: FSortOrder:=soDescending;
3776 soDescending: FSortOrder:=soAscending;
3777 end;
3778 end
3779 else
3780 FSortOrder := soAscending; // Ascending order to start with.
3781
3782 FSortColumn := index;
3783 Sort(True, index, FFixedRows, RowCount-1);
3784 end;
3785 end;
3786
3787 procedure TCustomGrid.HeaderSized(IsColumn: Boolean; index: Integer);
3788 begin
3789 end;
3790
3791 procedure TCustomGrid.ColRowMoved(IsColumn: Boolean; FromIndex,ToIndex: Integer);
3792 begin
3793 end;
3794
3795 // Notification to inform derived grids to exchange their actual rows data
3796 procedure TCustomGrid.ColRowExchanged(IsColumn: Boolean; index, WithIndex: Integer);
3797 begin
3798 end;
3799
3800 procedure TCustomGrid.ColRowInserted(IsColumn: boolean; index: integer);
3801 begin
3802 end;
3803
3804 procedure TCustomGrid.DrawFocusRect(aCol, aRow: Integer; ARect: TRect);
3805 begin
3806 end;
3807
3808 procedure TCustomGrid.AutoAdjustColumn(aCol: Integer);
3809 begin
3810 end;
3811
3812 procedure TCustomGrid.SizeChanged(OldColCount, OldRowCount: Integer);
3813 begin
3814 end;
3815
3816 procedure TCustomGrid.ColRowDeleted(IsColumn: Boolean; index: Integer);
3817 begin
3818 end;
3819
CanEditShownull3820 function TCustomGrid.CanEditShow: Boolean;
3821 begin
3822 Result := EditingAllowed(FCol) and not (csDesigning in ComponentState)
3823 and CanFocus;
3824 end;
3825
3826 procedure TCustomGrid.Paint;
3827 {$ifdef DbgPaint}
3828 var
3829 R: TRect;
3830 {$endif}
3831 begin
3832 //
3833 {$ifdef DbgPaint}
3834 R := Canvas.ClipRect;
3835 DebugLn('TCustomGrid.Paint %s Row=%d Clip=%s',[DbgSName(Self),Row,Dbgs(R)]);
3836 {$endif}
3837 if ([gfVisualChange,gfClientRectChange]*fGridFlags<>[]) or
3838 (ClientWidth<>FGCache.ClientWidth) or
3839 (ClientHeight<>FGCache.ClientHeight) then begin
3840 {$ifdef DbgVisualChange}
3841 DebugLnEnter('Resetting Sizes in Paint INIT');
3842 {$endif}
3843 FGridFlags := FGridFlags + [gfPainting];
3844 ResetSizes;
3845 FGridFlags := FGridFlags - [gfVisualChange, gfPainting, gfClientRectChange];
3846 {$ifdef DbgVisualChange}
3847 DebugLnExit('Resetting Sizes in Paint DONE');
3848 {$endif}
3849 end;
3850 inherited Paint;
3851 if FUpdateCount=0 then begin
3852 DrawEdges;
3853 DrawAllRows;
3854 DrawColRowMoving;
3855 DrawBorder;
3856 end;
3857 end;
3858
3859 procedure TCustomGrid.PickListItemSelected(Sender: TObject);
3860 begin
3861 if Assigned(OnPickListSelect) then
3862 OnPickListSelect(Self);
3863 end;
3864
3865 procedure TCustomGrid.PrepareCanvas(aCol, aRow: Integer; aState: TGridDrawState);
3866 function GetNotSelectedColor: TColor;
3867 begin
3868 Result := GetColumnColor(aCol, gdFixed in AState);
3869 if (gdFixed in AState) and (gdHot in aState) then
3870 Result := FFixedHotColor;
3871 if not (gdFixed in AState) and (FAlternateColor<>Result) then begin
3872 if Result=Color then begin
3873 // column color = grid Color, Allow override color
3874 // 1. default color after fixed rows
3875 // 2. always use absolute alternate color based in odd & even row
3876 if (FAltColorStartNormal and Odd(ARow-FixedRows)) {(1)} or
3877 (not FAltColorStartNormal and Odd(ARow)) {(2)} then
3878 Result := FAlternateColor;
3879 end;
3880 end;
3881 if (gdRowHighlight in aState) and not (gdFixed in AState) then
3882 Result := ColorToRGB(Result) xor $1F1F1F
3883 end;
3884 var
3885 AColor: TColor;
3886 CurrentTextStyle: TTextStyle;
3887 IsSelected: boolean;
3888 gc: TGridColumn;
3889 begin
3890 if (gdFixed in aState) or DefaultDrawing then begin
3891 Canvas.Pen.Mode := pmCopy;
3892 GetSelectedState(aState, IsSelected);
3893 if IsSelected then begin
3894 if FEditorMode and (aCol = Self.Col)
3895 and (((FEditor=FStringEditor) and (FStringEditor.BorderStyle=bsNone))
3896 or (FEditor=FButtonStringEditor))
3897 then
3898 Canvas.Brush.Color := FEditor.Color
3899 else if FEditorMode and (aCol = Self.Col) and (FEditor=FPicklistEditor) then
3900 Canvas.Brush.Color := GetNotSelectedColor
3901 else
3902 Canvas.Brush.Color := SelectedColor;
3903 SetCanvasFont(GetColumnFont(aCol, False));
3904 if not IsCellButtonColumn(point(aCol,aRow)) then
3905 Canvas.Font.Color := clHighlightText;
3906 FLastFont:=nil;
3907 end else begin
3908 Canvas.Brush.Color := GetNotSelectedColor;
3909 SetCanvasFont(GetColumnFont(aCol, ((gdFixed in aState) and (aRow < FFixedRows))));
3910 end;
3911 if not Enabled and (FDisabledFontColor<>clNone) then
3912 Canvas.Font.Color := FDisabledFontColor;
3913 CurrentTextStyle := DefaultTextStyle;
3914 CurrentTextStyle.Alignment := BidiFlipAlignment(GetColumnAlignment(aCol, gdFixed in AState), UseRightToLeftAlignment);
3915 CurrentTextStyle.Layout := GetColumnLayout(aCol, gdFixed in AState);
3916 CurrentTextStyle.ShowPrefix := ((gdFixed in aState) and (aRow < FFixedRows)) and GetTitleShowPrefix(aCol);
3917 CurrentTextStyle.RightToLeft := UseRightToLeftReading;
3918 CurrentTextStyle.EndEllipsis := (goCellEllipsis in Options);
3919 gc := ColumnFromGridColumn(aCol);
3920 CurrentTextStyle.SingleLine := (gc = nil) or (not gc.Title.MultiLine);
3921 Canvas.TextStyle := CurrentTextStyle;
3922 end else begin
3923 CurrentTextStyle := DefaultTextStyle;
3924 CurrentTextStyle.Alignment := BidiFlipAlignment(CurrentTextStyle.Alignment, UseRightToLeftAlignment);
3925 CurrentTextStyle.RightToLeft := UseRightToLeftAlignment;
3926 Canvas.TextStyle := CurrentTextStyle;
3927 Canvas.Brush.Color := clWindow;
3928 Canvas.Font.Color := clWindowText;
3929 end;
3930
3931 DoPrepareCanvas(aCol, aRow, aState);
3932 end;
3933
3934 procedure TCustomGrid.PrepareCellHints(ACol, ARow: Integer);
3935 begin
3936 end;
3937
3938 procedure TCustomGrid.ResetDefaultColWidths;
3939 var
3940 i: Integer;
3941 begin
3942 if not AutoFillColumns then begin
3943 for i:=0 to ColCount-1 do
3944 FCols[i] := -1;
3945 VisualChange;
3946 end;
3947 end;
3948
3949 procedure TCustomGrid.UnprepareCellHints;
3950 begin
3951 end;
3952
3953 procedure TCustomGrid.ResetEditor;
3954 begin
3955 EditorGetValue(True);
3956 if EditorAlwaysShown then
3957 EditorShow(True);
3958 end;
3959
3960 // Reset the last Row or Col movement
3961 procedure TCustomGrid.ResetLastMove;
3962 begin
3963 FMoveLast:=Point(-1,-1);
3964 end;
3965
3966 procedure TCustomGrid.ResetHotCell;
3967 begin
3968 with FGCache do begin
3969 if HotCellPainted and IsColumnIndexValid(HotCell.x) and IsRowIndexValid(HotCell.y) then
3970 InvalidateCell(HotCell.X, HotCell.Y);
3971 HotCell := Point(-1,-1);
3972 HotCellPainted := False;
3973 HotGridZone := gzInvalid;
3974 end;
3975 end;
3976
3977 procedure TCustomGrid.ResetPushedCell(ResetColRow: boolean=True);
3978 begin
3979 with FGCache do begin
3980 if ClickCellPushed then
3981 InvalidateCell(PushedCell.X, PushedCell.Y);
3982 if ResetColRow then
3983 PushedCell := Point(-1,-1);
3984 ClickCellPushed := False;
3985 end;
3986 end;
3987
ResetOffsetnull3988 function TCustomGrid.ResetOffset(chkCol, ChkRow: Boolean): Boolean;
3989 begin
3990 if ChkCol then ChkCol:=FGCache.TLColOff<>0;
3991 if ChkCol then FGCache.TlColOff:=0;
3992 if ChkRow then ChkRow:=FGCache.TLRowOff<>0;
3993 if ChkRow then FGCache.TlRowOff:=0;
3994 Result := ChkRow or ChkCol;
3995 if Result then
3996 begin
3997 CacheVisibleGrid;
3998 VisualChange;
3999 end;
4000 end;
4001
4002 procedure TCustomGrid.ResizeColumn(aCol, aWidth: Integer);
4003 begin
4004 if aWidth<0 then
4005 aWidth:=0;
4006 ColWidths[aCol] := aWidth;
4007 end;
4008
4009 procedure TCustomGrid.ResizeRow(aRow, aHeight: Integer);
4010 begin
4011 if aHeight<0 then
4012 aHeight:=0;
4013 RowHeights[aRow] := aHeight;
4014 end;
4015
4016 procedure TCustomGrid.HeaderSizing(const IsColumn: boolean; const AIndex,
4017 ASize: Integer);
4018 begin
4019 end;
4020
4021 procedure TCustomGrid.ShowCellHintWindow(APoint: TPoint);
4022 var
4023 cell: TPoint;
4024 txt1, txt2, txt, AppHint: String;
4025 w: Integer;
4026 gds: TGridDrawState;
4027
4028 procedure AddToHint(var AHint: String; const ANew: String);
4029 begin
4030 if ANew = '' then
4031 exit;
4032 if AHint = '' then AHint := ANew else AHint := AHint + LineEnding + ANew;
4033 end;
4034
4035 begin
4036 if not ShowHint then
4037 exit;
4038
4039 cell := MouseToCell(APoint);
4040 if (cell.x = -1) or (cell.y = -1) then
4041 exit;
4042
4043 txt1 := ''; // Hint returned by OnGetCellHint
4044 txt2 := ''; // Hint returned by GetTruncCellHintText
4045 AppHint := ''; // Hint to be displayed in Statusbar
4046 txt := ''; // Hint to be displayed as popup
4047 PrepareCellHints(cell.x, cell.y); // in DBGrid, set the active record to cell.y
4048 try
4049 if (goCellHints in Options) and (FCellHintPriority <> chpTruncOnly) then
4050 txt1 := GetCellHintText(cell.x, cell.y);
4051 if (goTruncCellHints in Options) then begin
4052 txt2 := GetTruncCellHintText(cell.x, cell.y);
4053 gds := GetGridDrawState(cell.x, cell.y);
4054 PrepareCanvas(cell.x, cell.y, gds);
4055 w := Canvas.TextWidth(txt2) + varCellPadding*2;
4056 if w < ColWidths[cell.x] then
4057 txt2 := '';
4058 end;
4059 finally
4060 UnprepareCellHints;
4061 end;
4062
4063 case FCellHintPriority of
4064 chpAll:
4065 begin
4066 AddToHint(txt, GetShortHint(FSavedHint));
4067 AddToHint(txt, GetShortHint(txt1));
4068 AddToHint(txt, txt2);
4069 AddToHint(AppHint, GetLongHint(FSavedHint));
4070 AddToHint(AppHint, GetLongHint(txt1));
4071 end;
4072 chpAllNoDefault:
4073 begin
4074 AddToHint(txt, GetShortHint(txt1));
4075 AddToHint(txt, txt2);
4076 AddToHint(AppHint, GetLongHint(txt1));
4077 end;
4078 chpTruncOnly:
4079 begin
4080 AddToHint(txt, txt2);
4081 AppHint := txt;
4082 if Pos('|', AppHint) = 0 then
4083 AppHint := AppHint + '|';
4084 end;
4085 end;
4086
4087 (*
4088 if (txt = '') and (FSavedHint <> '') then
4089 txt := FSavedHint;
4090 if (AppHint = '') then AppHint := FSavedhint;
4091 *)
4092
4093 if not EditorMode and not (csDesigning in ComponentState) then begin
4094 Hint := txt;
4095 //set Application.Hint as well (issue #0026957)
4096 Application.Hint := GetLongHint(AppHint);
4097 Application.ActivateHint(APoint, true);
4098 end else
4099 HideCellHintWindow;
4100 end;
4101
4102 procedure TCustomGrid.HideCellHintWindow;
4103 begin
4104 Hint := FSavedHint;
4105 Application.CancelHint;
4106 end;
4107
4108 procedure TCustomGrid.StartPushCell;
4109 begin
4110 fGridState := gsButtonColumnClicking;
4111 DoPushCell;
4112 end;
4113
TitleFontIsStorednull4114 function TCustomGrid.TitleFontIsStored: Boolean;
4115 begin
4116 Result := not FTitleFontIsDefault;
4117 end;
4118
SelectCellnull4119 function TCustomGrid.SelectCell(ACol, ARow: Integer): Boolean;
4120 begin
4121 Result := (ColWidths[aCol] > 0) and (RowHeights[aRow] > 0);
4122 end;
4123
4124 procedure TCustomGrid.SetCanvasFont(aFont: TFont);
4125 begin
4126 if (aFont<>FLastFont) or
4127 not Canvas.Font.IsEqual(aFont) then
4128 begin
4129 Canvas.Font := aFont;
4130 FLastFont := AFont;
4131 end;
4132 end;
4133
4134 procedure TCustomGrid.SetColor(Value: TColor);
4135 begin
4136 if AlternateColor = Color then
4137 FAlternateColor := Value;
4138 inherited SetColor(Value);
4139 end;
4140
4141 procedure TCustomGrid.SetColRow(const ACol, ARow: Integer; withEvents: boolean);
4142 begin
4143 if withEvents then begin
4144 MoveExtend(false, aCol, aRow, true);
4145 Click;
4146 end else begin
4147 FCol := ACol;
4148 FRow := ARow;
4149 UpdateSelectionRange;
4150 end;
4151 end;
4152
4153 procedure TCustomGrid.SetCursor(AValue: TCursor);
4154 begin
4155 inherited;
4156 ChangeCursor(AValue);
4157 end;
4158
4159 procedure TCustomGrid.DrawBorder;
4160 var
4161 R: TRect;
4162 begin
4163 if InternalNeedBorder then begin
4164 R := Rect(0,0,ClientWidth-1, Clientheight-1);
4165 // The following line is a simple workaround for a more complex problem
4166 // caused by Canvas.SaveHandleState and Canvas.RestoreHandleState in DoDrawCell
4167 // see the notes in the related bug report #34890
4168 Canvas.Pen.Color := fBorderColor + 1;
4169 Canvas.Pen.Color := fBorderColor;
4170 Canvas.Pen.Width := 1;
4171 Canvas.MoveTo(0,0);
4172 Canvas.LineTo(0,R.Bottom);
4173 Canvas.LineTo(R.Right, R.Bottom);
4174 Canvas.LineTo(R.Right, 0);
4175 Canvas.LineTo(0,0);
4176 end;
4177 end;
4178
4179 procedure TCustomGrid.DrawColRowMoving;
4180 {$ifdef AlternativeMoveIndicator}
4181 var
4182 x, y, dx, dy: Integer;
4183 R: TRect;
4184 {$endif}
4185 begin
4186 if (FGridState=gsColMoving)and(fMoveLast.x>=0) then begin
4187 {$ifdef AlternativeMoveIndicator}
4188 dx := 4;
4189 dy := 4;
4190 Canvas.pen.Width := 1;
4191 Canvas.Pen.Color := clBlack;
4192 Canvas.Brush.Color := clWhite;
4193 R := CellRect(FMoveLast.X, 0);
4194 Y := R.Top + (R.Bottom-R.Top) div 2;
4195 X := R.Left - 2*dx;
4196 Canvas.Polygon([Point(x,y+dy),point(x,y-dy),point(x+dx,y), point(x,y+dy)]);
4197 X := R.Left + 2*dx;
4198 Canvas.Polygon([Point(x,y+dy),point(x,y-dy),point(x-dx,y), point(x,y+dy)]);
4199 {$else}
4200 Canvas.Pen.Width:=3;
4201 Canvas.Pen.Color:=FColRowDragIndicatorColor;
4202 Canvas.MoveTo(fMoveLast.y, 0);
4203 Canvas.Lineto(fMovelast.y, FGCache.MaxClientXY.Y);
4204 Canvas.Pen.Width:=1;
4205 {$endif}
4206 end else
4207 if (FGridState=gsRowMoving)and(FMoveLast.y>=0) then begin
4208 {$ifdef AlternativeMoveIndicator}
4209 dx := 4;
4210 dy := 4;
4211 Canvas.pen.Width := 1;
4212 Canvas.Pen.Color := clBlack;
4213 Canvas.Brush.Color := clWhite;
4214 R := CellRect(0, FMoveLast.Y);
4215 X := R.Left + (R.Right-R.Left) div 2;
4216 Y := R.Top - 2*dy;
4217 Canvas.Polygon([Point(x-dx,y),point(x+dx,y),point(x,y+dy), point(x-dx,y)]);
4218 Y := R.Top + 2*dy;
4219 Canvas.Polygon([Point(x-dx,y),point(x+dx,y),point(x,y-dy), point(x-dx,y)]);
4220 {$else}
4221 Canvas.Pen.Width:=3;
4222 Canvas.Pen.Color:=FColRowDragIndicatorColor;
4223 if UseRightToLeftAlignment then begin
4224 Canvas.MoveTo(FGCache.ClientRect.Right, FMoveLast.X);
4225 Canvas.LineTo(FlipX(FGCache.MaxClientXY.X), FMoveLast.X);
4226 end
4227 else begin
4228 Canvas.MoveTo(0, FMoveLast.X);
4229 Canvas.LineTo(FGCache.MaxClientXY.X, FMoveLast.X);
4230 end;
4231 Canvas.Pen.Width:=1;
4232 {$endif}
4233 end;
4234 end;
4235
4236 procedure TCustomGrid.DrawColumnText(aCol, aRow: Integer; aRect: TRect;
4237 aState: TGridDrawState);
4238 begin
4239 DrawColumnTitleImage(aRect, aCol);
4240 DrawCellText(aCol,aRow,aRect,aState,GetColumnTitle(aCol))
4241 end;
4242
4243 procedure TCustomGrid.DrawColumnTitleImage(
4244 var ARect: TRect; AColumnIndex: Integer);
4245 var
4246 w, h, rw, rh, ImgIndex, ImgListWidth: Integer;
4247 p: TPoint;
4248 r: TRect;
4249 ImgLayout: TButtonLayout;
4250 ImgList: TCustomImageList;
4251 ImgRes: TScaledImageListResolution;
4252 s: TSize;
4253 Details: TThemedElementDetails;
4254 NativeSortGlyphs: Boolean;
4255 begin
4256 if FSortColumn = AColumnIndex then
4257 begin
4258 GetSortTitleImageInfo(AColumnIndex, ImgList, ImgIndex, ImgListWidth, NativeSortGlyphs);
4259 if NativeSortGlyphs then// draw native sort buttons
4260 begin
4261 case FSortOrder of
4262 soAscending: Details := ThemeServices.GetElementDetails(thHeaderSortArrowSortedUp);
4263 soDescending: Details := ThemeServices.GetElementDetails(thHeaderSortArrowSortedDown);
4264 end;
4265
4266 s := ThemeServices.GetDetailSize(Details);
4267 end else
4268 s := Size(-1, -1);
4269 if s.cx>0 then // theme services support sorted arrows
4270 begin
4271 w := Scale96ToFont(s.cx);
4272 h := Scale96ToFont(s.cy);
4273
4274 if IsRightToLeft then begin
4275 r.Left := ARect.Left + DEFIMAGEPADDING;
4276 Inc(ARect.Left, w + DEFIMAGEPADDING);
4277 end else begin
4278 Dec(ARect.Right, w + DEFIMAGEPADDING);
4279 r.Left := ARect.Right - DEFIMAGEPADDING;
4280 end;
4281 r.Right := r.Left + w;
4282 r.Top := ARect.Top + (ARect.Bottom - ARect.Top - h) div 2;
4283 r.Bottom := r.Top + h;
4284
4285 ThemeServices.DrawElement(Canvas.Handle, Details, r, nil);
4286 end else
4287 begin
4288 ImgRes := ImgList.ResolutionForPPI[ImgListWidth, Font.PixelsPerInch, GetCanvasScaleFactor];
4289 w := ImgRes.Width;
4290 h := ImgRes.Height;
4291
4292 if IsRightToLeft then begin
4293 P.X := ARect.Left + DEFIMAGEPADDING;
4294 Inc(ARect.Left, w + DEFIMAGEPADDING);
4295 end else begin
4296 Dec(ARect.Right, w + DEFIMAGEPADDING);
4297 p.X := ARect.Right - DEFIMAGEPADDING;
4298 end;
4299 p.Y := ARect.Top + (ARect.Bottom - ARect.Top - h) div 2;
4300
4301 ImgRes.Draw(Canvas, p.X, p.Y, ImgIndex);
4302 end;
4303 end;
4304
4305 if FTitleImageList<>nil then
4306 begin
4307 GetTitleImageInfo(AColumnIndex, ImgIndex, ImgLayout);
4308 if ImgIndex>=0 then
4309 begin
4310 ImgRes := FTitleImageList.ResolutionForPPI[FTitleImageListWidth, Font.PixelsPerInch, GetCanvasScaleFactor];
4311 w := ImgRes.Width;
4312 h := ImgRes.Height;
4313 rw := ARect.Right - ARect.Left - DEFIMAGEPADDING * 2;
4314 rh := ARect.Bottom - ARect.Top - DEFIMAGEPADDING * 2;
4315
4316 case ImgLayout of
4317 blGlyphRight, blGlyphLeft:
4318 p.Y := ARect.Top + (rh - h) div 2 + DEFIMAGEPADDING;
4319 blGlyphTop, blGlyphBottom:
4320 p.X := ARect.Left + (rw - w) div 2 + DEFIMAGEPADDING;
4321 end;
4322 case ImgLayout of
4323 blGlyphRight: begin
4324 Dec(ARect.Right, w + DEFIMAGEPADDING * 2);
4325 p.X := ARect.Right + DEFIMAGEPADDING;
4326 end;
4327 blGlyphLeft: begin
4328 p.X := ARect.Left + DEFIMAGEPADDING;
4329 Inc(ARect.Left, w + DEFIMAGEPADDING * 2);
4330 end;
4331 blGlyphTop: begin
4332 p.Y := ARect.Top + DEFIMAGEPADDING;
4333 Inc(ARect.Top, w + DEFIMAGEPADDING * 2);
4334 end;
4335 blGlyphBottom: begin
4336 Dec(ARect.Bottom, w + DEFIMAGEPADDING * 2);
4337 p.Y := ARect.Bottom + DEFIMAGEPADDING;
4338 end;
4339 end;
4340
4341 ImgRes.Draw(Canvas, p.X, p.Y, ImgIndex);
4342 end;
4343 end;
4344 end;
4345
4346 procedure TCustomGrid.DrawCell(aCol, aRow: Integer; aRect: TRect;
4347 aState: TGridDrawState);
4348 begin
4349 PrepareCanvas(aCol, aRow, aState);
4350 DrawFillRect(Canvas, aRect);
4351 DrawCellGrid(aCol,aRow,aRect,aState);
4352 end;
4353
4354 procedure TCustomGrid.DrawAllRows;
4355 var
4356 i: Integer;
4357 begin
4358 // Draw Rows
4359 with FGCache.VisibleGrid do
4360 for i:=Top to Bottom do
4361 DrawRow(i);
4362 // Draw Fixed Rows
4363 for i:=0 to FFixedRows-1 do
4364 DrawRow(i);
4365 end;
4366
4367 procedure TCustomGrid.DrawFillRect(aCanvas: TCanvas; R: TRect);
4368 begin
4369 if UseRightToLeftAlignment then
4370 OffsetRect(R, 1, 0);
4371 aCanvas.FillRect(R);
4372 end;
4373
4374 function VerticalIntersect(const aRect,bRect: TRect): boolean;
4375 begin
4376 result := (aRect.Top < bRect.Bottom) and (aRect.Bottom > bRect.Top);
4377 end;
4378
4379 function HorizontalIntersect(const aRect,bRect: TRect): boolean;
4380 begin
4381 result := (aRect.Left < bRect.Right) and (aRect.Right > bRect.Left);
4382 end;
4383
4384 procedure TCustomGrid.DrawRow(aRow: Integer);
4385 var
4386 gds: TGridDrawState;
4387 aCol, exCol, orgTop, orgBottom: Integer;
4388 Rs, colSpanning: Boolean;
4389 R: TRect;
4390 ClipArea: Trect;
4391
4392 procedure DoDrawCell;
4393 begin
4394 with FGCache do begin
4395 if (aCol=HotCell.x) and (aRow=HotCell.y) and not IsPushCellActive() then begin
4396 Include(gds, gdHot);
4397 HotCellPainted := True;
4398 end;
4399 if ClickCellPushed and (aCol=PushedCell.x) and (aRow=PushedCell.y) then begin
4400 Include(gds, gdPushed);
4401 end;
4402 end;
4403
4404 Canvas.SaveHandleState;
4405 try
4406 InterSectClipRect(Canvas.Handle, R.Left, R.Top, R.Right, R.Bottom);
4407 DrawCell(aCol, aRow, R, gds);
4408 finally
4409 Canvas.RestoreHandleState;
4410 end;
4411 end;
4412 begin
4413
4414 // Upper and Lower bounds for this row
4415 ColRowToOffSet(False, True, aRow, R.Top, R.Bottom);
4416 orgTop := R.Top;
4417 orgBottom := R.Bottom;
4418 // is this row within the ClipRect?
4419 ClipArea := Canvas.ClipRect;
4420 if (R.Top>=R.Bottom) or not VerticalIntersect(R, ClipArea) then begin
4421 {$IFDEF DbgVisualChange}
4422 DebugLn('Drawrow: Skipped row: ', IntToStr(aRow));
4423 {$ENDIF}
4424 exit;
4425 end;
4426
4427 colSpanning := (goColSpanning in Options);
4428
4429 // Draw columns in this row
4430 with FGCache.VisibleGrid do begin
4431
4432 aCol := left;
4433 while aCol<=Right do begin
4434 ColRowToOffset(True, True, aCol, R.Left, R.Right);
4435 if (R.Left<R.Right) and HorizontalIntersect(R, ClipArea) then begin
4436
4437 if colSpanning then
4438 CellExtent(aCol, aRow, R, exCol);
4439
4440 gds := GetGridDrawState(ACol, ARow);
4441 DoDrawCell;
4442
4443 if colSpanning then begin
4444 aCol := exCol;
4445 R.Top := orgTop;
4446 R.Bottom := orgBottom;
4447 end;
4448 end;
4449 inc(aCol);
4450 end;
4451
4452 Rs := (goRowSelect in Options);
4453 // Draw the focus Rect
4454 if FFocusRectVisible and (ARow=FRow) and
4455 ((Rs and (ARow>=Top) and (ARow<=Bottom)) or IsCellVisible(FCol,ARow))
4456 then begin
4457 if EditorMode then begin
4458 //if EditorAlwaysShown and (FEditor<>nil) and FEditor.Visible then begin
4459 //DebugLn('No Draw Focus Rect');
4460 end else begin
4461 if Rs then
4462 CalcFocusRect(R, false) // will be adjusted when calling DrawFocusRect
4463 else begin
4464 ColRowToOffset(True, True, FCol, R.Left, R.Right);
4465 if colSpanning then
4466 CellExtent(FCol, aRow, R, exCol);
4467 end;
4468 // is this column within the ClipRect?
4469 if HorizontalIntersect(R, ClipArea) then
4470 DrawFocusRect(FCol,FRow, R);
4471 end;
4472 end;
4473
4474 end;
4475
4476
4477 // Draw Fixed Columns
4478 aCol := 0;
4479 while aCol<=FFixedCols-1 do begin
4480 gds:=[gdFixed];
4481 ColRowToOffset(True, True, aCol, R.Left, R.Right);
4482 // is this column within the ClipRect?
4483 if (R.Left<R.Right) and HorizontalIntersect(R, ClipArea) then begin
4484 if colSpanning then
4485 CellExtent(aCol, aRow, R, exCol);
4486 DoDrawCell;
4487 if colSpanning then begin
4488 aCol := exCol;
4489 R.Top := orgTop;
4490 R.Bottom := orgBottom;
4491 end;
4492 end;
4493 inc(aCol);
4494 end;
4495 end;
4496
4497 procedure TCustomGrid.EditButtonClicked(Sender: TObject);
4498 begin
4499 if Assigned(OnEditButtonClick) or Assigned(OnButtonClick) then begin
4500 if Sender=FButtonEditor then
4501 DoEditButtonClick(FButtonEditor.Col, FButtonEditor.Row)
4502 else
4503 DoEditButtonClick(FCol, FRow);
4504 end;
4505 end;
4506
4507 procedure TCustomGrid.DrawEdges;
4508 var
4509 P: TPoint;
4510 Cr: TRect;
4511 begin
4512 P:=FGCache.MaxClientXY;
4513 Cr:=Bounds(0,0, FGCache.ClientWidth, FGCache.ClientHeight);
4514 if P.x<Cr.Right then begin
4515 if UseRightToLeftAlignment then
4516 Cr.Right:=Cr.Right - P.x
4517 else
4518 Cr.Left:=P.x;
4519 Canvas.Brush.Color:= Color;
4520 Canvas.FillRect(cr);
4521 if UseRightToLeftAlignment then begin
4522 Cr.Left := Cr.Right;
4523 Cr.Right:=FGCache.ClientWidth;
4524 end
4525 else begin
4526 Cr.Right:=Cr.Left;
4527 Cr.Left:=0;
4528 end;
4529 end;
4530 if P.y<Cr.Bottom then begin
4531 Cr.Top:=p.y;
4532 Canvas.Brush.Color:= Color;
4533 Canvas.FillRect(cr);
4534 end;
4535 end;
4536
4537 procedure TCustomGrid.DrawCellGrid(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState);
4538 var
4539 dv,dh: Boolean;
4540 OldCosmeticUsed, OldCosmetic: Boolean;
4541 begin
4542 OldCosmeticUsed := false;
4543
4544 with Canvas do begin
4545
4546 // fixed cells
4547 if (gdFixed in aState) then begin
4548 Dv := goFixedVertLine in Options;
4549 Dh := goFixedHorzLine in Options;
4550 Pen.Style := psSolid;
4551 if FGridLineWidth > 0 then
4552 Pen.Width := 1
4553 else
4554 Pen.Width := 0;
4555 if not FFlat then begin
4556 if FTitleStyle=tsNative then
4557 exit
4558 else
4559 if FGridLineWidth > 0 then begin
4560 if gdPushed in aState then
4561 Pen.Color := cl3DShadow
4562 else
4563 Pen.Color := cl3DHilight;
4564 if UseRightToLeftAlignment then begin
4565 //the light still on the left but need to new x
4566 MoveTo(aRect.Right, aRect.Top);
4567 LineTo(aRect.Left + 1, aRect.Top);
4568 LineTo(aRect.Left + 1, aRect.Bottom);
4569 end else begin
4570 MoveTo(aRect.Right - 1, aRect.Top);
4571 LineTo(aRect.Left, aRect.Top);
4572 LineTo(aRect.Left, aRect.Bottom);
4573 end;
4574 if FTitleStyle=tsStandard then begin
4575 // more contrast
4576 if gdPushed in aState then
4577 Pen.Color := cl3DHilight
4578 else
4579 Pen.Color := cl3DShadow;
4580 if UseRightToLeftAlignment then begin
4581 MoveTo(aRect.Left+2, aRect.Bottom-2);
4582 LineTo(aRect.Right, aRect.Bottom-2);
4583 LineTo(aRect.Right, aRect.Top);
4584 end else begin
4585 MoveTo(aRect.Left+1, aRect.Bottom-2);
4586 LineTo(aRect.Right-2, aRect.Bottom-2);
4587 LineTo(aRect.Right-2, aRect.Top);
4588 end;
4589 end;
4590 end;
4591 Pen.Color := cl3DDKShadow;
4592 end else begin
4593 Pen.Color := FFixedGridLineColor;
4594 end;
4595 end else begin
4596 Dv := goVertLine in Options;
4597 Dh := goHorzLine in Options;
4598 OldCosmeticUsed := true;
4599 OldCosmetic := Pen.Cosmetic;
4600 Pen.Cosmetic := false;
4601 Pen.Style := fGridLineStyle;
4602 Pen.Color := fGridLineColor;
4603 Pen.Width := fGridLineWidth;
4604 end;
4605
4606 // non-fixed cells
4607 if fGridLineWidth > 0 then begin
4608 if Dh then begin
4609 MoveTo(aRect.Left, aRect.Bottom - 1);
4610 LineTo(aRect.Right, aRect.Bottom - 1);
4611 end;
4612 if Dv then begin
4613 if UseRightToLeftAlignment then begin
4614 MoveTo(aRect.Left, aRect.Top);
4615 LineTo(aRect.Left, aRect.Bottom);
4616 end else begin
4617 MoveTo(aRect.Right - 1, aRect.Top);
4618 LineTo(aRect.Right - 1, aRect.Bottom);
4619 end;
4620 end;
4621 end;
4622
4623 if OldCosmeticUsed then
4624 Pen.Cosmetic := OldCosmetic;
4625 end; // with canvas,rect
4626 end;
4627
4628 procedure TCustomGrid.DrawTextInCell(aCol, aRow: Integer; aRect: TRect;
4629 aState: TGridDrawState);
4630 begin
4631 //
4632 end;
4633
4634 procedure TCustomGrid.DrawThemedCell(aCol, aRow: Integer; aRect: TRect;
4635 aState: TGridDrawState);
4636 var
4637 details: TThemedElementDetails;
4638 begin
4639 if gdPushed in aState then
4640 Details := ThemeServices.GetElementDetails(thHeaderItemPressed)
4641 else
4642 if gdHot in aState then
4643 Details := ThemeServices.GetElementDetails(thHeaderItemHot)
4644 else
4645 Details := ThemeServices.GetElementDetails(thHeaderItemNormal);
4646 ThemeSErvices.DrawElement(Canvas.Handle, Details, aRect, nil);
4647 end;
4648
4649 procedure TCustomGrid.DrawCellText(aCol, aRow: Integer; aRect: TRect;
4650 aState: TGridDrawState; aText: String);
4651 begin
4652 dec(ARect.Right, varCellPadding);
4653 case Canvas.TextStyle.Alignment of
4654 Classes.taLeftJustify: Inc(ARect.Left, varCellPadding);
4655 Classes.taRightJustify: Dec(ARect.Right, 1);
4656 end;
4657 case Canvas.TextStyle.Layout of
4658 tlTop: Inc(ARect.Top, varCellPadding);
4659 tlBottom: Dec(ARect.Bottom, varCellPadding);
4660 end;
4661
4662 if ARect.Right<ARect.Left then
4663 ARect.Right:=ARect.Left;
4664 if ARect.Left>ARect.Right then
4665 ARect.Left:=ARect.Right;
4666 if ARect.Bottom<ARect.Top then
4667 ARect.Bottom:=ARect.Top;
4668 if ARect.Top>ARect.Bottom then
4669 ARect.Top:=ARect.Bottom;
4670
4671 if (ARect.Left<>ARect.Right) and (ARect.Top<>ARect.Bottom) then
4672 Canvas.TextRect(aRect,ARect.Left,ARect.Top, aText);
4673 end;
4674
4675 procedure TCustomGrid.DrawGridCheckboxBitmaps(const aCol,aRow: Integer;
4676 const aRect: TRect; const aState: TCheckboxState);
4677 const
4678 arrtb:array[TCheckboxState] of TThemedButton =
4679 (tbCheckBoxUncheckedNormal, tbCheckBoxCheckedNormal, tbCheckBoxMixedNormal);
4680 var
4681 ChkBitmap: TBitmap;
4682 XPos,YPos: Integer;
4683 Details: TThemedElementDetails;
4684 PaintRect: TRect;
4685 CSize: TSize;
4686 bmpAlign: TAlignment;
4687 bmpLayout: TTextLayout;
4688 ChkIL: TCustomImageList;
4689 ChkII: TImageIndex;
4690 ChkILRes: TScaledImageListResolution;
4691 begin
4692
4693 if Columns.Enabled then
4694 begin
4695 bmpAlign := GetColumnAlignment(aCol, false);
4696 bmpLayout := GetColumnLayout(aCol, false);
4697 end else
4698 begin
4699 bmpAlign := taCenter;
4700 bmpLayout := Canvas.TextStyle.Layout;
4701 end;
4702
4703 Details.State := -1;
4704 ChkIL := nil;
4705 ChkILRes := TScaledImageListResolution.Create(nil, 0);
4706 ChkII := -1;
4707 ChkBitmap := nil;
4708
4709 GetImageForCheckBox(aCol, aRow, AState, ChkIL, ChkII, ChkBitmap);
4710 if Assigned(ChkBitmap) then
4711 CSize := Size(ChkBitmap.Width, ChkBitmap.Height)
4712 else if (Assigned(ChkIL) and (ChkII>=0)) then
4713 begin
4714 ChkILRes := ChkIL.ResolutionForPPI[ChkIL.Width, Font.PixelsPerInch, GetCanvasScaleFactor];
4715 CSize := ChkILRes.Size;
4716 end else
4717 begin
4718 Details := ThemeServices.GetElementDetails(arrtb[AState]);
4719 CSize := ThemeServices.GetDetailSize(Details);
4720 CSize.cx := MulDiv(CSize.cx, Font.PixelsPerInch, Screen.PixelsPerInch);
4721 CSize.cy := MulDiv(CSize.cy, Font.PixelsPerInch, Screen.PixelsPerInch);
4722 end;
4723
4724 case bmpAlign of
4725 taCenter: PaintRect.Left := (aRect.Left + aRect.Right - CSize.cx) div 2;
4726 taLeftJustify: PaintRect.Left := ARect.Left + varCellPadding;
4727 taRightJustify: PaintRect.Left := ARect.Right - CSize.Cx - varCellPadding - 1;
4728 end;
4729
4730 case bmpLayout of
4731 tlTop : PaintRect.Top := aRect.Top + varCellPadding;
4732 tlCenter : PaintRect.Top := (aRect.Top + aRect.Bottom - CSize.cy) div 2;
4733 tlBottom : PaintRect.Top := aRect.Bottom - varCellPadding - CSize.cy - 1;
4734 end;
4735 PaintRect := Bounds(PaintRect.Left, PaintRect.Top, CSize.cx, CSize.cy);
4736
4737 if Details.State>=0 then
4738 ThemeServices.DrawElement(Canvas.Handle, Details, PaintRect, nil)
4739 else
4740 if Assigned(ChkBitmap) then
4741 Canvas.StretchDraw(PaintRect, ChkBitmap)
4742 else
4743 if Assigned(ChkILRes.Resolution) then
4744 ChkILRes.StretchDraw(Canvas, ChkII, PaintRect);
4745 end;
4746
4747 procedure TCustomGrid.DrawButtonCell(const aCol, aRow: Integer; aRect: TRect;
4748 const aState: TGridDrawState);
4749 var
4750 details: TThemedElementDetails;
4751 begin
4752 Dec(aRect.Right);
4753 Dec(aRect.Bottom);
4754 if gdPushed in aState then
4755 Details := ThemeServices.GetElementDetails(tbPushButtonPressed)
4756 else
4757 if gdHot in aState then
4758 Details := ThemeServices.GetElementDetails(tbPushButtonHot)
4759 else
4760 Details := ThemeServices.GetElementDetails(tbPushButtonNormal);
4761 ThemeServices.DrawElement(Canvas.Handle, Details, aRect, nil);
4762 end;
4763
4764 procedure TCustomGrid.OnTitleFontChanged(Sender: TObject);
4765 begin
4766 FTitleFontIsDefault := False;
4767 if FColumns.Enabled then begin
4768 FColumns.TitleFontChanged;
4769 ColumnsChanged(nil);
4770 end else
4771 VisualChange;
4772 end;
4773
4774 procedure TCustomGrid.ReadColumns(Reader: TReader);
4775 begin
4776 Columns.Clear;
4777 Reader.ReadValue;
4778 Reader.ReadCollection(Columns);
4779 end;
4780
4781 procedure TCustomGrid.ReadColWidths(Reader: TReader);
4782 var
4783 i: integer;
4784 begin
4785 with Reader do begin
4786 ReadListBegin;
4787 for i:=0 to ColCount-1 do
4788 ColWidths[I] := ReadInteger;
4789 ReadListEnd;
4790 end;
4791 end;
4792
4793 procedure TCustomGrid.ReadRowHeights(Reader: TReader);
4794 var
4795 i: integer;
4796 begin
4797 with Reader do begin
4798 ReadListBegin;
4799 for i:=0 to RowCount-1 do
4800 RowHeights[I] := ReadInteger;
4801 ReadListEnd;
4802 end;
4803 end;
4804
4805 procedure TCustomGrid.WMEraseBkgnd(var message: TLMEraseBkgnd);
4806 begin
4807 message.Result:=1;
4808 end;
4809
4810 procedure TCustomGrid.WMGetDlgCode(var Msg: TLMNoParams);
4811 begin
4812 Msg.Result := DLGC_WANTARROWS or DLGC_WANTCHARS;
4813 if goTabs in Options then Msg.Result:= Msg.Result or DLGC_WANTTAB;
4814 end;
4815
4816 procedure TCustomGrid.WMHScroll(var message: TLMHScroll);
4817 var
4818 SP: TPoint;
4819 begin
4820 SP := GetPxTopLeft;
4821
4822 case message.ScrollCode of
4823 SB_THUMBPOSITION,
4824 SB_THUMBTRACK: begin
4825 if (message.ScrollCode=SB_THUMBPOSITION) or (goThumbTracking in Options) then
4826 begin
4827 if BiDiMode = bdRightToLeft then
4828 TrySmoothScrollBy(FGCache.HScrollBarNetRange-message.Pos-SP.x, 0)
4829 else
4830 TrySmoothScrollBy(message.Pos-SP.x, 0);
4831 end;
4832 message.Result := 0;
4833 end;
4834 SB_PAGELEFT: TrySmoothScrollBy(-(ClientWidth-FGCache.FixedWidth)*RTLSign, 0);
4835 SB_PAGERIGHT: TrySmoothScrollBy((ClientWidth-FGCache.FixedWidth)*RTLSign, 0);
4836 SB_LINELEFT: TrySmoothScrollBy(-DefaultColWidth*RTLSign, 0);
4837 SB_LINERIGHT: TrySmoothScrollBy(DefaultColWidth*RTLSign, 0);
4838 end;
4839
4840 if EditorMode then
4841 EditorPos;
4842 end;
4843
4844 procedure TCustomGrid.WMVScroll(var message: TLMVScroll);
4845 var
4846 SP: TPoint;
4847 begin
4848 SP := GetPxTopLeft;
4849
4850 case message.ScrollCode of
4851 SB_THUMBPOSITION,
4852 SB_THUMBTRACK: begin
4853 if (message.ScrollCode=SB_THUMBPOSITION) or (goThumbTracking in Options) then
4854 TrySmoothScrollBy(0, message.Pos-SP.y);
4855 message.Result := 0;
4856 end;
4857 SB_PAGEUP: TrySmoothScrollBy(0, -(ClientHeight-FGCache.FixedHeight));
4858 SB_PAGEDOWN: TrySmoothScrollBy(0, ClientHeight-FGCache.FixedHeight);
4859 SB_LINEUP: TrySmoothScrollBy(0, -DefaultRowHeight);
4860 SB_LINEDOWN: TrySmoothScrollBy(0, DefaultRowHeight);
4861 end;
4862
4863 if EditorMode then
4864 EditorPos;
4865 end;
4866
4867 procedure TCustomGrid.WMKillFocus(var message: TLMKillFocus);
4868 begin
4869 if csDestroying in ComponentState then
4870 exit;
4871 {$ifdef dbgGrid}
4872 DbgOut('*** grid.WMKillFocus, FocusedWnd=%x WillFocus=',[Message.FocusedWnd]);
4873 if EditorMode and (Message.FocusedWnd = FEditor.Handle) then
4874 DebugLn('Editor')
4875 else begin
4876 DbgOut('ExternalWindow: ');
4877 if GetProp(Message.FocusedWnd, 'WinControl')<>nil then
4878 DebugLn(dbgsname(TObject(GetProp(Message.FocusedWnd, 'WinControl'))))
4879 else
4880 DebugLn(' Unknown Window');
4881 end;
4882 {$endif}
4883 inherited WMKillFocus(Message);
4884 InvalidateFocused;
4885 end;
4886
4887 procedure TCustomGrid.WMSetFocus(var message: TLMSetFocus);
4888 begin
4889 {$ifdef dbgGrid}
4890 DbgOut('*** grid.WMSetFocus, FocusedWnd=', dbgs(Message.FocusedWnd),'[',dbgs(pointer(Message.FocusedWnd)),'] ');
4891 if EditorMode and (Message.FocusedWnd = FEditor.Handle) then
4892 DebugLn('Editor')
4893 else begin
4894 if Message.FocusedWnd=Self.Handle then
4895 DebugLn('Same Grid!')
4896 else
4897 DebugLn('ExternalWindow');
4898 end;
4899 {$endif}
4900 inherited WMSetFocus(Message);
4901 InvalidateFocused;
4902 end;
4903
4904 procedure TCustomGrid.WMSize(var Message: TLMSize);
4905 begin
4906 if gfUpdatingScrollbar in FGridFlags then // ignore WMSize when updating scrollbars. issue #31715
4907 Exit;
4908 inherited WMSize(Message);
4909 end;
4910
4911 class procedure TCustomGrid.WSRegisterClass;
4912 begin
4913 inherited WSRegisterClass;
4914 RegisterCustomGrid;
4915 end;
4916
4917 procedure TCustomGrid.AddSelectedRange;
4918 var
4919 n: Integer;
4920 begin
4921 if (goRangeSelect in Options) and (FRangeSelectMode = rsmMulti) then begin
4922 n := Length(FSelections);
4923 SetLength(FSelections, n+1);
4924 FSelections[n] := FRange;
4925 end;
4926 end;
4927
4928 procedure TCustomGrid.AdjustClientRect(var ARect: TRect);
4929 begin
4930 inherited AdjustClientRect(ARect);
4931 include(FGridFlags, gfClientRectChange);
4932 end;
4933
4934 procedure TCustomGrid.WndProc(var TheMessage: TLMessage);
4935 begin
4936 {$ifdef GridTraceMsg}
4937 TransMsg('GRID: ', TheMessage);
4938 {$endif}
4939 case TheMessage.Msg of
4940 LM_HSCROLL, LM_VSCROLL:
4941 if csDesigning in ComponentState then
4942 exit;
4943 {$IFDEF MSWINDOWS}
4944 // Ignore LM_SIZE while another sizing is being processed.
4945 // Windows sends WM_SIZE when showing/hiding scrollbars.
4946 // Scrollbars can be shown/hidden when processing DoOnChangeBounds.
4947 LM_SIZE:
4948 if gfUpdatingSize in FGridFlags then
4949 exit;
4950 {$ENDIF}
4951 end;
4952 inherited WndProc(TheMessage);
4953 end;
4954
4955 procedure TCustomGrid.CreateWnd;
4956 begin
4957 //DebugLn('TCustomGrid.CreateWnd ',DbgSName(Self));
4958 inherited CreateWnd;
4959 FVSbVisible := Ord(GetScrollbarvisible(Handle, SB_Vert));
4960 FHSbVisible := Ord(GetScrollbarvisible(Handle, SB_Horz));
4961 CheckPosition;
4962 VisualChange;
4963 end;
4964
4965 { Scroll grid to the given Topleft[aCol,aRow] as needed }
4966 procedure TCustomGrid.TryScrollTo(aCol, aRow: Integer; ClearColOff,
4967 ClearRowOff: Boolean);
4968 var
4969 TryTL: TPoint;
4970 NewCol,NewRow: Integer;
4971 TLChange: Boolean;
4972 begin
4973 TryTL:=ScrollGrid(False,aCol, aRow);
4974 TLChange := not PointIgual(TryTL, FTopLeft);
4975 if TLChange
4976 or (not PointIgual(TryTL, Point(aCol, aRow)) and (goSmoothScroll in Options))
4977 or (ClearColOff and (FGCache.TLColOff<>0))
4978 or (ClearRowOff and (FGCache.TLRowOff<>0)) then
4979 begin
4980 NewCol := TryTL.X - FTopLeft.X + Col;
4981 NewRow := TryTL.Y - FTopLeft.Y + Row;
4982 FTopLeft:=TryTL;
4983 if ClearColOff then
4984 FGCache.TLColOff := 0;
4985 if ClearRowOff then
4986 FGCache.TLRowOff := 0;
4987 if (aCol>TryTL.X) and (goSmoothScroll in Options) then
4988 FGCache.TLColOff := FGCache.MaxTLOffset.X;
4989 if (aRow>TryTL.Y) and (goSmoothScroll in Options) then
4990 FGCache.TLRowOff := FGCache.MaxTLOffset.Y;
4991 {$ifdef dbgscroll}
4992 DebugLn('TryScrollTo: TopLeft=%s NewCol=%d NewRow=%d',
4993 [dbgs(FTopLeft), NewCol, NewRow]);
4994 {$endif}
4995 // To-Do: move rect with ScrollBy_WS and invalidate only new (not scrolled) rects
4996 if TLChange then
4997 doTopleftChange(False)
4998 else
4999 VisualChange;
5000 if goScrollKeepVisible in Options then
5001 MoveNextSelectable(False, NewCol, NewRow);
5002 end;
5003 end;
5004
TrySmoothScrollBynull5005 function TCustomGrid.TrySmoothScrollBy(aColDelta, aRowDelta: Integer): Boolean;
5006 var
5007 OldTopLeft, OldTopLeftXY, NewTopLeftXY, OldOff: TPoint;
5008 begin
5009 if (aColDelta=0) and (aRowDelta=0) then
5010 Exit(True);
5011
5012 OldTopLeft := FTopLeft;
5013 OldTopLeftXY := GetPxTopLeft;
5014 OldOff := Point(FGCache.TLColOff, FGCache.TLRowOff);
5015
5016 Inc(FGCache.TLColOff, aColDelta);
5017 Inc(FGCache.TLRowOff, aRowDelta);
5018
5019 while (FTopLeft.x < GCache.MaxTopLeft.x) and (FGCache.TLColOff >= ColWidths[FTopLeft.x]) do
5020 begin
5021 Dec(FGCache.TLColOff, ColWidths[FTopLeft.x]);
5022 Inc(FTopLeft.x);
5023 end;
5024 while (FTopLeft.x > FixedCols) and (FGCache.TLColOff < 0) do
5025 begin
5026 Dec(FTopLeft.x);
5027 Inc(FGCache.TLColOff, ColWidths[FTopLeft.x]);
5028 end;
5029
5030 while (FTopLeft.y < GCache.MaxTopLeft.y) and (FGCache.TLRowOff >= RowHeights[FTopLeft.y]) do
5031 begin
5032 Dec(FGCache.TLRowOff, RowHeights[FTopLeft.y]);
5033 Inc(FTopLeft.y);
5034 end;
5035 while (FTopLeft.y > FixedRows) and (FGCache.TLRowOff < 0) do
5036 begin
5037 Dec(FTopLeft.y);
5038 Inc(FGCache.TLRowOff, RowHeights[FTopLeft.y]);
5039 end;
5040
5041 FGCache.TLColOff := Max(0, FGCache.TLColOff);
5042 FGCache.TLRowOff := Max(0, FGCache.TLRowOff);
5043 if FTopLeft.x=FGCache.MaxTopLeft.x then
5044 FGCache.TLColOff := Min(FGCache.MaxTLOffset.x, FGCache.TLColOff);
5045 if FTopLeft.y=FGCache.MaxTopLeft.y then
5046 FGCache.TLRowOff := Min(FGCache.MaxTLOffset.y, FGCache.TLRowOff);
5047
5048 if not GetSmoothScroll(SB_Horz) then
5049 FGCache.TLColOff := 0;
5050 if not GetSmoothScroll(SB_Vert) then
5051 FGCache.TLRowOff := 0;
5052
5053 if not PointIgual(OldTopleft,FTopLeft) then begin
5054 TopLeftChanged;
5055 if goScrollKeepVisible in Options then
5056 MoveNextSelectable(False, FTopLeft.x - oldTopLeft.x + col,
5057 FTopLeft.y - oldTopLeft.y + row);
5058 end;
5059
5060 NewTopLeftXY := GetPxTopLeft;
5061 ScrollBy((OldTopLeftXY.x-NewTopLeftXY.x)*RTLSign, OldTopLeftXY.y-NewTopLeftXY.y);
5062
5063 //Result is false if this function failed due to a too high/wide cell (applicable only if goSmoothScroll not used)
5064 Result :=
5065 not PointIgual(OldTopLeftXY, NewTopLeftXY)
5066 or ((NewTopLeftXY.x = 0) and (aColDelta < 0))
5067 or ((FTopLeft.x = FGCache.MaxTopLeft.x) and (FGCache.TLColOff = FGCache.MaxTLOffset.x) and (aColDelta > 0))
5068 or ((NewTopLeftXY.y = 0) and (aRowDelta < 0))
5069 or ((FTopLeft.y = FGCache.MaxTopLeft.y) and (FGCache.TLRowOff = FGCache.MaxTLOffset.y) and (aRowDelta > 0));
5070 end;
5071
5072 procedure TCustomGrid.SetGridLineWidth(const AValue: Integer);
5073 begin
5074 if FGridLineWidth = AValue then
5075 exit;
5076 FGridLineWidth := AValue;
5077 Invalidate;
5078 end;
5079
5080 procedure TCustomGrid.UpdateCachedSizes;
5081 var
5082 i: Integer;
5083 TLChanged: Boolean;
5084 begin
5085 if AutoFillColumns then
5086 InternalAutoFillColumns;
5087
5088 // Calculate New Cached Values
5089 FGCache.GridWidth:=0;
5090 FGCache.FixedWidth:=0;
5091 for i:=0 to ColCount-1 do begin
5092 FGCache.AccumWidth[i]:=FGCache.GridWidth;
5093 FGCache.GridWidth:=FGCache.GridWidth + GetColWidths(i);
5094 if i<FixedCols then
5095 FGCache.FixedWidth:=FGCache.GridWidth;
5096 end;
5097
5098 FGCache.Gridheight:=0;
5099 FGCache.FixedHeight:=0;
5100 for i:=0 to RowCount-1 do begin
5101 FGCache.AccumHeight[i]:=FGCache.Gridheight;
5102 FGCache.Gridheight:=FGCache.Gridheight+GetRowHeights(i);
5103 if i<FixedRows then
5104 FGCache.FixedHeight:=FGCache.GridHeight;
5105 end;
5106
5107 FGCache.ClientRect := ClientRect;
5108 FGCache.ClientWidth := ClientWidth;
5109 FGCache.ClientHeight := ClientHeight;
5110
5111 FGCache.ScrollWidth := FGCache.ClientWidth-FGCache.FixedWidth;
5112 FGCache.ScrollHeight := FGCache.ClientHeight-FGCache.FixedHeight;
5113 CalcMaxTopLeft;
5114
5115 TLChanged := False;
5116 if fTopLeft.y > FGCache.MaxTopLeft.y then
5117 begin
5118 fTopLeft.y := FGCache.MaxTopLeft.y;
5119 FGCache.TLRowOff := FGCache.MaxTLOffset.y;
5120 TLChanged := True;
5121 end else
5122 if FTopLeft.y < FixedRows then
5123 begin
5124 fTopLeft.y := FixedRows;
5125 TLChanged := True;
5126 end;
5127 if fTopLeft.x > FGCache.MaxTopLeft.x then
5128 begin
5129 fTopLeft.x := FGCache.MaxTopLeft.x;
5130 FGCache.TLColOff := FGCache.MaxTLOffset.x;
5131 TLChanged := True;
5132 end else
5133 if FTopLeft.x < FixedCols then
5134 begin
5135 fTopLeft.x := FixedCols;
5136 TLChanged := True;
5137 end;
5138 if TopRow=FGCache.MaxTopLeft.y then
5139 FGCache.TLRowOff := Min(FGCache.TLRowOff, FGCache.MaxTLOffset.y)
5140 else
5141 FGCache.TLRowOff := Min(FGCache.TLRowOff, RowHeights[TopRow]);
5142 if LeftCol=FGCache.MaxTopLeft.x then
5143 FGCache.TLColOff := Min(FGCache.TLColOff, FGCache.MaxTLOffset.x)
5144 else
5145 FGCache.TLColOff := Min(FGCache.TLColOff, ColWidths[LeftCol]);
5146 if TLChanged then
5147 TopLeftChanged;
5148
5149 {$ifdef dbgVisualChange}
5150 DebugLn('TCustomGrid.updateCachedSizes: ');
5151 with FGCache do
5152 DebugLn(' GWidth=%d GHeight=%d FWidth=%d FHeight=%d CWidth=%d CHeight=%d MTL.X=%d MTL.Y=%d',
5153 [GridWidth,GridHeight,FixedWidth,FixedHeight,ClientWidth,ClientHeight,
5154 MaxTopLeft.X, MaxTopLeft.Y]);
5155 {$endif}
5156 end;
5157
5158 procedure TCustomGrid.GetSBVisibility(out HsbVisible,VsbVisible:boolean);
5159 var
5160 autoVert,autoHorz: boolean;
5161 ClientW,ClientH,ExtraW,ExtraH: Integer;
5162 BarW,BarH: Integer;
5163 begin
5164 AutoVert := ScrollBarAutomatic(ssVertical);
5165 AutoHorz := ScrollBarAutomatic(ssHorizontal);
5166
5167 // get client bounds free of bars
5168 ClientW := ClientWidth;
5169 ClientH := ClientHeight;
5170 BarW := GetSystemMetrics(SM_CXVSCROLL) +
5171 GetSystemMetrics(SM_SWSCROLLBARSPACING);
5172 if ScrollBarIsVisible(SB_VERT) then
5173 ClientW := ClientW + BarW;
5174 BarH := GetSystemMetrics(SM_CYHSCROLL) +
5175 GetSystemMetrics(SM_SWSCROLLBARSPACING);
5176 if ScrollBarIsVisible(SB_HORZ) then
5177 ClientH := ClientH + BarH;
5178 ExtraW := 0;
5179 if goScrollToLastCol in FOptions2 then
5180 begin
5181 Inc(ExtraW, ClientWidth - FGCache.FixedWidth);
5182 if ColCount>FixedCols then
5183 Dec(ExtraW, ColWidths[ColCount-1]);
5184 end;
5185 ExtraH := 0;
5186 if goScrollToLastRow in FOptions2 then
5187 begin
5188 Inc(ExtraH, ClientHeight - FGCache.FixedHeight);
5189 if RowCount>FixedRows then
5190 Dec(ExtraH, RowHeights[RowCount-1]);
5191 end;
5192
5193 // first find out if scrollbars need to be visible by
5194 // comparing against client bounds free of bars
5195 HsbVisible := (FScrollBars in [ssHorizontal, ssBoth]) or
5196 (AutoHorz and (FGCache.GridWidth+ExtraW>ClientW));
5197
5198 VsbVisible := (FScrollBars in [ssVertical, ssBoth]) or
5199 (AutoVert and (FGCache.GridHeight+ExtraH>ClientH));
5200
5201 // then for automatic scrollbars check if grid bounds are
5202 // in some part of area occupied by scrollbars
5203 if ExtraW>0 then
5204 Dec(ExtraW, BarW);
5205 if not HsbVisible and AutoHorz and VsbVisible then
5206 HsbVisible := FGCache.GridWidth+ExtraW > (ClientW-BarW);
5207
5208 if ExtraH>0 then
5209 Dec(ExtraH, BarH);
5210 if not VsbVisible and AutoVert and HsbVisible then
5211 VsbVisible := FGCache.GridHeight+ExtraH > (ClientH-BarH);
5212
5213 if AutoHorz then
5214 HsbVisible := HsbVisible and not AutoFillColumns;
5215
5216 // update new cached client values according to visibility
5217 // of scrollbars
5218 if HsbVisible then
5219 FGCache.ClientHeight := ClientH - BarH;
5220 if VsbVisible then
5221 FGCache.ClientWidth := ClientW - BarW;
5222
5223 {$ifdef dbgscroll}
5224 DebugLn('TCustomGrid.GetSBVisibility:');
5225 DebugLn([' Horz=',HsbVisible,' GW=',FGCache.GridWidth,
5226 ' CW=',ClientWidth,' CCW=',FGCache.ClientWidth,' BarW=',BarW]);
5227 DebugLn([' Vert=',VsbVisible,' GH=',FGCache.GridHeight,
5228 ' CH=',ClientHeight,' CCH=',FGCache.ClientHeight,' BarH=',BarH]);
5229 {$endif}
5230 end;
5231
5232 procedure TCustomGrid.GetSBRanges(const HsbVisible, VsbVisible: boolean; out
5233 HsbRange, VsbRange, HsbPage, VsbPage, HsbPos, VsbPos: Integer);
5234 begin
5235 HsbRange := 0;
5236 HsbPos := 0;
5237 if HsbVisible then
5238 begin
5239 if not GetSmoothScroll(SB_Horz) then
5240 begin
5241 if IsColumnIndexValid(FGCache.MaxTopLeft.x) then
5242 HsbRange := FGCache.AccumWidth[FGCache.MaxTopLeft.x]+ClientWidth-FGCache.FixedWidth
5243 end else
5244 begin
5245 HsbRange:=GridWidth - GetBorderWidth;
5246 if goScrollToLastCol in FOptions2 then
5247 begin
5248 Inc(HsbRange, ClientWidth - FGCache.FixedWidth);
5249 if ColCount>FixedCols then
5250 Dec(HsbRange, ColWidths[ColCount-1]);
5251 end;
5252 end;
5253 if IsColumnIndexValid(FTopLeft.x) then
5254 HsbPos := FGCache.AccumWidth[FTopLeft.x]+FGCache.TLColOff-FGCache.FixedWidth;
5255 end;
5256
5257 VsbRange := 0;
5258 VsbPos := 0;
5259 if VsbVisible then
5260 begin
5261 if not GetSmoothScroll(SB_Vert) then
5262 begin
5263 if IsRowIndexValid(FGCache.MaxTopLeft.y) then
5264 VsbRange := FGCache.AccumHeight[FGCache.MaxTopLeft.y]+ClientHeight-FGCache.FixedHeight
5265 end else
5266 begin
5267 VSbRange:= GridHeight - GetBorderWidth;
5268 if goScrollToLastRow in FOptions2 then
5269 begin
5270 Inc(VsbRange, ClientHeight - FGCache.FixedHeight);
5271 if RowCount>FixedRows then
5272 Dec(VsbRange, RowHeights[RowCount-1]);
5273 end;
5274 end;
5275 if IsRowIndexValid(FTopLeft.y) then
5276 VsbPos := FGCache.AccumHeight[FTopLeft.y]+FGCache.TLRowOff-FGCache.FixedHeight;
5277 end;
5278
5279 HsbPage := ClientWidth;
5280 VSbPage := ClientHeight;
5281
5282 FGCache.HScrollBarNetRange := HsbRange-HsbPage;
5283
5284 {$ifdef dbgscroll}
5285 DebugLn('GetSBRanges: HRange=%d HPage=%d HPos=%d VRange=%d VPage=%d VPos=%d',
5286 [HSbRange,HsbPage,HsbPos, VsbRange, VsbPage, VsbPos]);
5287 {$endif}
5288 end;
5289
5290 procedure TCustomGrid.GetSelectedState(AState: TGridDrawState; out
5291 IsSelected: boolean);
5292 begin
5293 IsSelected := (gdSelected in aState);
5294 if IsSelected and (gdFocused in aState) then
5295 IsSelected := (goDrawFocusSelected in Options) or
5296 ((goRowSelect in Options) and not (goRelaxedRowSelect in Options));
5297 end;
5298
5299 procedure TCustomGrid.UpdateSBVisibility;
5300 var
5301 HSbVisible, VSbVisible: boolean;
5302 begin
5303 GetSBVisibility(HSbVisible, VSbVisible);
5304 ScrollBarShow(SB_VERT, VSbVisible);
5305 ScrollBarShow(SB_HORZ, HSbVisible);
5306 end;
5307
5308 procedure TCustomGrid.UpdateSizes;
5309 begin
5310 if (FUpdateCount<>0) then
5311 exit;
5312
5313 Include(FGridFlags, gfVisualChange);
5314
5315 UpdateCachedSizes;
5316 CacheVisibleGrid;
5317 CalcScrollbarsRange;
5318 end;
5319
5320 procedure TCustomGrid.UpdateSelectionRange;
5321 begin
5322 if goRowSelect in Options then begin
5323 FRange:=Rect(FFixedCols, FRow, ColCount-1, FRow);
5324 end
5325 else
5326 FRange:=Rect(FCol,FRow,FCol,FRow);
5327 end;
5328
5329 procedure TCustomGrid.WriteColumns(Writer: TWriter);
5330 begin
5331 if Columns.IsDefault then
5332 Writer.WriteCollection(nil)
5333 else
5334 Writer.WriteCollection(Columns);
5335 end;
5336
5337 procedure TCustomGrid.WriteColWidths(Writer: TWriter);
5338 var
5339 i: Integer;
5340 begin
5341 with writer do begin
5342 WriteListBegin;
5343 for i:=0 to ColCount-1 do
5344 WriteInteger(ColWidths[i]);
5345 WriteListEnd;
5346 end;
5347 end;
5348
5349 procedure TCustomGrid.WriteRowHeights(Writer: TWriter);
5350 var
5351 i: integer;
5352 begin
5353 with writer do begin
5354 WriteListBegin;
5355 for i:=0 to RowCount-1 do
5356 WriteInteger(RowHeights[i]);
5357 WriteListEnd;
5358 end;
5359 end;
5360
5361 procedure TCustomGrid.CheckFixedCount(aCol,aRow,aFCol,aFRow: Integer);
5362 begin
5363 if AFRow<0 then
5364 raise EGridException.Create('FixedRows<0');
5365 if AFCol<0 then
5366 raise EGridException.Create('FixedCols<0');
5367
5368 if csLoading in ComponentState then
5369 exit;
5370
5371 if (aCol=0)and(aFCol=0) then // fixed grid
5372 else if (aFCol>ACol) then
5373 raise EGridException.Create(rsFixedColsTooBig);
5374
5375 if (aRow=0)and(aFRow=0) then // fixed grid
5376 else if (aFRow>ARow) then
5377 raise EGridException.Create(rsFixedRowsTooBig);
5378 end;
5379
5380 procedure TCustomGrid.CheckCount(aNewColCount, aNewRowCount: Integer; FixEditor: boolean=true);
5381 var
5382 NewCol,NewRow: Integer;
5383 begin
5384 if HandleAllocated then begin
5385 if Col >= aNewColCount then NewCol := aNewColCount-1
5386 else NewCol := Col;
5387 if Row >= aNewRowCount then NewRow := aNewRowCount-1
5388 else NewRow := Row;
5389 if (NewCol>=0) and (NewRow>=0) and ((NewCol <> Col) or (NewRow <> Row)) then
5390 begin
5391 CheckTopleft(NewCol, NewRow , NewCol<>Col, NewRow<>Row);
5392 if FixEditor and (aNewColCount<>FFixedCols) and (aNewRowCount<>FFixedRows) then
5393 MoveNextSelectable(false, NewCol, NewRow);
5394 end;
5395 end;
5396 end;
5397
5398 procedure TCustomGrid.CheckIndex(IsColumn: Boolean; Index: Integer);
5399 begin
5400 if (IsColumn and not IsColumnIndexValid(Index)) or
5401 (not IsColumn and not IsRowIndexValid(Index)) then
5402 raise EGridException.Create(rsGridIndexOutOfRange);
5403 end;
5404
CheckTopLeftnull5405 function TCustomGrid.CheckTopLeft(aCol,aRow: Integer; CheckCols, CheckRows: boolean): boolean;
5406 var
5407 OldTopLeft: TPoint;
5408 W: Integer;
5409 begin
5410 OldTopLeft := FTopLeft;
5411 Result := False;
5412
5413 if CheckCols and (FTopleft.X > FixedCols) then begin
5414 W := FGCache.ScrollWidth-ColWidths[aCol]-FGCache.AccumWidth[aCol];
5415 while (FTopleft.x > FixedCols)
5416 and (W+FGCache.AccumWidth[FTopleft.x] >= ColWidths[FTopleft.x-1]) do
5417 Dec(FTopleft.x);
5418 end;
5419
5420 if CheckRows and (FTopleft.Y > FixedRows) then begin
5421 W := FGCache.ScrollHeight-RowHeights[aRow]-FGCache.AccumHeight[aRow];
5422 while (FTopleft.y > FixedRows)
5423 and (W+FGCache.AccumHeight[FTopleft.y] >= RowHeights[FTopleft.y-1]) do
5424 Dec(FTopleft.y);
5425 //DebugLn('TCustomGrid.CheckTopLeft A ',DbgSName(Self),' FTopLeft=',dbgs(FTopLeft));
5426 end;
5427
5428 Result := not PointIgual(OldTopleft,FTopLeft);
5429 if Result then
5430 doTopleftChange(False)
5431 end;
5432
GetQuickColRownull5433 function TCustomGrid.GetQuickColRow: TPoint;
5434 begin
5435 result.x := Col;
5436 result.y := Row;
5437 end;
5438
5439 procedure TCustomGrid.SetQuickColRow(AValue: TPoint);
5440 begin
5441 if (AValue.x=FCol) and (AValue.y=FRow) then Exit;
5442 if not AllowOutboundEvents then
5443 CheckLimitsWithError(AValue.x, AValue.y);
5444 SetColRow(aValue.x, aValue.y, true);
5445 end;
5446
5447 procedure TCustomGrid.doPushCell;
5448 begin
5449 with FGCache do
5450 begin
5451 PushedCell := ClickCell;
5452 ClickCellPushed:=True;
5453 InvalidateCell(PushedCell.x, PushedCell.y);
5454 end;
5455 end;
5456
IsCellButtonColumnnull5457 function TCustomGrid.IsCellButtonColumn(ACell: TPoint): boolean;
5458 var
5459 Column: TGridColumn;
5460 begin
5461 Column := ColumnFromGridColumn(ACell.X);
5462 result := (Column<>nil) and (Column.ButtonStyle=cbsButtonColumn) and
5463 (ACell.y>=FixedRows);
5464 end;
5465
GetIsCellTitlenull5466 function TCustomGrid.GetIsCellTitle(aCol, aRow: Integer): boolean;
5467 begin
5468 result := (FixedRows>0) and (aRow=0) {and Columns.Enabled} and (aCol>=FirstGridColumn);
5469 // Columns.Enabled removed in order to allow sort arrows also without columns
5470 end;
5471
GetIsCellSelectednull5472 function TCustomGrid.GetIsCellSelected(aCol, aRow: Integer): boolean;
5473 var
5474 i: Integer;
5475 begin
5476 Result:= (FRange.Left<=aCol) and
5477 (aCol<=FRange.Right) and
5478 (FRange.Top<=aRow) and
5479 (aRow<=FRange.Bottom);
5480
5481 if not Result and (goRangeSelect in FOptions) and (RangeSelectMode = rsmMulti)
5482 then
5483 for i:=0 to High(FSelections) do
5484 if (FSelections[i].Left <= aCol) and
5485 (ACol <= FSelections[i].Right) and
5486 (FSelections[i].Top <= ARow) and
5487 (ARow <= FSelections[i].Bottom)
5488 then begin
5489 Result := true;
5490 exit;
5491 end;
5492 end;
5493
IsEmptyRownull5494 function TCustomGrid.IsEmptyRow(ARow: Integer): Boolean;
5495 var
5496 i: Integer;
5497 begin
5498 Result := False;
5499 for i:=FixedCols to ColCount-1 do
5500 if GetCells(i, ARow)<>'' then begin
5501 Exit;
5502 end;
5503 Result := True;
5504 end;
5505
GetDefColWidthnull5506 function TCustomGrid.GetDefColWidth: Integer;
5507 begin
5508 if FDefColWidth<0 then
5509 begin
5510 if FRealizedDefColWidth <= 0 then
5511 FRealizedDefColWidth := Scale96ToFont(DEFCOLWIDTH);
5512 Result := FRealizedDefColWidth;
5513 end else
5514 Result := FDefColWidth;
5515 end;
5516
GetDefRowHeightnull5517 function TCustomGrid.GetDefRowHeight: Integer;
5518 begin
5519 if FDefRowHeight<0 then
5520 begin
5521 if FRealizedDefRowHeight <= 0 then
5522 FRealizedDefRowHeight := GetDefaultRowHeight;
5523 Result := FRealizedDefRowHeight;
5524 end else
5525 Result := FDefRowHeight;
5526 end;
5527
GetSelectedColumnnull5528 function TCustomGrid.GetSelectedColumn: TGridColumn;
5529 begin
5530 Result := ColumnFromGridColumn(Col);
5531 end;
5532
IsAltColorStorednull5533 function TCustomGrid.IsAltColorStored: boolean;
5534 begin
5535 result := FAlternateColor <> Color;
5536 end;
5537
5538 procedure TCustomGrid.SetAlternateColor(const AValue: TColor);
5539 begin
5540 if FAlternateColor=AValue then exit;
5541 FAlternateColor:=AValue;
5542 Invalidate;
5543 end;
5544
GetEditorBorderStylenull5545 function TCustomGrid.GetEditorBorderStyle: TBorderStyle;
5546 begin
5547 result := bsSingle;
5548 if FEditor = FStringEditor then
5549 Result := FStringEditor.BorderStyle
5550 else if FEditor = FPickListEditor then
5551 Result := FPickListEditor.BorderStyle;
5552 end;
5553
GetBorderWidthnull5554 function TCustomGrid.GetBorderWidth: Integer;
5555 begin
5556 if InternalNeedBorder then
5557 Result := 1
5558 else
5559 Result := 0
5560 end;
5561
5562 procedure TCustomGrid.GetTitleImageInfo(aColumnIndex: Integer; out
5563 ImgIndex: Integer; out ImgLayout: TButtonLayout);
5564 var
5565 c: TGridColumn;
5566 ResName: string;
5567 begin
5568 c := ColumnFromGridColumn(AColumnIndex);
5569 if (c <> nil) and (FTitleImageList <> nil) and InRange(c.Title.FImageIndex, 0, FTitleImageList.Count - 1) then
5570 begin
5571 ImgIndex := c.Title.FImageIndex;
5572 ImgLayout := c.Title.ImageLayout;
5573 end else
5574 begin
5575 ImgIndex := -1;
5576 ImgLayout := blGlyphRight;
5577 end;
5578 if IsRightToLeft then begin
5579 if ImgLayout = blGlyphRight then
5580 ImgLayout := blGlyphLeft
5581 else if ImgLayout = blGlyphLeft then
5582 ImgLayout := blGlyphRight;
5583 end;
5584 end;
5585
5586 procedure TCustomGrid.GetSortTitleImageInfo(aColumnIndex: Integer; out
5587 ImgList: TCustomImageList; out ImgIndex, ImgListWidth: Integer; out
5588 NativeSortGlyphs: Boolean);
5589 var
5590 ResName: string;
5591 begin
5592 NativeSortGlyphs := False;
5593 ImgIndex := -1;
5594 ImgList := nil;
5595 ImgListWidth := 0;
5596
5597 if aColumnIndex<>FSortColumn then
5598 Exit;
5599
5600 if (FTitleImageList<>nil) and (FSortOrder=soAscending) and (FAscImgInd>=0) then
5601 begin
5602 ImgList := FTitleImageList;
5603 ImgListWidth := FTitleImageListWidth;
5604 ImgIndex := FAscImgInd;
5605 end else
5606 if (FTitleImageList<>nil) and (FSortOrder=soDescending) and (FDescImgInd>=0) then
5607 begin
5608 ImgList := FTitleImageList;
5609 ImgListWidth := FTitleImageListWidth;
5610 ImgIndex := FDescImgInd;
5611 end else
5612 begin
5613 if FSortLCLImages=nil then
5614 begin
5615 FSortLCLImages := TLCLGlyphs.Create(Self);
5616 FSortLCLImages.Width := 8;
5617 FSortLCLImages.Height := 8;
5618 FSortLCLImages.RegisterResolutions([8, 12, 16]);
5619 FSortLCLImages.SetWidth100Suffix(16);
5620 end;
5621 ImgList := FSortLCLImages;
5622 case FSortOrder of
5623 soAscending: ResName := 'sortasc';
5624 soDescending: ResName := 'sortdesc';
5625 end;
5626 ImgIndex := FSortLCLImages.GetImageIndex(ResName);
5627 NativeSortGlyphs := FTitleStyle = tsNative;
5628 end;
5629 end;
5630
5631 procedure TCustomGrid.GetImageForCheckBox(const aCol, aRow: Integer;
5632 CheckBoxView: TCheckBoxState; var ImageList: TCustomImageList;
5633 var ImageIndex: TImageIndex; var Bitmap: TBitmap);
5634 begin
5635 if Assigned(OnUserCheckboxBitmap) then
5636 OnUserCheckboxBitmap(Self, aCol, aRow, CheckBoxView, Bitmap);
5637 if (Bitmap = nil) and Assigned(OnUserCheckBoxImage) then
5638 OnUserCheckboxImage(Self, aCol, aRow, CheckBoxView, ImageList, ImageIndex);
5639 end;
5640
5641 procedure TCustomGrid.AdjustInnerCellRect(var ARect: TRect);
5642 begin
5643 if (GridLineWidth>0) then begin
5644 if goHorzLine in Options then Dec(ARect.Bottom);
5645 if goVertLine in Options then Dec(ARect.Right);
5646 end;
5647 end;
5648
GetColumnsnull5649 function TCustomGrid.GetColumns: TGridColumns;
5650 begin
5651 result := FColumns;
5652 end;
5653
CreateColumnsnull5654 function TCustomGrid.CreateColumns: TGridColumns;
5655 begin
5656 result := TGridColumns.Create(Self, TGridColumn);
5657 end;
5658
5659 procedure TCustomGrid.CheckNewCachedSizes(var AGCache:TGridDataCache);
5660 begin
5661
5662 end;
5663
5664 procedure TCustomGrid.SetAutoFillColumns(const AValue: boolean);
5665 begin
5666 FAutoFillColumns := AValue;
5667 if FAutoFillColumns then begin
5668 VisualChange;
5669 if FTopleft.x<>FixedCols then begin
5670 FTopLeft.x := FixedCols;
5671 TopLeftChanged;
5672 end;
5673 end;
5674 end;
5675
5676 procedure TCustomGrid.SetBorderColor(const AValue: TColor);
5677 begin
5678 if FBorderColor=AValue then exit;
5679 FBorderColor:=AValue;
5680 if BorderStyle<>bsNone then
5681 Invalidate;
5682 end;
5683
5684 procedure TCustomGrid.SetColumnClickSorts(const AValue: boolean);
5685 begin
5686 if FColumnClickSorts=AValue then exit;
5687 FColumnClickSorts:=AValue;
5688 end;
5689
5690 procedure TCustomGrid.SetColumns(const AValue: TGridColumns);
5691 begin
5692 FColumns.Assign(Avalue);
5693 end;
5694
5695 procedure TCustomGrid.SetEditorOptions(const AValue: Integer);
5696 begin
5697 if FEditorOptions<>AValue then begin
5698 if FEditor=nil then exit;
5699 FEditorOptions:=AValue;
5700
5701 if FEditorOptions and EO_HOOKKEYDOWN = EO_HOOKKEYDOWN then begin
5702 FEditor.OnKeyDown:=@EditorKeyDown;
5703 end;
5704 if FEditorOptions and EO_HOOKKEYPRESS = EO_HOOKKEYPRESS then begin
5705 FEditor.OnKeyPress := @EditorKeyPress;
5706 FEditor.OnUTF8KeyPress := @EditorUTF8KeyPress;
5707 end;
5708 if FEditorOptions and EO_HOOKKEYUP = EO_HOOKKEYUP then begin
5709 FEditor.OnKeyUp := @EditorKeyUp;
5710 end;
5711
5712 {$IfDef DbgGrid}
5713 DBGOut('EditorOptions ',FEditor.Name,' ');
5714 if FEditorOptions and EO_AUTOSIZE = EO_AUTOSIZE then DBGOut('EO_AUTOSIZE ');
5715 if FEditorOptions and EO_HOOKKEYDOWN = EO_HOOKKEYDOWN then DBGOut('EO_HOOKKEYDOWN ');
5716 if FEditorOptions and EO_HOOKKEYPRESS = EO_HOOKKEYPRESS then DBGOut('EO_HOOKKEYPRESS ');
5717 if FEditorOptions and EO_HOOKKEYUP = EO_HOOKKEYUP then DBGOut('EO_HOOKKEYUP ');
5718 if FEditorOptions and EO_SELECTALL= EO_SELECTALL then DBGOut('EO_SELECTALL ');
5719 DebugLn;
5720 {$Endif}
5721 end;
5722 end;
5723
5724 procedure TCustomGrid.SetEditorBorderStyle(const AValue: TBorderStyle);
5725 begin
5726 // supposedly instances cannot access protected properties
5727 // of parent classes, so why the next works?
5728 {
5729 if FEditor.BorderStyle <> AValue then begin
5730 FEditor.BorderStyle := AValue;
5731 if EditorMode then
5732 EditorPos;
5733 end;
5734 }
5735 if FStringEditor.BorderStyle<>AValue then begin
5736 FStringEditor.BorderStyle := AValue;
5737 if (FEditor = FStringEditor) and EditorMode then
5738 EditorPos;
5739 end;
5740 if FPicklistEditor.BorderStyle<>AValue then begin
5741 FPicklistEditor.BorderStyle := AValue;
5742 if (FEditor = FPicklistEditor) and EditorMode then
5743 EditorPos;
5744 end;
5745 end;
5746
5747 procedure TCustomGrid.SetAltColorStartNormal(const AValue: boolean);
5748 begin
5749 if FAltColorStartNormal=AValue then exit;
5750 FAltColorStartNormal:=AValue;
5751 if IsAltColorStored then
5752 Invalidate;
5753 end;
5754
5755 procedure TCustomGrid.SetFlat(const AValue: Boolean);
5756 begin
5757 if FFlat=AValue then exit;
5758 FFlat:=AValue;
5759 if FGridBorderStyle=bsSingle then
5760 UpdateBorderStyle
5761 else
5762 Invalidate;
5763 end;
5764
5765 procedure TCustomGrid.SetFocusRectVisible(const AValue: Boolean);
5766 begin
5767 if FFocusRectVisible<>AValue then begin
5768 FFocusRectVisible := AValue;
5769 Invalidate;
5770 end;
5771 end;
5772
5773 procedure TCustomGrid.SetTitleFont(const AValue: TFont);
5774 begin
5775 FTitleFont.Assign(AValue);
5776 VisualChange;
5777 end;
5778
5779 procedure TCustomGrid.SetTitleImageList(const AValue: TImageList);
5780 begin
5781 if FTitleImageList = AValue then exit;
5782 FTitleImageList := AValue;
5783 VisualChange;
5784 end;
5785
5786 procedure TCustomGrid.SetTitleImageListWidth(
5787 const aTitleImageListWidth: Integer);
5788 begin
5789 if FTitleImageListWidth = aTitleImageListWidth then Exit;
5790 FTitleImageListWidth := aTitleImageListWidth;
5791 VisualChange;
5792 end;
5793
5794 procedure TCustomGrid.SetTitleStyle(const AValue: TTitleStyle);
5795 begin
5796 if FTitleStyle=AValue then exit;
5797 FTitleStyle:=AValue;
5798 Invalidate;
5799 end;
5800
5801 procedure TCustomGrid.SetUseXorFeatures(const AValue: boolean);
5802 begin
5803 if FUseXORFeatures=AValue then exit;
5804 FUseXORFeatures:=AValue;
5805 Invalidate;
5806 end;
5807
5808 procedure TCustomGrid.SetBorderStyle(NewStyle: TBorderStyle);
5809 begin
5810 if FGridBorderStyle<>NewStyle then begin
5811 FGridBorderStyle := NewStyle;
5812 UpdateBorderStyle;
5813 end;
5814 end;
5815
5816 { Save to the cache the current visible grid (excluding fixed cells) }
5817 procedure TCustomGrid.CacheVisibleGrid;
5818 var
5819 CellR: TRect;
5820 begin
5821 with FGCache do begin
5822 VisibleGrid:=GetVisibleGrid;
5823 with VisibleGrid do begin
5824 ValidRows := (left>=0) and (Right>=Left) and (ColCount>0) and (RowCount>0);
5825 ValidCols := (top>=0) and (bottom>=Top) and (ColCount>0) and (RowCount>0);
5826 ValidGrid := ValidRows and ValidCols;
5827 end;
5828 FullVisibleGrid := VisibleGrid;
5829 if ValidGrid then begin
5830 if GetSmoothScroll(SB_Horz) and (TLColOff>0) then
5831 FullVisibleGrid.Left := Min(FullVisibleGrid.Left+1, FullVisibleGrid.Right);
5832 if GetSmoothScroll(SB_Vert) and (TLRowOff>0) then
5833 FullVisibleGrid.Top := Min(FullVisibleGrid.Top+1, FullVisibleGrid.Bottom);
5834
5835 CellR := CellRect(FullVisibleGrid.Right, FullVisibleGrid.Bottom);
5836 if CellR.Right>(ClientWidth+GetBorderWidth) then
5837 FullVisibleGrid.Right := Max(FullVisibleGrid.Right-1, FullVisibleGrid.Left);
5838 if CellR.Bottom>(ClientHeight+GetBorderWidth) then
5839 FullVisibleGrid.Bottom := Max(FullVisibleGrid.Bottom-1, FullVisibleGrid.Top);
5840 end;
5841 end;
5842 end;
5843
5844 procedure TCustomGrid.CancelSelection;
5845 begin
5846 if (FRange.Bottom-FRange.Top>0) or
5847 ((FRange.Right-FRange.Left>0) and not (goRowSelect in Options)) then begin
5848 InvalidateRange(FRange);
5849 if goRowSelect in Options then
5850 FRange:=Rect(FFixedCols, FRow, ColCount-1, FRow)
5851 else
5852 FRange:=Rect(FCol,FRow,FCol,FRow);
5853 end;
5854 SelectActive := False;
5855 end;
5856
GetSelectedRangenull5857 function TCustomGrid.GetSelectedRange(AIndex: Integer): TGridRect;
5858 begin
5859 if AIndex >= Length(FSelections) then
5860 Result := FRange
5861 else
5862 Result := FSelections[AIndex];
5863 end;
5864
GetSelectedRangeCountnull5865 function TCustomGrid.GetSelectedRangeCount: Integer;
5866 begin
5867 Result := Length(FSelections) + 1;
5868 // add 1 because the current selection (FRange) is not stored in the array
5869 end;
5870
GetSelectionnull5871 function TCustomGrid.GetSelection: TGridRect;
5872 begin
5873 Result:=FRange;
5874 end;
5875
GetSpecialCursornull5876 function TCustomGrid.GetSpecialCursor(ACursorState: TGridCursorState): TCursor;
5877 begin
5878 Result := FSpecialCursors[ACursorState];
5879 end;
5880
GetSmoothScrollnull5881 function TCustomGrid.GetSmoothScroll(Which: Integer): Boolean;
5882 begin
5883 Result := goSmoothScroll in Options;
5884 end;
5885
5886 procedure TCustomGrid.SetColRowDragIndicatorColor(const AValue: TColor);
5887 begin
5888 if FColRowDragIndicatorColor = AValue then exit;
5889 FColRowDragIndicatorColor := AValue;
5890 if FGridState = gsColMoving then
5891 DrawColRowMoving;
5892 end;
5893
5894 procedure TCustomGrid.SetDefaultDrawing(const AValue: Boolean);
5895 begin
5896 if FDefaultDrawing=AValue then exit;
5897 FDefaultDrawing:=AValue;
5898 Invalidate;
5899 end;
5900
5901 procedure TCustomGrid.SetFocusColor(const AValue: TColor);
5902 begin
5903 if FFocusColor=AValue then exit;
5904 FFocusColor:=AValue;
5905 InvalidateCell(FCol,FRow);
5906 end;
5907
5908 procedure TCustomGrid.SetGridLineStyle(const AValue: TPenStyle);
5909 begin
5910 if FGridLineStyle=AValue then exit;
5911 FGridLineStyle:=AValue;
5912 Invalidate;
5913 end;
5914
5915 procedure TCustomGrid.SetSelectActive(const AValue: Boolean);
5916 begin
5917 if FSelectActive=AValue then exit;
5918 FSelectActive:=AValue and
5919 (not EditingAllowed(FCol) or (ExtendedSelect and not EditorAlwaysShown));
5920 if FSelectActive then FPivot:=Point(FCol,FRow);
5921 end;
5922
5923 procedure TCustomGrid.SetSelection(const AValue: TGridRect);
5924 begin
5925 if goRangeSelect in Options then
5926 begin
5927 if (AValue.Left<0)and(AValue.Top<0)and(AValue.Right<0)and(AValue.Bottom<0) then
5928 CancelSelection
5929 else begin
5930 fRange:=NormalizarRect(aValue);
5931 if fRange.Right>=ColCount then fRange.Right:=ColCount-1;
5932 if fRange.Bottom>=RowCount then fRange.Bottom:=RowCount-1;
5933 if fRange.Left<FixedCols then fRange.Left := FixedCols;
5934 if fRange.Top<FixedRows then fRange.Top := FixedRows;
5935 if goSelectionActive in Options then begin
5936 FPivot := FRange.TopLeft;
5937 FSelectActive := True;
5938 MoveExtend(false, FRange.Right, FRange.Bottom, True);
5939 end;
5940 Invalidate;
5941 end;
5942 end;
5943 end;
5944
5945 procedure TCustomGrid.SetSpecialCursor(ACursorState: TGridCursorState;
5946 const AValue: TCursor);
5947 begin
5948 if AValue = GetSpecialCursor(ACursorState) then
5949 exit;
5950 FSpecialCursors[ACursorState] := AValue;
5951 if FCursorState <> gcsDefault then
5952 ChangeCursor(AValue, false);
5953 end;
5954
doColSizingnull5955 function TCustomGrid.doColSizing(X, Y: Integer): Boolean;
5956 var
5957 Offset: Integer;
5958
5959 procedure FindPrevColumn;
5960 begin
5961 Dec(FSizing.Index);
5962 while (FSizing.Index>FixedCols) and (ColWidths[FSizing.Index]=0) do
5963 Dec(FSizing.Index);
5964 end;
5965
5966 begin
5967 Result:=False;
5968
5969 with FSizing do
5970 if gsColSizing = fGridState then begin
5971
5972 if not (gfSizingStarted in FGridFlags) then
5973 if not StartColSizing(X,Y) then
5974 exit;
5975 Include(FGridFlags, gfSizingStarted);
5976
5977 if FUseXORFeatures then begin
5978
5979 if UseRightToLeftAlignment then begin
5980 if (OffEnd - x) <=0 then
5981 x:= OffEnd;
5982 end
5983 else
5984 if (X-OffIni)<=0 then
5985 X := OffIni;
5986
5987 if X<>PrevOffset then begin
5988 if PrevLine then
5989 DrawXorVertLine(PrevOffset);
5990 DrawXorVertLine(X);
5991 PrevLine:=True;
5992 PrevOffset:=X;
5993 end;
5994
5995 end else begin
5996 if UseRightToLeftAlignment then
5997 ResizeColumn(Index, OffEnd - X + DeltaOff)
5998 else
5999 ResizeColumn(Index, X - OffIni + DeltaOff);
6000 end;
6001 HeaderSizing(true, Index, X - OffIni + DeltaOff);
6002 exit(true);
6003 end else
6004 if (fGridState=gsNormal) and
6005 ((Y<FGCache.FixedHeight) or (FExtendedColSizing and (Y<FGCache.MaxClientXY.Y))) and
6006 ((goFixedColSizing in Options) or ((ColCount>FixedCols) and (FlipX(X)>FGCache.FixedWidth)))
6007 then begin
6008
6009 // find closest cell and cell boundaries
6010 if (FlipX(X)>FGCache.GridWidth-1) then
6011 Index := ColCount-1
6012 else
6013 OffsetToColRow(True, True, X, Index, Offset);
6014 ColRowToOffset(True, true, Index, OffIni, OffEnd);
6015
6016 if OffEnd>FGCache.ClientWidth then
6017 Offset := FGCache.ClientWidth
6018 else if (OffEnd-X)<(X-OffIni) then begin
6019 Offset := OffEnd;
6020 if UseRightToLeftAlignment then
6021 FindPrevColumn;
6022 end else begin
6023 Offset := OffIni;
6024 if not UseRightToLeftAlignment then
6025 FindPrevColumn;
6026 end;
6027
6028 // check if cursor is near boundary and it's a valid column
6029 if (Abs(Offset-x)<=varColRowBorderTolerance) then begin
6030 if goFixedColSizing in Options then
6031 Offset := 0
6032 else
6033 Offset := FFixedCols;
6034 if Index>=Offset then begin
6035 // start resizing
6036 if FCursorState<>gcsColWidthChanging then begin
6037 PrevLine := false;
6038 PrevOffset := -1;
6039 ChangeCursor(ColSizingCursor);
6040 FCursorState := gcsColWidthChanging;
6041 end;
6042 exit(true);
6043 end;
6044 end;
6045
6046 end;
6047
6048 if (FCursorState=gcsColWidthChanging) then
6049 RestoreCursor;
6050 end;
6051
TCustomGrid.doRowSizingnull6052 function TCustomGrid.doRowSizing(X, Y: Integer): Boolean;
6053 var
6054 Offset: Integer;
6055 begin
6056 Result:=False;
6057
6058 with FSizing do
6059 if gsRowSizing = fGridState then begin
6060 if FUseXORFeatures then begin
6061 if (y-OffIni)<=0 then
6062 y:= OffIni;
6063 if y<>PrevOffset then begin
6064 if PrevLine then
6065 DrawXorHorzLine(PrevOffset);
6066 DrawXorHorzLine(Y);
6067 PrevLine:=True;
6068 PrevOffset:=y;
6069 end;
6070 end else
6071 ResizeRow(Index, y-OffIni);
6072 HeaderSizing(false, Index, y-OffIni);
6073 exit(true);
6074 end else
6075 if (fGridState=gsNormal) and (RowCount>FixedRows) and
6076 ((FlipX(X)<FGCache.FixedWidth) or
6077 (FExtendedRowSizing and (FlipX(X)<FGCache.MaxClientXY.X))) and
6078 (Y>FGCache.FixedHeight) then
6079 begin
6080
6081 // find closest cell and cell boundaries
6082 if Y>FGCache.GridHeight-1 then
6083 Index := RowCount-1
6084 else
6085 OffsetToColRow(False, True, Y, Index, OffEnd{dummy});
6086 ColRowToOffset(False, True, Index, OffIni, OffEnd);
6087
6088 // find out what cell boundary is closer to Y
6089 if OffEnd>FGCache.ClientHeight then
6090 Offset := FGCache.ClientHeight
6091 else
6092 if (OffEnd-Y)<(Y-OffIni) then
6093 Offset := OffEnd
6094 else begin
6095 Offset := OffIni;
6096 Dec(Index);
6097 ColRowToOffset(False, True, Index, OffIni, OffEnd);
6098 end;
6099
6100 // check if it's not fixed row and if cursor is close enough to
6101 // selected boundary
6102 if (Index>=FFixedRows)and(Abs(Offset-Y)<=varColRowBorderTolerance) then begin
6103 // start resizing
6104 if FCursorState<>gcsRowHeightChanging then begin
6105 ChangeCursor(RowSizingCursor);
6106 FCursorState := gcsRowHeightChanging;
6107 PrevLine := False;
6108 PrevOffset := -1;
6109 end;
6110 exit(true);
6111 end
6112
6113 end;
6114
6115 if (FCursorState=gcsRowHeightChanging) then
6116 RestoreCursor;
6117 end;
6118
6119 procedure TCustomGrid.doColMoving(X, Y: Integer);
6120 var
6121 CurCell: TPoint;
6122 R: TRect;
6123 begin
6124 CurCell:=MouseToCell(Point(X,Y));
6125
6126 with FGCache do begin
6127
6128 if (Abs(ClickMouse.X-X)>FDragDX) and (FCursorState<>gcsDragging) then begin
6129 ChangeCursor(ColRowDraggingCursor);
6130 FCursorState := gcsDragging;
6131 ResetLastMove;
6132 end;
6133
6134 if (FCursorState=gcsDragging) and
6135 (CurCell.X>=FFixedCols) and
6136 ((CurCell.X<=ClickCell.X) or (CurCell.X>ClickCell.X)) and
6137 (CurCell.X<>FMoveLast.X) then begin
6138
6139 R := CellRect(CurCell.X, CurCell.Y);
6140 if CurCell.X<=ClickCell.X then
6141 FMoveLast.Y := R.Left
6142 else
6143 FMoveLast.Y := R.Right;
6144
6145 FMoveLast.X := CurCell.X;
6146 {$ifdef AlternativeMoveIndicator}
6147 InvalidateRow(0);
6148 {$else}
6149 Invalidate;
6150 {$endif}
6151 end;
6152 end;
6153 end;
6154
6155 procedure TCustomGrid.doRowMoving(X, Y: Integer);
6156 var
6157 CurCell: TPoint;
6158 R: TRect;
6159 begin
6160 CurCell:=MouseToCell(Point(X,Y));
6161
6162 with FGCache do begin
6163
6164 if (FCursorState<>gcsDragging) and (Abs(ClickMouse.Y-Y)>FDragDX) then begin
6165 ChangeCursor(ColRowDraggingCursor);
6166 FCursorState := gcsDragging;
6167 ResetLastMove;
6168 end;
6169
6170 if (FCursorState=gcsDragging)and
6171 (CurCell.Y>=FFixedRows) and
6172 ((CurCell.Y<=ClickCell.Y) or (CurCell.Y>ClickCell.Y))and
6173 (CurCell.Y<>FMoveLast.Y) then begin
6174
6175 R:=CellRect(CurCell.X, CurCell.Y);
6176 if CurCell.Y<=ClickCell.Y then
6177 FMoveLast.X:=R.Top
6178 else
6179 FMoveLast.X:=R.Bottom;
6180 FMoveLast.Y:=CurCell.Y;
6181 Invalidate;
6182 end;
6183 end;
6184 end;
6185
6186
OffsetToColRownull6187 function TCustomGrid.OffsetToColRow(IsCol, Physical: Boolean; Offset: Integer;
6188 out Index, Rest: Integer): Boolean;
6189 begin
6190 Index:=0;
6191 Rest:=0;
6192 Result := False;
6193 if IsCol and UseRightToLeftAlignment then
6194 Offset := FlipX(Offset);
6195 Offset := Offset - GetBorderWidth;
6196 if Offset<0 then Exit; // Out of Range;
6197
6198 with FGCache do begin
6199 if IsCol then begin
6200 // begin to count Cols from 0 but ...
6201 if Physical and (Offset>FixedWidth-1) then begin
6202 Index := FTopLeft.X; // In scrolled view, then begin from FTopLeft col
6203 if IsColumnIndexValid(Index) then begin
6204 Offset:=Offset-FixedWidth+AccumWidth[Index];
6205 if GetSmoothScroll(SB_Horz) then
6206 Offset:=Offset+TLColOff;
6207 end;
6208 if not IsColumnIndexValid(Index) or (Offset>GridWidth-1) then begin
6209 if AllowOutboundEvents then
6210 Index := ColCount-1
6211 else
6212 Index := -1;
6213 exit;
6214 end;
6215 end;
6216
6217 while Offset > AccumWidth[Index]+GetColWidths(Index)-1 do begin
6218 Inc(Index);
6219 if not IsColumnIndexValid(Index) then begin
6220 if AllowOutBoundEvents then
6221 Index := ColCount-1
6222 else
6223 Index := -1;
6224 exit;
6225 end;
6226 end;
6227
6228 Rest:=Offset;
6229 if Index<>0 then
6230 Rest:=Offset-AccumWidth[Index];
6231
6232 end else begin
6233
6234 //DebugLn('TCustomGrid.OffsetToColRow ',DbgSName(Self),' Physical=',dbgs(Physical),' Offset=',dbgs(Offset),' FixedHeight=',dbgs(FixedHeight),' FTopLeft=',dbgs(FTopLeft),' RowCount=',dbgs(RowCount),' TLRowOff=',dbgs(TLRowOff));
6235 if Physical and (Offset>FixedHeight-1) then begin
6236 Index:=FTopLeft.Y;
6237 if IsRowIndexValid(Index) then
6238 Offset:=Offset-FixedHeight+AccumHeight[Index]+TLRowOff;
6239 if not IsRowIndexValid(Index) or (Offset>GridHeight-1) then begin
6240 if AllowOutboundEvents then
6241 Index := RowCount-1
6242 else
6243 Index := -1;
6244 Exit; // Out of Range
6245 end;
6246 end;
6247
6248 while Offset > AccumHeight[Index]+GetRowHeights(Index)-1 do
6249 Inc(Index);
6250
6251 Rest:=Offset;
6252 if Index<>0 then
6253 Rest:=Offset-AccumHeight[Index];
6254
6255 end;
6256 end;
6257 result := True;
6258 end;
6259
6260 { ------------------------------------------------------------------------------
6261 Example:
6262 IsCol=true, Index:=100, TopLeft.x:=98, FixedCols:=1, all ColWidths:=20
6263 Relative => StartPos := WidthfixedCols+WidthCol98+WidthCol99
6264 not Relative = Absolute => StartPos := WidthCols(0..99) }
ColRowToOffsetnull6265 function TCustomGrid.ColRowToOffset(IsCol, Relative: Boolean; Index: Integer;
6266 out StartPos, EndPos: Integer): Boolean;
6267 var
6268 Dim: Integer;
6269 begin
6270 Result:=false;
6271 with FGCache do begin
6272 if IsCol then begin
6273 if not IsColumnIndexValid(Index) then
6274 exit;
6275 StartPos:=AccumWidth[index];
6276 Dim:=GetColWidths(index);
6277 end else begin
6278 if not IsRowIndexValid(Index) then
6279 exit;
6280 StartPos:=AccumHeight[index];
6281 Dim:= GetRowHeights(index);
6282 end;
6283 StartPos := StartPos + GetBorderWidth;
6284 if not Relative then begin
6285 EndPos:=StartPos + Dim;
6286 Exit;
6287 end;
6288 if IsCol then begin
6289 if IsColumnIndexVariable(Index) then begin
6290 StartPos:=StartPos-AccumWidth[FTopLeft.X] + FixedWidth;
6291 if GetSmoothScroll(SB_Horz) then
6292 StartPos := StartPos - TLColOff;
6293 end;
6294 end else begin
6295 if IsRowIndexVariable(Index) then begin
6296 StartPos:=StartPos-AccumHeight[FTopLeft.Y] + FixedHeight;
6297 if GetSmoothScroll(SB_Vert) then
6298 StartPos := StartPos - TLRowOff;
6299 end;
6300 end;
6301 if IsCol and UseRightToLeftAlignment then
6302 begin
6303 EndPos := FlipX(StartPos) + 1;
6304 StartPos := EndPos - Dim;
6305 end
6306 else
6307 EndPos:=StartPos + Dim;
6308 end;
6309 Result:=true;
6310 end;
6311
ColumnIndexFromGridColumnnull6312 function TCustomGrid.ColumnIndexFromGridColumn(Column: Integer): Integer;
6313 begin
6314 if Columns.Enabled and (Column>=FirstGridColumn) then
6315 result := Columns.RealIndex(Column - FirstGridColumn)
6316 else
6317 result := -1;
6318 end;
6319
ColumnFromGridColumnnull6320 function TCustomGrid.ColumnFromGridColumn(Column: Integer): TGridColumn;
6321 var
6322 ColIndex: Integer;
6323 begin
6324 ColIndex := ColumnIndexFromGridColumn(Column);
6325 if ColIndex>=0 then
6326 result := Columns[ColIndex]
6327 else
6328 result := nil;
6329 end;
6330
6331 procedure TCustomGrid.ColumnsChanged(aColumn: TGridColumn);
6332 var
6333 aCol: Integer;
6334 begin
6335 if csDestroying in ComponentState then
6336 exit;
6337
6338 if AColumn=nil then begin
6339 if Columns.Enabled then begin
6340 if FirstGridColumn + Columns.VisibleCount <> ColCount then
6341 InternalSetColCount( FirstGridColumn + Columns.VisibleCount )
6342 else
6343 VisualChange;
6344 end else
6345 if not (csLoading in ComponentState) then
6346 ColCount := FixedCols;
6347 end else begin
6348 aCol := Columns.IndexOf(AColumn);
6349 if ACol>=0 then begin
6350 VisualChange;
6351 {
6352 if aColumn.WidthChanged then
6353 VisualChange
6354 else
6355 InvalidateCol(FixedCols + ACol);
6356 }
6357 end;
6358 end;
6359
6360 end;
6361
MouseToGridZonenull6362 function TCustomGrid.MouseToGridZone(X, Y: Integer): TGridZone;
6363 var
6364 aBorderWidth: Integer;
6365 aCol, aRow: Longint;
6366 begin
6367 aBorderWidth := GetBorderWidth;
6368 if FlipX(X)<FGCache.FixedWidth+aBorderWidth then begin
6369 // in fixedwidth zone
6370 if Y<FGcache.FixedHeight+aBorderWidth then
6371 Result:= gzFixedCells
6372 else begin
6373 OffsetToColRow(False, True, Y, aRow, aCol);
6374 if (aRow<0) or (RowCount<=FixedRows) then
6375 Result := gzInvalid
6376 else
6377 Result := gzFixedRows;
6378 end;
6379 end
6380 else if Y<FGCache.FixedHeight+aBorderWidth then begin
6381 // if fixedheight zone
6382 if FlipX(X)<FGCache.FixedWidth+aBorderWidth then
6383 Result:=gzFixedCells
6384 else begin
6385 OffsetToColRow(True, True, X, aCol, aRow);
6386 if (aCol<0) or (ColCount<=FixedCols) then
6387 Result := gzInvalid
6388 else
6389 Result := gzFixedCols;
6390 end;
6391 end
6392 else if not FixedGrid then begin
6393 // in normal cell zone (though, might be outbounds)
6394 MouseToCell(x, y, aCol, aRow);
6395 if (aCol<0) or (aRow<0) then
6396 result := gzInvalid
6397 else
6398 result := gzNormal;
6399 end
6400 else
6401 result := gzInvalid;
6402 end;
6403
CellToGridZonenull6404 function TCustomGrid.CellToGridZone(aCol, aRow: Integer): TGridZone;
6405 begin
6406 if (aCol<0) or (aRow<0) then
6407 Result := gzInvalid
6408 else
6409 if (aCol<FFixedCols) then
6410 if aRow<FFixedRows then
6411 Result:= gzFixedCells
6412 else
6413 Result:= gzFixedRows
6414 else
6415 if (aRow<FFixedRows) then
6416 if aCol<FFixedCols then
6417 Result:= gzFixedCells
6418 else
6419 Result:= gzFixedCols
6420 else
6421 Result := gzNormal;
6422 end;
6423
6424 procedure TCustomGrid.DoOPExchangeColRow(IsColumn: Boolean; index, WithIndex: Integer);
6425 var
6426 aColRow: integer;
6427 begin
6428
6429 if IsColumn and Columns.Enabled then begin
6430 Columns.ExchangeColumn( ColumnIndexFromGridColumn(Index),
6431 ColumnIndexFromGridColumn(WithIndex));
6432 ColRowExchanged(IsColumn, index, WithIndex);
6433 exit;
6434 end;
6435 // exchanges column widths or row heights
6436 if IsColumn then
6437 FCols.Exchange(index, WithIndex)
6438 else
6439 FRows.Exchange(index, WithIndex);
6440 ColRowExchanged(IsColumn, index, WithIndex);
6441 VisualChange;
6442
6443 // adjust editor bounds
6444 if IsColumn then
6445 aColRow := FCol
6446 else
6447 aColRow := FRow;
6448
6449 if Between(aColRow, Index, WithIndex) then begin
6450 if aColRow=Index then
6451 aColRow:=WithIndex
6452 else
6453 if aColRow=WithIndex then
6454 aColRow:=Index;
6455 if IsColumn then
6456 AdjustEditorBounds(aColRow, FRow)
6457 else
6458 AdjustEditorBounds(FCol, aColRow);
6459 end;
6460
6461 // adjust sort column
6462 if IsColumn and (FSortColumn>=0) then begin
6463 if Between(FSortColumn, Index, WithIndex) then begin
6464 if FSortColumn=Index then
6465 FSortColumn := WithIndex
6466 else
6467 if FSortColumn=WithIndex then
6468 FSortColumn := Index;
6469 end;
6470 end;
6471 end;
6472
6473 procedure TCustomGrid.DoOPInsertColRow(IsColumn: boolean; index: integer);
6474 var
6475 NewCol,NewRow: Integer;
6476 begin
6477 if IsColumn and (RowCount = 0) then
6478 Raise EGridException.Create(rsGridHasNoRows);
6479 if not IsColumn then
6480 begin
6481 if (Columns.Enabled and (Columns.Count = 0)) or (not Columns.Enabled and (ColCount = 0)) then
6482 Raise EGridException.Create(rsGridHasNoCols);
6483 end;
6484
6485 if Index<0 then
6486 Index:=0;
6487
6488 NewCol := Col;
6489 NewRow := Row;
6490 if IsColumn then begin
6491 if Index>ColCount-1 then
6492 Index := ColCount-1;
6493 if Index<FixedCols then
6494 inc(FFixedCols);
6495 if columns.Enabled then begin
6496 Columns.InsertColumn(ColumnIndexFromGridColumn(index));
6497 ColRowInserted(true, index);
6498 exit;
6499 end else begin
6500 FCols.Insert(Index, -1);
6501 FGCache.AccumWidth.Insert(Index, -1);
6502 end;
6503 end else begin
6504 Frows.Insert(Index, -1);
6505 FGCache.AccumHeight.Insert(Index, -1);
6506 if Index<FixedRows then
6507 inc(FFixedRows);
6508 end;
6509 ColRowInserted(IsColumn, index);
6510 VisualChange;
6511
6512 // adjust editor bounds
6513 if IsColumn then begin
6514 if NewCol<FixedCols then
6515 NewCol := FixedCols
6516 else
6517 if Index<=NewCol then
6518 Inc(NewCol);
6519 end else begin
6520 if NewRow<FixedRows then
6521 NewRow := FixedRows
6522 else
6523 if Index<=NewRow then
6524 Inc(NewRow);
6525 end;
6526 AdjustEditorBounds(NewCol, NewRow);
6527
6528 // adjust sorted column
6529 if IsColumn and (FSortColumn>=Index) then
6530 Inc(FSortColumn);
6531 end;
6532
6533 procedure TCustomGrid.DoOPMoveColRow(IsColumn: Boolean; FromIndex,
6534 ToIndex: Integer);
6535 var
6536 aColRow: Integer;
6537 begin
6538 if FromIndex=ToIndex then
6539 exit;
6540
6541 CheckIndex(IsColumn, FromIndex);
6542 CheckIndex(IsColumn, ToIndex);
6543
6544 // move custom columns if they are not locked
6545 if IsColumn and Columns.Enabled and (not(gfColumnsLocked in FGridFlags)) then begin
6546 Columns.MoveColumn(ColumnIndexFromGridColumn(FromIndex),
6547 ColumnIndexFromGridColumn(ToIndex));
6548 // done
6549 exit;
6550 end;
6551
6552 // move grids content
6553 if IsColumn then
6554 FCols.Move(FromIndex, ToIndex)
6555 else
6556 FRows.Move(FromIndex, ToIndex);
6557 ColRowMoved(IsColumn, FromIndex, ToIndex);
6558
6559 if not IsColumn or not Columns.Enabled then
6560 VisualChange;
6561
6562 // adjust editor bounds
6563 if IsColumn then
6564 aColRow:=FCol
6565 else
6566 aColRow:=FRow;
6567 if Between(aColRow, FromIndex, ToIndex) then begin
6568 if aColRow=FromIndex then
6569 aColRow := ToIndex
6570 else
6571 if FromIndex<aColRow then
6572 aColRow := aColRow-1
6573 else
6574 aColRow := aColRow+1;
6575 if IsColumn then
6576 AdjustEditorBounds(aColRow, FRow)
6577 else
6578 AdjustEditorBounds(FCol, aColRow);
6579 end;
6580
6581 // adjust sorted column
6582 if IsColumn and (FSortColumn>=0) then
6583 if Between(FSortColumn, FromIndex, ToIndex) then begin
6584 if FSortColumn=FromIndex then
6585 FSortColumn := ToIndex
6586 else
6587 if FromIndex<FSortColumn then
6588 Dec(FSortColumn)
6589 else
6590 Inc(FSortColumn);
6591 end;
6592 end;
6593
6594 procedure TCustomGrid.DoOPDeleteColRow(IsColumn: Boolean; index: Integer);
6595
6596 procedure doDeleteColumn;
6597 var
6598 tmpIndex: Integer;
6599 begin
6600 CheckFixedCount(ColCount-1, RowCount, FFixedCols, FFixedRows);
6601 CheckCount(ColCount-1, RowCount, false);
6602
6603 // before deleteing column hide editor
6604 if EditorMode and (Index=Col) then
6605 EditorMode:=False;
6606
6607 if Columns.Enabled then
6608 tmpIndex := ColumnIndexFromGridColumn(Index);
6609
6610 if Index<FixedCols then begin
6611 Dec(FFixedCols);
6612 FTopLeft.x := FFixedCols;
6613 end;
6614
6615 FCols.Delete(Index);
6616 FGCache.AccumWidth.Delete(Index);
6617
6618 ColRowDeleted(True, Index);
6619
6620 if Columns.Enabled then
6621 Columns.RemoveColumn(tmpIndex);
6622
6623 FixPosition(True, Index);
6624 end;
6625
6626 procedure doDeleteRow;
6627 begin
6628 CheckFixedCount(ColCount, RowCount-1, FFixedCols, FFixedRows);
6629 CheckCount(ColCount, RowCount-1, false);
6630 // before deleteing row hide editor
6631 if EditorMode and (Index=Row) then
6632 EditorMode:=False;
6633 if Index<FixedRows then begin
6634 Dec(FFixedRows);
6635 FTopLeft.y := FFixedRows;
6636 end;
6637 FRows.Delete(Index);
6638 FGCache.AccumHeight.Delete(Index);
6639 ColRowDeleted(False,Index);
6640 FixPosition(False, Index);
6641
6642 If FRowAutoInserted And (Index=FixedRows+(RowCount-1)) Then
6643 FRowAutoInserted := False;
6644 end;
6645
6646 begin
6647 CheckIndex(IsColumn,Index);
6648 if IsColumn then begin
6649 doDeleteColumn;
6650 if FSortColumn=Index then
6651 FSortColumn :=-1
6652 else
6653 if FSortColumn>Index then
6654 Dec(FSortColumn);
6655 end
6656 else
6657 doDeleteRow;
6658 end;
6659
EditorByStylenull6660 function TCustomGrid.EditorByStyle(Style: TColumnButtonStyle): TWinControl;
6661 begin
6662 case Style of
6663 cbsEllipsis:
6664 Result := FButtonStringEditor;
6665 cbsButton:
6666 Result := FButtonEditor;
6667 cbsPicklist:
6668 Result := FPicklistEditor;
6669 cbsAuto:
6670 Result := FStringEditor;
6671 else {cbsNone, cbsCheckboxColumn, cbsButtonColumn:}
6672 Result := nil;
6673 end;
6674 end;
6675
6676 procedure TCustomGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
6677 Y: Integer);
6678
6679 function CheckAutoEdit: boolean;
6680 begin
6681 result := FAutoEdit and not(csNoFocus in ControlStyle) and
6682 EditingAllowed(FCol) and (FGCache.ClickCell.X=Col) and (FGCache.ClickCell.Y=Row);
6683 if result then
6684 GridFlags := GridFlags + [gfAutoEditPending];
6685 end;
6686
6687 begin
6688 inherited MouseDown(Button, Shift, X, Y);
6689
6690 if (csDesigning in componentState) or not MouseButtonAllowed(Button) then
6691 Exit;
6692
6693 {$IfDef dbgGrid}DebugLnEnter('MouseDown %s INIT',[dbgsName(self)]); {$Endif}
6694
6695 FIgnoreClick := True;
6696
6697 {$IFDEF dbgGrid}
6698 DebugLn('Mouse was in ', dbgs(FGCache.HotGridZone));
6699 {$ENDIF}
6700
6701 if not Focused and not(csNoFocus in ControlStyle) then begin
6702 SetFocus;
6703 if not Focused then begin
6704 {$ifDef dbgGrid} DebugLnExit('TCustomGrid.MouseDown EXIT: Focus not allowed'); {$Endif}
6705 exit;
6706 end;
6707 end;
6708
6709 CacheMouseDown(X,Y);
6710
6711 case FGCache.HotGridZone of
6712
6713 gzFixedCells:
6714 begin
6715 if (goColSizing in Options) and (goFixedColSizing in Options) and
6716 (FCursorState=gcsColWidthChanging) then
6717 fGridState:= gsColSizing
6718 else begin
6719 FGridState := gsHeaderClicking;
6720 if ((goHeaderPushedLook in Options) and
6721 (FGCache.HotGridZone in FHeaderPushZones)) then
6722 DoPushCell;
6723 end;
6724 end;
6725
6726 gzFixedCols:
6727 begin
6728 if (goColSizing in Options) and (FCursorState=gcsColWidthChanging) then begin
6729 fGridState:= gsColSizing;
6730 FGCache.OldMaxTopLeft := FGCache.MaxTopLeft;
6731 end
6732 else begin
6733 // ColMoving or Clicking
6734 if fGridState<>gsColMoving then begin
6735 fGridState:=gsColMoving;
6736 ResetLastMove;
6737 end;
6738
6739 if ((goHeaderPushedLook in Options) and
6740 (FGCache.HotGridZone in FHeaderPushZones)) then
6741 DoPushCell;
6742 end;
6743 end;
6744
6745 gzFixedRows:
6746 if (goRowSizing in Options) and (FCursorState=gcsRowHeightChanging) then
6747 fGridState:= gsRowSizing
6748 else begin
6749 // RowMoving or Clicking
6750 fGridState:=gsRowMoving;
6751 ResetLastMove;
6752 if ((goHeaderPushedLook in Options) and
6753 (FGCache.HotGridZone in FHeaderPushZones)) then
6754 DoPushCell;
6755 end;
6756
6757 gzNormal:
6758 begin
6759 LockEditor;
6760 FIgnoreClick := False;
6761 UnlockEditor;
6762 if IsMouseOverCellButton(X, Y) then begin
6763 StartPushCell;
6764 Exit;
6765 end else
6766 if FExtendedColSizing and
6767 (FCursorState=gcsColWidthChanging) and
6768 (goColSizing in Options) then begin
6769 // extended column sizing
6770 fGridState:= gsColSizing;
6771
6772 end
6773 else if not FixedGrid then begin
6774 // normal selecting
6775 fGridState:=gsSelecting;
6776
6777 if not EditingAllowed(FCol) or
6778 (ExtendedSelect and not EditorAlwaysShown) then begin
6779
6780 if ssShift in Shift then
6781 SelectActive:=(goRangeSelect in Options)
6782 else begin
6783 if (goRangeSelect in Options) and (FRangeSelectMode = rsmMulti)
6784 then begin
6785 if (MULTISEL_MODIFIER in Shift) then
6786 AddSelectedRange
6787 else begin
6788 ClearSelections;
6789 Invalidate;
6790 end;
6791 end;
6792
6793 // shift is not pressed any more cancel SelectActive if necessary
6794 if SelectActive then
6795 CancelSelection;
6796
6797 if not SelectActive then begin
6798 CheckAutoEdit;
6799 GridFlags := GridFlags + [gfNeedsSelectActive];
6800 FPivot:=FGCache.ClickCell;
6801
6802 end;
6803 end;
6804
6805 end else if CheckAutoEDit then begin
6806 {$ifDef dbgGrid} DebugLnExit('MouseDown (autoedit) EXIT'); {$Endif}
6807 Exit;
6808 end;
6809
6810 include(fGridFlags, gfEditingDone);
6811 try
6812 if not MoveExtend(False, FGCache.ClickCell.X, FGCache.ClickCell.Y, False) then begin
6813 if EditorAlwaysShown then begin
6814 SelectEditor;
6815 EditorShow(true);
6816 end;
6817 MoveSelection;
6818 end else
6819 FGridState:=gsSelecting;
6820 finally
6821 exclude(fGridFlags, gfEditingDone);
6822 end;
6823
6824 end;
6825 end;
6826 end;
6827 {$ifDef dbgGrid}DebugLnExit('MouseDown END'); {$Endif}
6828 end;
6829
6830 procedure TCustomGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
6831 var
6832 p: TPoint;
6833 obe: boolean; // stored "AllowOutboundEvents"
6834 begin
6835 inherited MouseMove(Shift, X, Y);
6836
6837 if Dragging then
6838 exit;
6839
6840 HeadersMouseMove(X,Y);
6841
6842 case FGridState of
6843 gsHeaderClicking, gsButtonColumnClicking:
6844 ;
6845 gsSelecting:
6846 if not FixedGrid and (not EditingAllowed(-1) or
6847 (ExtendedSelect and not EditorAlwaysShown)) then begin
6848 P:=MouseToLogcell(Point(X,Y));
6849 if gfNeedsSelectActive in GridFlags then
6850 SelectActive := (P.x<>FPivot.x)or(P.y<>FPivot.y);
6851 MoveExtend(false, P.X, P.Y, false);
6852 end;
6853 gsColMoving:
6854 if goColMoving in Options then
6855 doColMoving(X,Y);
6856 gsRowMoving:
6857 if goRowMoving in Options then
6858 doRowMoving(X,Y);
6859
6860 else
6861 begin
6862 if goColSizing in Options then
6863 doColSizing(X,Y);
6864
6865 if goRowSizing in Options then
6866 doRowSizing(X,Y);
6867
6868 obe := AllowOutboundEvents;
6869 AllowOutboundEvents := false;
6870 try
6871 p := MouseCoord(X, Y);
6872 finally
6873 AllowOutboundEvents := obe;
6874 end;
6875
6876 // if we are not over a cell
6877 if p.X < 0 then
6878 begin
6879 // empty hints
6880 Application.Hint := '';
6881 Hint := '';
6882 // if FCellHintPriority = chpAll, restore default hint
6883 if ShowHint and (FCellHintPriority = chpAll) then
6884 begin
6885 Hint := FSavedHint;
6886 Application.Hint := GetLongHint(FSavedHint);
6887 end;
6888 end;
6889
6890 with FGCache do
6891 if (MouseCell.X <> p.X) or (MouseCell.Y <> p.Y) then begin
6892 Application.CancelHint;
6893 ShowCellHintWindow(Point(X,Y));
6894 MouseCell := p;
6895 end;
6896 end;
6897 end;
6898 end;
6899
6900 procedure TCustomGrid.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
6901 Y: Integer);
6902 var
6903 Cur: TPoint;
6904 Gz: TGridZone;
6905
6906 function IsValidCellClick: boolean;
6907 begin
6908 result := (Cur.X=FGCache.ClickCell.X) and (Cur.Y=FGCache.ClickCell.Y) and (gz<>gzInvalid);
6909 end;
6910
6911 procedure DoAutoEdit;
6912 begin
6913 if (gfAutoEditPending in GridFlags){ and not (ssDouble in Shift)} then begin
6914 SelectEditor;
6915 EditorShow(True);
6916 end;
6917 end;
6918
6919 begin
6920 inherited MouseUp(Button, Shift, X, Y);
6921 {$IfDef dbgGrid}DebugLn('MouseUP INIT');{$Endif}
6922
6923 Cur:=MouseToCell(Point(x,y));
6924 Gz :=CellToGridZone(cur.x, cur.y);
6925
6926 case fGridState of
6927
6928 gsHeaderClicking, gsButtonColumnClicking:
6929 if IsValidCellClick then begin
6930 if fGridState=gsHeaderClicking then
6931 HeaderClick(True, FGCache.ClickCell.X)
6932 else
6933 if Assigned(OnEditButtonClick) or Assigned(OnButtonClick) then
6934 DoEditButtonClick(Cur.X, Cur.Y);
6935 end;
6936
6937 gsNormal:
6938 if not FixedGrid and IsValidCellClick then begin
6939 doAutoEdit;
6940 CellClick(cur.x, cur.y, Button);
6941 end;
6942
6943 gsSelecting:
6944 begin
6945 if SelectActive then
6946 MoveExtend(False, Cur.x, Cur.y, False)
6947 else begin
6948 doAutoEdit;
6949 CellClick(cur.x, cur.y, Button);
6950 end;
6951 end;
6952
6953 gsColMoving:
6954 begin
6955 //DebugLn('Move Col From ',Fsplitter.x,' to ', FMoveLast.x);
6956 RestoreCursor;
6957
6958 if FMoveLast.X>=0 then
6959 DoOPMoveColRow(True, FGCache.ClickCell.X, FMoveLast.X)
6960 else
6961 if Cur.X=FGCache.ClickCell.X then
6962 HeaderClick(True, FGCache.ClickCell.X)
6963 end;
6964
6965 gsRowMoving:
6966 begin
6967 //DebugLn('Move Row From ',Fsplitter.Y,' to ', FMoveLast.Y);
6968 RestoreCursor;
6969
6970 if FMoveLast.Y>=0 then
6971 DoOPMoveColRow(False, FGCache.ClickCell.Y, FMoveLast.Y)
6972 else
6973 if Cur.Y=FGCache.ClickCell.Y then
6974 HeaderClick(False, FGCache.ClickCell.Y);
6975 end;
6976
6977 gsColSizing:
6978 if gfSizingStarted in FGridFlags then
6979 with FSizing do begin
6980 if FUseXORFeatures then begin
6981 if PrevLine then
6982 DrawXorVertLine(PrevOffset);
6983 PrevLine := False;
6984 PrevOffset := -1;
6985 end;
6986 if UseRightToLeftAlignment then
6987 ResizeColumn(Index, OffEnd - X + DeltaOff)
6988 else
6989 ResizeColumn(Index, X - OffIni + DeltaOff);
6990 FixScroll;
6991 HeaderSized(True, Index);
6992 end;
6993
6994 gsRowSizing:
6995 with FSizing do begin
6996 if FUseXORFeatures then begin
6997 if PrevLine then
6998 DrawXorHorzLine(PrevOffset);
6999 PrevLine := False;
7000 PrevOffset := -1;
7001 end;
7002 ResizeRow(Index, Y - OffIni);
7003 HeaderSized(False, Index);
7004 end;
7005
7006 end;
7007
7008 GridFlags := GridFlags - [gfNeedsSelectActive, gfSizingStarted, gfAutoEditPending];
7009
7010 if IsPushCellActive() then begin
7011 ResetPushedCell;
7012 end;
7013
7014 if (FMoveLast.X>=0) or (FMoveLast.Y>=0) then begin
7015 {$ifdef AlternativeMoveIndicator}
7016 begin
7017 if FMoveLast.X>=0 then InvalidateRow(0);
7018 if FMoveLast.Y>=0 then InvalidateCol(0);
7019 end;
7020 {$else}
7021 Invalidate;
7022 {$endif}
7023 if not (fGridState in [gsColMoving,gsRowMoving]) then
7024 RestoreCursor;
7025 end;
7026
7027 FGCache.ClickCell := point(-1, -1);
7028
7029 fGridState:=gsNormal;
7030 {$IfDef dbgGrid}DebugLn('MouseUP END RND=', FloatToStr(Random));{$Endif}
7031 end;
7032
7033 procedure TCustomGrid.DblClick;
7034 var
7035 OldWidth: Integer;
7036 begin
7037 {$IfDef dbgGrid}DebugLn('DoubleClick INIT');{$Endif}
7038 SelectActive:=False;
7039 fGridState:=gsNormal;
7040 if (goColSizing in Options) and (FCursorState=gcsColWidthChanging) then begin
7041 if (goDblClickAutoSize in Options) then begin
7042 OldWidth := ColWidths[FSizing.Index];
7043 AutoAdjustColumn( FSizing.Index );
7044 if OldWidth<>ColWidths[FSizing.Index] then begin
7045 RestoreCursor;
7046 HeaderSized(True, FSizing.Index);
7047 end;
7048 end {else
7049 DebugLn('Got Doubleclick on Col Resizing: AutoAdjust?');}
7050 end else
7051 if (goDblClickAutoSize in Options) and
7052 (goRowSizing in Options) and
7053 (FCursorState=gcsRowHeightChanging) then begin
7054 {
7055 DebugLn('Got DoubleClick on Row Resizing: AutoAdjust?');
7056 }
7057 end
7058 else
7059 Inherited DblClick;
7060 {$IfDef dbgGrid}DebugLn('DoubleClick END');{$Endif}
7061 end;
7062
DefaultColWidthIsStorednull7063 function TCustomGrid.DefaultColWidthIsStored: Boolean;
7064 begin
7065 Result := FDefColWidth>=0;
7066 end;
7067
DefaultRowHeightIsStorednull7068 function TCustomGrid.DefaultRowHeightIsStored: Boolean;
7069 begin
7070 Result := FDefRowHeight>=0;
7071 end;
7072
7073 procedure TCustomGrid.DefineProperties(Filer: TFiler);
7074
7075 function SonRowsIguales(aGrid: TCustomGrid): boolean;
7076 var
7077 i: Integer;
7078 begin
7079 result := aGrid.RowCount = RowCount;
7080 if Result then
7081 for i:=0 to RowCount-1 do
7082 if aGrid.RowHeights[i]<>RowHeights[i] then begin
7083 result := false;
7084 break;
7085 end;
7086 end;
7087
7088 function SonColsIguales(aGrid: TCustomGrid): boolean;
7089 var
7090 i: Integer;
7091 begin
7092 result := aGrid.ColCount = ColCount;
7093 if Result then
7094 for i:=0 to ColCount-1 do
7095 if aGrid.ColWidths[i]<>ColWidths[i] then begin
7096 result := false;
7097 break;
7098 end;
7099 end;
7100
7101 function SonDefault(IsColumn: Boolean; L1: TIntegerList): boolean;
7102 var
7103 i: Integer;
7104 DefValue: Integer;
7105 begin
7106 Result := True;
7107 if IsColumn then DefValue := DefaultColWidth
7108 else DefValue := DefaultRowHeight;
7109 for i:=0 to L1.Count-1 do begin
7110 Result := (L1[i] = DefValue) or (L1[i] < 0);
7111 if not Result then
7112 break;
7113 end;
7114 end;
7115
7116 function NeedWidths: boolean;
7117 begin
7118 if Filer.Ancestor is TCustomGrid then
7119 Result := not SonColsIguales(TCustomGrid(Filer.Ancestor))
7120 else
7121 Result := not SonDefault(True, FCols);
7122 //result := Result and not AutoFillColumns;
7123 end;
7124
7125 function NeedHeights: boolean;
7126 begin
7127 if Filer.Ancestor is TCustomGrid then
7128 Result := not SonRowsIguales(TCustomGrid(Filer.Ancestor))
7129 else
7130 Result := not SonDefault(false, FRows);
7131 end;
7132
7133 function HasColumns: boolean;
7134 var
7135 C: TGridColumns;
7136 begin
7137 if Filer.Ancestor is TCustomGrid then
7138 C := TCustomGrid(Filer.Ancestor).Columns
7139 else
7140 C := Columns;
7141 if C<>nil then
7142 result := not C.IsDefault
7143 else
7144 result := false;
7145 end;
7146
7147 begin
7148 inherited DefineProperties(Filer);
7149 with Filer do begin
7150 //DefineProperty('Columns', @ReadColumns, @WriteColumns, HasColumns);
7151 DefineProperty('ColWidths', @ReadColWidths, @WriteColWidths, NeedWidths);
7152 DefineProperty('RowHeights', @ReadRowHeights, @WriteRowHeights, NeedHeights);
7153 end;
7154 end;
7155
7156 procedure TCustomGrid.DestroyHandle;
7157 begin
7158 inherited DestroyHandle;
7159 editorGetValue;
7160 end;
7161
DialogCharnull7162 function TCustomGrid.DialogChar(var Message: TLMKey): boolean;
7163 var
7164 i: Integer;
7165 begin
7166 for i:=0 to Columns.Count-1 do
7167 if Columns[i].Visible and (Columns[i].Title.PrefixOption<>poNone) then
7168 if IsAccel(Message.CharCode, Columns[i].Title.Caption) then begin
7169 result := true;
7170 HeaderClick(True, GridColumnFromColumnIndex(i));
7171 exit;
7172 end;
7173 result := inherited DialogChar(Message);
7174 end;
7175
DoCompareCellsnull7176 function TCustomGrid.DoCompareCells(Acol, ARow, Bcol, BRow: Integer): Integer;
7177 begin
7178 result := 0;
7179 if Assigned(OnCompareCells) then
7180 OnCompareCells(Self, ACol, ARow, BCol, BRow, Result);
7181 end;
7182
7183 procedure TCustomGrid.DoCopyToClipboard;
7184 begin
7185 end;
7186
7187 procedure TCustomGrid.DoCutToClipboard;
7188 begin
7189 end;
7190
7191 procedure TCustomGrid.DoEditButtonClick(const ACol, ARow: Integer);
7192 var
7193 OldCol,OldRow: Integer;
7194 begin
7195 OldCol:=FCol;
7196 OldRow:=FRow;
7197 try
7198 FCol:=ACol;
7199 FRow:=ARow;
7200 if Assigned(OnEditButtonClick) then
7201 OnEditButtonClick(Self);
7202 if Assigned(OnButtonClick) then
7203 OnButtonClick(Self, ACol, ARow);
7204 finally
7205 if (FCol=ACol) and (FRow=ARow) then
7206 begin
7207 // didn't change FRow or FCol, restore old index.
7208 FCol:=OldCol;
7209 FRow:=OldRow;
7210 end;
7211 end;
7212 end;
7213
7214 procedure TCustomGrid.DoEditorHide;
7215 var
7216 ParentForm: TCustomForm;
7217 begin
7218 {$ifdef dbgGrid}DebugLnEnter('grid.DoEditorHide [',Editor.ClassName,'] INIT');{$endif}
7219 if gfEditingDone in FGridFlags then begin
7220 ParentForm := GetParentForm(Self);
7221 if Self.CanFocus then
7222 ParentForm.ActiveControl := self;
7223 end;
7224 Editor.Visible:=False;
7225 {$ifdef dbgGrid}DebugLnExit('grid.DoEditorHide [',Editor.ClassName,'] END');{$endif}
7226 end;
7227 procedure TCustomGrid.DoEditorShow;
7228 var
7229 ParentChanged: Boolean;
7230 Column: TGridColumn;
7231 begin
7232 {$ifdef dbgGrid}DebugLnEnter('grid.DoEditorShow [',Editor.ClassName,'] INIT');{$endif}
7233 ScrollToCell(FCol,FRow, True);
7234 // Under carbon, Editor.Parent:=nil destroy Editor handle, but not immediately
7235 // as in this case where keyboard event on editor is being handled.
7236 // After Editor.Visible:=true, a new handle is allocated but it's got overwritten
7237 // once the delayed destroying of previous handle happens, the result is a stalled
7238 // unparented editor ....
7239 ParentChanged := (Editor.Parent<>Self);
7240 if ParentChanged then
7241 Editor.Parent := nil;
7242 EditorSetValue;
7243 if ParentChanged then
7244 Editor.Parent:=Self;
7245 if (FEditor = FStringEditor) or (FEditor = FButtonStringEditor) then
7246 begin
7247 Column:=ColumnFromGridColumn(FCol);
7248 if Column<>nil then
7249 FStringEditor.Alignment:=Column.Alignment
7250 else
7251 FStringEditor.Alignment:=taLeftJustify;
7252 end;
7253 Editor.Visible:=True;
7254 if Focused and Editor.CanFocus then
7255 Editor.SetFocus;
7256 InvalidateCell(FCol,FRow,True);
7257 {$ifdef dbgGrid}DebugLnExit('grid.DoEditorShow [',Editor.ClassName,'] END');{$endif}
7258 end;
7259
7260 procedure TCustomGrid.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
7261 const AXProportion, AYProportion: Double);
7262 var
7263 i: Integer;
7264 C: TGridColumn;
7265 begin
7266 inherited;
7267
7268 if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
7269 begin
7270 BeginUpdate;
7271 try
7272 for i := Columns.Count - 1 downto 0 do
7273 begin
7274 C := Columns.Items[i];
7275 C.MaxSize := Round(C.MaxSize * AXProportion);
7276 C.MinSize := Round(C.MinSize * AXProportion);
7277 if C.IsWidthStored then
7278 C.Width := Round(C.Width * AXProportion);
7279 end;
7280
7281 for i := FRows.Count - 1 downto 0 do
7282 if FRows[i]>=0 then
7283 FRows[i] := Round(FRows[i] * AYProportion);
7284
7285 for i := FCols.Count - 1 downto 0 do
7286 if FCols[i]>=0 then
7287 FCols[i] := Round(FCols[i] * AXProportion);
7288
7289 if DefaultColWidthIsStored then
7290 DefaultColWidth := Round(DefaultColWidth * AXProportion)
7291 else
7292 FRealizedDefColWidth := 0;
7293 if DefaultRowHeightIsStored then
7294 DefaultRowHeight := Round(DefaultRowHeight * AYProportion)
7295 else
7296 FRealizedDefRowHeight := 0;
7297 finally
7298 EndUpdate;
7299 end;
7300 end;
7301 end;
7302
7303 procedure TCustomGrid.DoPasteFromClipboard;
7304 begin
7305 //
7306 end;
7307
7308 procedure TCustomGrid.DoPrepareCanvas(aCol,aRow:Integer; aState: TGridDrawState);
7309 begin
7310 if Assigned(OnPrepareCanvas) then
7311 OnPrepareCanvas(Self, aCol, aRow, aState);
7312 end;
7313
7314 procedure TCustomGrid.DoOnResize;
7315 begin
7316 inherited DoOnResize;
7317 if FUpdateCount=0 then
7318 TWSCustomGridClass(WidgetSetClass).Invalidate(Self);
7319 end;
7320
7321 procedure TCustomGrid.DoSetBounds(ALeft, ATop, AWidth, AHeight: integer);
7322 begin
7323 FLastWidth := ClientWidth;
7324 inherited DoSetBounds(ALeft, ATop, AWidth, AHeight);
7325 end;
7326
DoUTF8KeyPressnull7327 function TCustomGrid.DoUTF8KeyPress(var UTF8Key: TUTF8Char): boolean;
7328 begin
7329 Result := inherited DoUTF8KeyPress(UTF8Key);
7330 if EditingAllowed(FCol) and (not result) and (Length(UTF8Key)>1) then begin
7331 EditorShowChar(UTF8Key);
7332 UTF8Key := '';
7333 Result := true
7334 end;
7335 end;
7336
FlipRectnull7337 function TCustomGrid.FlipRect(ARect: TRect): TRect;
7338 begin
7339 Result := BidiFlipRect(ARect, GCache.ClientRect, UseRightToLeftAlignment);
7340 end;
7341
FlipPointnull7342 function TCustomGrid.FlipPoint(P: TPoint): TPoint;
7343 begin
7344 Result := BidiFlipPoint(P, GCache.ClientRect, UseRightToLeftAlignment);
7345 end;
7346
FlipXnull7347 function TCustomGrid.FlipX(X: Integer): Integer;
7348 begin
7349 Result := BidiFlipX(X, GCache.ClientRect, UseRightToLeftAlignment);
7350 end;
7351
IsMouseOverCellButtonnull7352 function TCustomGrid.IsMouseOverCellButton(X, Y: Integer): boolean;
7353 var
7354 oldAOE: Boolean;
7355 P: TPoint;
7356 begin
7357 oldAOE := AllowOutboundEvents;
7358 AllowOutboundEvents := false;
7359 P := MouseToCell(Point(X,Y));
7360 AllowOutBoundEvents := OldAOE;
7361 result := IsCellButtonColumn(P);
7362 end;
7363
7364 procedure TCustomGrid.DoExit;
7365 begin
7366 if not (csDestroying in ComponentState) then begin
7367 {$IfDef dbgGrid}DebugLnEnter('DoExit - INIT');{$Endif}
7368 if FEditorShowing then begin
7369 {$IfDef dbgGrid}DebugLn('DoExit - EditorShowing');{$Endif}
7370 end else begin
7371 {$IfDef dbgGrid}DebugLn('DoExit - Ext');{$Endif}
7372 if not EditorAlwaysShown then
7373 InvalidateFocused;
7374 ResetEditor;
7375 if FgridState=gsSelecting then begin
7376 if SelectActive then
7377 FSelectActive := False;
7378 FGridState := gsNormal;
7379 end;
7380 end;
7381 end;
7382 inherited DoExit;
7383 {$IfDef dbgGrid}DebugLnExit('DoExit - END');{$Endif}
7384 end;
7385
7386 procedure TCustomGrid.DoEnter;
7387 begin
7388 {$IfDef dbgGrid}DebugLnEnter('DoEnter %s INIT',[dbgsname(self)]);{$Endif}
7389 inherited DoEnter;
7390 if EditorLocked then begin
7391 {$IfDef dbgGrid}DebugLn('DoEnter - EditorLocked');{$Endif}
7392 end else begin
7393 {$IfDef dbgGrid}DebugLn('DoEnter - Ext');{$Endif}
7394 if EditorAlwaysShown then begin
7395 // try to show editor only if focused cell is visible area
7396 // so a mouse click would use click coords to show up
7397 if IsCellVisible(Col,Row) then begin
7398 SelectEditor;
7399 if Feditor<>nil then
7400 EditorShow(true);
7401 end else begin
7402 {$IfDef dbgGrid}DebugLn('DoEnter - Ext - Cell was not visible');{$Endif}
7403 end;
7404 end else
7405 InvalidateFocused;
7406 end;
7407 {$IfDef dbgGrid}DebugLnExit('DoEnter - END');{$Endif}
7408 end;
7409
7410 procedure TCustomGrid.DoLoadColumn(sender: TCustomGrid; aColumn: TGridColumn;
7411 aColIndex: Integer; aCfg: TXMLConfig; aVersion: Integer; aPath: string);
7412 begin
7413 if Assigned(FOnLoadColumn) then
7414 FOnLoadColumn(Self, aColumn, aColIndex, aCfg, aVersion, aPath);
7415 end;
7416
7417 procedure TCustomGrid.DoSaveColumn(sender: TCustomGrid; aColumn: TGridColumn;
7418 aColIndex: Integer; aCfg: TXMLConfig; aVersion: Integer; aPath: string);
7419 begin
7420 if Assigned(FOnSaveColumn) then
7421 FOnSaveColumn(Self, aColumn, aColIndex, aCfg, aVersion, aPath);
7422 end;
7423
DoMouseWheelnull7424 function TCustomGrid.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
7425 MousePos: TPoint): Boolean;
7426 begin
7427 if FMouseWheelOption=mwCursor then
7428 FSelectActive := false;
7429 Result:=inherited DoMouseWheel(Shift, WheelDelta, MousePos);
7430 end;
7431
DoMouseWheelDownnull7432 function TCustomGrid.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint
7433 ): Boolean;
7434 begin
7435 {$ifdef dbgScroll}DebugLn('doMouseWheelDown INIT');{$endif}
7436 Result:=inherited DoMouseWheelDown(Shift, MousePos);
7437 if not Result then begin
7438 GridMouseWheel(Shift, 1);
7439 Result := True; // handled, no further scrolling by the widgetset
7440 end;
7441 {$ifdef dbgScroll}DebugLn('doMouseWheelDown END');{$endif}
7442 end;
7443
DoMouseWheelUpnull7444 function TCustomGrid.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint
7445 ): Boolean;
7446 begin
7447 {$ifdef dbgScroll}DebugLn('doMouseWheelUP INIT');{$endif}
7448 Result:=inherited DoMouseWheelUp(Shift, MousePos);
7449 if not Result then begin
7450 GridMouseWheel(Shift, -1);
7451 Result := True; // handled, no further scrolling by the widgetset
7452 end;
7453 {$ifdef dbgScroll}DebugLn('doMouseWheelUP END');{$endif}
7454 end;
7455
DoMouseWheelLeftnull7456 function TCustomGrid.DoMouseWheelLeft(Shift: TShiftState; MousePos: TPoint
7457 ): Boolean;
7458 begin
7459 {$ifdef dbgScroll}DebugLn('doMouseWheelLEFT INIT');{$endif}
7460 Result:=inherited DoMouseWheelLeft(Shift, MousePos);
7461 if not Result then begin
7462 GridMouseWheel([ssCtrl], -1);
7463 Result := True; // handled, no further scrolling by the widgetset
7464 end;
7465 {$ifdef dbgScroll}DebugLn('doMouseWheelLEFT END');{$endif}
7466 end;
7467
DoMouseWheelRightnull7468 function TCustomGrid.DoMouseWheelRight(Shift: TShiftState; MousePos: TPoint
7469 ): Boolean;
7470 begin
7471 {$ifdef dbgScroll}DebugLn('doMouseWheelRIGHT INIT');{$endif}
7472 Result:=inherited DoMouseWheelRight(Shift, MousePos);
7473 if not Result then begin
7474 GridMouseWheel([ssCtrl], 1);
7475 Result := True; // handled, no further scrolling by the widgetset
7476 end;
7477 {$ifdef dbgScroll}DebugLn('doMouseWheelRIGHT END');{$endif}
7478 end;
7479
7480 procedure TCustomGrid.DoOnChangeBounds;
7481 var
7482 OldTopLeft: TPoint;
7483 OldColOff, OldRowOff: Integer;
7484 begin
7485 inherited DoOnChangeBounds;
7486
7487 if FUpdateCount=0 then
7488 begin
7489 OldTopLeft := fTopLeft;
7490 OldColOff := FGCache.TLColOff;
7491 OldRowOff := FGCache.TLRowOff;
7492 UpdateSizes;
7493 if (OldTopLeft.X<>FTopLeft.X) or (OldTopLeft.Y<>FTopLeft.Y)
7494 or (OldColOff<>FGCache.TLColOff) or (OldRowOff<>FGCache.TLRowOff) then // reduce unnecessary repaints
7495 Invalidate;
7496 end;
7497 end;
7498
7499 procedure TCustomGrid.KeyDown(var Key: Word; Shift: TShiftState);
7500 var
7501 Sh, PreserveRowAutoInserted: Boolean;
7502 R: TRect;
7503 Relaxed: Boolean;
7504 DeltaCol,DeltaRow: Integer;
7505
7506 procedure MoveSel(Rel: Boolean; aCol,aRow: Integer);
7507 begin
7508 // Do not reset Offset in keyboard Events - see issue #29420
7509 //FGCache.TLColOff:=0;
7510 //FGCache.TLRowOff:=0;
7511 SelectActive:=Sh;
7512 Include(FGridFlags, gfEditingDone);
7513 if MoveNextSelectable(Rel, aCol, aRow) then
7514 Click;
7515 Exclude(FGridFlags, gfEditingDone);
7516 Key := 0; { Flag key as handled, even if selected cell did not move }
7517 end;
7518
7519 procedure TabCheckEditorKey;
7520 begin
7521 if FEditorKey then begin
7522 {$IFDEF dbggrid}
7523 DebugLn('Got TAB, shift=',dbgs(sh));
7524 {$endif}
7525 if sh then
7526 GridFlags := GridFlags + [gfRevEditorTab]
7527 else
7528 GridFlags := GridFlags + [gfEditorTab];
7529 end;
7530 end;
7531
7532 const
7533 cBidiMove: array[Boolean] of Integer = (1, -1);
7534 begin
7535 {$ifdef dbgGrid}DebugLn('Grid.KeyDown INIT Key=',IntToStr(Key));{$endif}
7536 inherited KeyDown(Key, Shift);
7537 //Don't touch FRowAutoInserted flag if user presses only Ctrl,Shift,Altor Meta/Win key
7538 PreserveRowAutoInserted := (Key in [VK_SHIFT,VK_CONTROL,VK_LWIN,VK_RWIN,VK_MENU]);
7539
7540 //if not FGCache.ValidGrid then Exit;
7541 if not CanGridAcceptKey(Key, Shift) then
7542 Key:=0; // Allow CanGridAcceptKey to override Key behaviour
7543 Sh:=(ssShift in Shift);
7544 Relaxed := not (goRowSelect in Options) or (goRelaxedRowSelect in Options);
7545
7546 case Key of
7547 VK_TAB:
7548 if goTabs in Options then begin
7549 if GetDeltaMoveNext(Sh, DeltaCol,DeltaRow,FTabAdvance) then begin
7550 Sh := False;
7551 MoveSel(True, DeltaCol, DeltaRow);
7552 PreserveRowAutoInserted := True;
7553 Key:=0;
7554 end else if (goAutoAddRows in Options) and (DeltaRow = 1) then begin
7555 //prevent selecting multiple cells when user presses Shift
7556 Sh := False;
7557 if (goAutoAddRowsSkipContentCheck in Options) or (not IsEmptyRow(Row)) then MoveSel(True, DeltaCol, DeltaRow);
7558 Key := 0;
7559 PreserveRowAutoInserted := True;
7560 end else
7561 if (TabAdvance=aaNone) or
7562 ((TabAdvance=aaDown) and (Row>=GetLastVisibleRow)) or
7563 (sh and (Col<=GetFirstVisibleColumn)) or
7564 ((not sh) and (Col>=GetLastVisibleColumn)) then
7565 TabCheckEditorKey
7566 else
7567 Key := 0;
7568 end else
7569 TabCheckEditorKey;
7570 VK_LEFT:
7571 //Don't move to another cell is user is editing
7572 if not FEditorKey then
7573 begin
7574 if Relaxed then
7575 MoveSel(True, -cBidiMove[UseRightToLeftAlignment], 0)
7576 else
7577 MoveSel(True, 0,-1);
7578 end;
7579 VK_RIGHT:
7580 //Don't move to another cell is user is editing
7581 if not FEditorKey then
7582 begin
7583 if Relaxed then
7584 MoveSel(True, cBidiMove[UseRightToLeftAlignment], 0)
7585 else
7586 MoveSel(True, 0, 1);
7587 end;
7588 VK_UP:
7589 MoveSel(True, 0, -1);
7590 VK_DOWN:
7591 MoveSel(True, 0, 1);
7592 VK_PRIOR:
7593 begin
7594 R:=FGCache.FullVisiblegrid;
7595 MoveSel(True, 0, R.Top-R.Bottom);
7596 end;
7597 VK_NEXT:
7598 begin
7599 R:=FGCache.FullVisibleGrid;
7600 MoveSel(True, 0, R.Bottom-R.Top);
7601 end;
7602 VK_HOME:
7603 if not FEditorKey then begin
7604 if ssCtrl in Shift then MoveSel(False, FCol, FFixedRows)
7605 else
7606 if Relaxed then MoveSel(False, FFixedCols, FRow)
7607 else MoveSel(False, FCol, FFixedRows);
7608 end;
7609 VK_END:
7610 if not FEditorKey then begin
7611 if ssCtrl in Shift then MoveSel(False, FCol, RowCount-1)
7612 else
7613 if Relaxed then MoveSel(False, ColCount-1, FRow)
7614 else MoveSel(False, FCol, RowCount-1);
7615 end;
7616 VK_APPS:
7617 if not FEditorKey and EditingAllowed(FCol) then
7618 EditorShow(False); // Will show popup menu in the editor.
7619 VK_F2:
7620 if not FEditorKey and EditingAllowed(FCol) then begin
7621 SelectEditor;
7622 EditorShow(False);
7623 Key:=0;
7624 end ;
7625 VK_BACK:
7626 // Workaround: LM_CHAR doesnt trigger with BACKSPACE
7627 if not FEditorKey and EditingAllowed(FCol) then begin
7628 EditorShowChar(^H);
7629 key:=0;
7630 end;
7631 VK_C:
7632 if not FEditorKey and (Shift = [ssModifier]) then
7633 doCopyToClipboard;
7634 VK_V:
7635 if not FEditorKey and (Shift = [ssModifier]) then
7636 doPasteFromClipboard;
7637 VK_X:
7638 if not FEditorKey and (Shift = [ssShift]) then
7639 doCutToClipboard;
7640 VK_DELETE:
7641 if not FEditorKey and EditingAllowed(FCol) and
7642 not (csDesigning in ComponentState) then begin
7643 if Editor=nil then
7644 SelectEditor;
7645 if Editor is TCustomEdit then begin
7646 EditorShow(False);
7647 TCustomEdit(Editor).Text:='';
7648 InvalidateCell(FCol,FRow,True);
7649 EditorShow(True);
7650 Key := 0;
7651 end;
7652 end;
7653 VK_ESCAPE:
7654 begin
7655 EditordoResetValue;
7656 EditorHide;
7657 Key := 0;
7658 end;
7659 end;
7660 if FEditorKey and (not PreserveRowAutoInserted) then
7661 FRowAutoInserted:=False;
7662 {$ifdef dbgGrid}DebugLn('Grid.KeyDown END Key=',IntToStr(Key));{$endif}
7663 end;
7664
7665 procedure TCustomGrid.KeyUp(var Key: Word; Shift: TShiftState);
7666 begin
7667 inherited KeyUp(Key, Shift);
7668 end;
7669
7670 procedure TCustomGrid.KeyPress(var Key: char);
7671 begin
7672 inherited KeyPress(Key);
7673 if not EditorKey then
7674 // we are interested in these keys only if they came from the grid
7675 if not EditorMode and EditingAllowed(FCol) then begin
7676 if (Key=#13) then begin
7677 SelectEditor;
7678 EditorShow(True);
7679 Key := #0;
7680 end else
7681 if (Key in [^H, #32..#255]) then begin
7682 EditorShowChar(Key);
7683 Key := #0;
7684 end;
7685 end;
7686 end;
7687
7688 { Convert a physical Mouse coordinate into a physical cell coordinate }
TCustomGrid.MouseToCellnull7689 function TCustomGrid.MouseToCell(const Mouse: TPoint): TPoint;
7690 begin
7691 MouseToCell(Mouse.X, Mouse.Y, Result.X, Result.Y);
7692 end;
7693
7694 procedure TCustomGrid.MouseToCell(X, Y: Integer; out ACol, ARow: Longint);
7695 var
7696 dummy: Integer;
7697 begin
7698 // Do not raise Exception if out of range
7699 OffsetToColRow(True, True, X, ACol, dummy);
7700 if ACol<0 then
7701 ARow := -1
7702 else begin
7703 OffsetToColRow(False,True, Y, ARow, dummy);
7704 if ARow<0 then
7705 ACol := -1;
7706 end;
7707 end;
7708
7709 { Convert a physical Mouse coordinate into a logical cell coordinate }
MouseToLogcellnull7710 function TCustomGrid.MouseToLogcell(Mouse: TPoint): TPoint;
7711 var
7712 gz: TGridZone;
7713 begin
7714 Gz:=MouseToGridZone(Mouse.x, Mouse.y);
7715 Result:=MouseToCell(Mouse);
7716 if gz<>gzNormal then begin
7717 if (gz=gzFixedRows)or(gz=gzFixedCells) then begin
7718 Result.x:= fTopLeft.x-1;
7719 if Result.x<FFixedCols then Result.x:=FFixedCols;
7720 end;
7721 if (gz=gzFixedCols)or(gz=gzFixedCells) then begin
7722 Result.y:=fTopleft.y-1;
7723 if Result.y<fFixedRows then Result.y:=FFixedRows;
7724 end;
7725 end;
7726 end;
7727
TCustomGrid.MouseCoordnull7728 function TCustomGrid.MouseCoord(X, Y: Integer): TGridCoord;
7729 begin
7730 Result := MouseToCell(Point(X,Y));
7731 end;
7732
IsCellVisiblenull7733 function TCustomGrid.IsCellVisible(aCol, aRow: Integer): Boolean;
7734 begin
7735 with FGCache.VisibleGrid do
7736 Result:= (Left<=ACol)and(aCol<=Right)and(Top<=aRow)and(aRow<=Bottom);
7737 end;
7738
IsFixedCellVisiblenull7739 function TCustomGrid.IsFixedCellVisible(aCol, aRow: Integer): boolean;
7740 begin
7741 with FGCache.VisibleGrid do
7742 result := ((aCol<FixedCols) and ((aRow<FixedRows) or ((aRow>=Top)and(aRow<=Bottom)))) or
7743 ((aRow<FixedRows) and ((aCol<FixedCols) or ((aCol>=Left)and(aCol<=Right))));
7744 end;
7745
7746 procedure TCustomGrid.InvalidateCol(ACol: Integer);
7747 var
7748 R: TRect;
7749 begin
7750 {$ifdef dbgPaint} DebugLn('InvalidateCol Col=',IntToStr(aCol)); {$Endif}
7751 if not HandleAllocated then
7752 exit;
7753 R:=CellRect(aCol, FTopLeft.y);
7754 R.Top:=0; // Full Column
7755 R.Bottom:=FGCache.MaxClientXY.Y;
7756 InvalidateRect(Handle, @R, True);
7757 end;
7758
7759 procedure TCustomGrid.InvalidateFromCol(ACol: Integer);
7760 var
7761 R: TRect;
7762 begin
7763 {$IFDEF dbgPaint} DebugLn('InvalidateFromCol Col=',IntToStr(aCol)); {$Endif}
7764 if not HandleAllocated then
7765 exit;
7766 R:=CellRect(aCol, FTopLeft.y);
7767 R.Top:=0; // Full Column
7768 R.BottomRight := FGCache.MaxClientXY;
7769 InvalidateRect(Handle, @R, True);
7770 end;
7771
7772 procedure TCustomGrid.InvalidateRow(ARow: Integer);
7773 var
7774 R: TRect;
7775 begin
7776 {$ifdef DbgPaint} DebugLn('InvalidateRow Row=',IntToStr(aRow)); {$Endif}
7777 if not HandleAllocated then
7778 exit;
7779 R:=CellRect(fTopLeft.x, aRow);
7780 if UseRightToLeftAlignment then begin
7781 R.Left:=FlipX(FGCache.MaxClientXY.X);
7782 R.Right:=FGCache.ClientRect.Right;
7783 end
7784 else begin
7785 R.Left:=0; // Full row
7786 R.Right:=FGCache.MaxClientXY.X;
7787 end;
7788 InvalidateRect(Handle, @R, True);
7789 end;
7790
7791 procedure TCustomGrid.InvalidateFocused;
7792 begin
7793 if FGCache.ValidGrid then begin
7794 {$ifdef dbgGrid}DebugLn('InvalidateFocused');{$Endif}
7795 if ((goRowSelect in Options) or (goRowHighlight in Options)) then
7796 InvalidateRow(Row)
7797 else
7798 InvalidateCell(Col,Row);
7799 end;
7800 end;
7801
MoveExtendnull7802 function TCustomGrid.MoveExtend(Relative: Boolean; DCol, DRow: Integer;
7803 ForceFullyVisible: Boolean): Boolean;
7804 var
7805 OldRange: TRect;
7806 prevCol, prevRow: Integer;
7807 begin
7808 Result:=TryMoveSelection(Relative,DCol,DRow);
7809 if (not Result) then Exit;
7810
7811 Result:=EditorGetValue(true);
7812 if (not Result) then Exit;
7813
7814 {$IfDef dbgGrid}DebugLnEnter('MoveExtend INIT FCol= ',IntToStr(FCol), ' FRow= ',IntToStr(FRow));{$Endif}
7815 BeforeMoveSelection(DCol,DRow);
7816
7817 OldRange := FRange;
7818 PrevRow := FRow;
7819 PrevCol := FCol;
7820
7821 if goRowSelect in Options then
7822 FRange:=Rect(FFixedCols, DRow, Colcount-1, DRow)
7823 else
7824 FRange:=Rect(DCol,DRow,DCol,DRow);
7825
7826 if SelectActive and (goRangeSelect in Options) then
7827 if goRowSelect in Options then begin
7828 FRange.Top:=Min(fPivot.y, DRow);
7829 FRange.Bottom:=Max(fPivot.y, DRow);
7830 end else
7831 FRange:=NormalizarRect(Rect(Fpivot.x,FPivot.y, DCol, DRow));
7832
7833 if not ScrollToCell(DCol, DRow, ForceFullyVisible) then
7834 InvalidateMovement(DCol, DRow, OldRange);
7835
7836 FCol := DCol;
7837 FRow := DRow;
7838
7839 MoveSelection;
7840 SelectEditor;
7841
7842 if (FEditor<>nil) and EditorAlwaysShown then begin
7843 // if editor visibility was changed on BeforeMoveSelection or MoveSelection
7844 // make sure editor will be updated.
7845 // TODO: cell coords of last time editor was visible
7846 // could help here too, if they are not the same as the
7847 // current cell, editor should be hidden first too.
7848 if FEditor.Visible then
7849 EditorHide;
7850 EditorShow(true);
7851 end;
7852
7853 AfterMoveSelection(PrevCol,PrevRow);
7854
7855 {$IfDef dbgGrid}DebugLnExit('MoveExtend END FCol= ',IntToStr(FCol), ' FRow= ',IntToStr(FRow));{$Endif}
7856 end;
7857
MoveNextAutonull7858 function TCustomGrid.MoveNextAuto(const Inverse: boolean): boolean;
7859 var
7860 aCol,aRow: Integer;
7861 begin
7862 Result := GetDeltaMoveNext(Inverse, ACol, ARow, FAutoAdvance);
7863 if Result then
7864 MoveNextSelectable(true, aCol, aRow);
7865 end;
7866
TCustomGrid.MoveNextSelectablenull7867 function TCustomGrid.MoveNextSelectable(Relative: Boolean; DCol, DRow: Integer): Boolean;
7868 var
7869 CInc,RInc: Integer;
7870 NCol,NRow: Integer;
7871 begin
7872 // Reference
7873 if not Relative then begin
7874 NCol:=DCol;
7875 NRow:=DRow;
7876 DCol:=NCol-FCol;
7877 DRow:=NRow-FRow;
7878 end else begin
7879 NCol:=FCol+DCol;
7880 NRow:=FRow+DRow;
7881 if (goEditing in options) and (goAutoAddRows in options) then begin
7882 if (DRow=1) and (NRow>=RowCount) then begin
7883 // If the last row has data or goAutoAddRowsSkipContentCheck is set, add a new row.
7884 if (not FRowAutoInserted) then begin
7885 if (goAutoAddRowsSkipContentCheck in Options) or (not IsEmptyRow(FRow)) then begin
7886 RowCount:=RowCount+1;
7887 if not (goAutoAddRowsSkipContentCheck in Options) then FRowAutoInserted:=True;
7888 end;
7889 end;
7890 end
7891 else if FRowAutoInserted and (DRow=-1) then begin
7892 RowCount:=RowCount-1;
7893 FRowAutoInserted:=False;
7894 ScrollToCell(Col, Row, True);
7895 end;
7896 end;
7897 end;
7898
7899 Checklimits(NCol, NRow);
7900
7901 // Increment
7902 if DCol<0 then CInc:=-1 else
7903 if DCol>0 then CInc:= 1
7904 else CInc:= 0;
7905 if DRow<0 then RInc:=-1 else
7906 if DRow>0 then RInc:= 1
7907 else RInc:= 0;
7908
7909 // Calculate
7910 Result:=False;
7911 while ((ColWidths[NCol]=0) and (CInc<>0))
7912 or ((RowHeights[NRow]=0) and (RInc<>0)) do
7913 begin
7914 if not (IsRowIndexVariable(NRow+RInc) and IsColumnIndexVariable(NCol+CInc)) then
7915 Exit;
7916 Inc(NCol, CInc);
7917 Inc(NRow, RInc);
7918 end;
7919 Result:=MoveExtend(False, NCol, NRow, True);
7920
7921 // whether or not a movement was valid if goAlwaysShowEditor
7922 // is set, editor should pop up.
7923 if not EditorMode and EditorAlwaysShown then begin
7924 SelectEditor;
7925 if Feditor<>nil then
7926 EditorShow(true);
7927 end;
7928 end;
7929
TCustomGrid.TryMoveSelectionnull7930 function TCustomGrid.TryMoveSelection(Relative: Boolean; var DCol, DRow: Integer
7931 ): Boolean;
7932 begin
7933 Result:=False;
7934
7935 if FixedGrid then
7936 exit;
7937
7938 if Relative then begin
7939 Inc(DCol, FCol);
7940 Inc(DRow, FRow);
7941 end;
7942
7943 CheckLimits(DCol, DRow);
7944
7945 // Change on Focused cell?
7946 if (DCol=FCol) and (DRow=FRow) then
7947 SelectCell(DCol,DRow)
7948 else
7949 Result:=SelectCell(DCol,DRow);
7950 end;
7951
7952 procedure TCustomGrid.UnLockEditor;
7953 begin
7954 if FEDitorHidingCount>0 then
7955 Dec(FEditorHidingCount)
7956 else
7957 DebugLn('WARNING: unpaired Unlock Editor');
7958 {$ifdef dbgGrid}DebugLn('==< LockEditor: ', dbgs(FEditorHidingCount)); {$endif}
7959 end;
7960
7961 procedure TCustomGrid.UpdateHorzScrollBar(const aVisible: boolean;
7962 const aRange,aPage,aPos: Integer);
7963 var
7964 NeedUpdate: Boolean;
7965 begin
7966 {$ifdef DbgScroll}
7967 DebugLn('TCustomGrid.UpdateHorzScrollbar: Vis=%s Range=%d Page=%d aPos=%d',
7968 [dbgs(aVisible),aRange, aPage, aPos]);
7969 {$endif}
7970 NeedUpdate := FHSbVisible <> Ord(AVisible);
7971 if NeedUpdate then
7972 ScrollBarShow(SB_HORZ, aVisible);
7973 if aVisible or NeedUpdate then
7974 ScrollBarRange(SB_HORZ, aRange, aPage, aPos);
7975 end;
7976
7977 procedure TCustomGrid.UpdateVertScrollbar(const aVisible: boolean;
7978 const aRange,aPage,aPos: Integer);
7979 begin
7980 {$ifdef DbgScroll}
7981 DebugLn('TCustomGrid.UpdateVertScrollbar: Vis=%s Range=%d Page=%d aPos=%d',
7982 [dbgs(aVisible),aRange, aPage, aPos]);
7983 {$endif}
7984 if FVSbVisible<>Ord(aVisible) then
7985 ScrollBarShow(SB_VERT, aVisible);
7986 if aVisible then
7987 ScrollbarRange(SB_VERT, aRange, aPage, aPos );
7988 end;
7989
7990 procedure TCustomGrid.UpdateBorderStyle;
7991 var
7992 ABorderStyle: TBorderStyle;
7993 begin
7994 if not Flat and (FGridBorderStyle=bsSingle) then
7995 ABorderStyle := bsSingle
7996 else
7997 ABorderStyle := bsNone;
7998 inherited SetBorderStyle(ABorderStyle);
7999 if HandleAllocated and ([csDestroying,csLoading]*ComponentState=[]) then
8000 begin
8001 VisualChange;
8002 if CheckTopLeft(Col, Row, True, True) then
8003 VisualChange;
8004 end;
8005 end;
8006
ValidateEntrynull8007 function TCustomGrid.ValidateEntry(const ACol, ARow: Integer;
8008 const OldValue:string; var NewValue:string): boolean;
8009 begin
8010 result := true;
8011 if assigned(OnValidateEntry) then begin
8012 try
8013 OnValidateEntry(Self, ACol, ARow, OldValue, NewValue);
8014 except
8015 on E:Exception do begin
8016 result := false;
8017 if FGridState=gsSelecting then
8018 FGridState := gsNormal;
8019 Application.HandleException(E);
8020 end;
8021 end;
8022 end;
8023 end;
8024
8025 procedure TCustomGrid.BeforeMoveSelection(const DCol,DRow: Integer);
8026 begin
8027 if Assigned(OnBeforeSelection) then OnBeforeSelection(Self, DCol, DRow);
8028 end;
8029
8030 procedure TCustomGrid.BeginAutoDrag;
8031 begin
8032 if ((goColSizing in Options) and (FCursorState=gcsColWidthChanging)) or
8033 ((goRowSizing in Options) and (FCursorState=gcsRowHeightChanging))
8034 then
8035 // TODO: Resizing in progress, add an option to forbid resizing
8036 // when DragMode=dmAutomatic
8037 else
8038 BeginDrag(False);
8039 end;
8040
8041 procedure TCustomGrid.CalcAutoSizeColumn(const Index: Integer; var AMin, AMax,
8042 APriority: Integer);
8043 begin
8044 APriority := 0;
8045 end;
8046
8047 procedure TCustomGrid.CalcCellExtent(acol, aRow: Integer; var aRect: TRect);
8048 begin
8049 //
8050 end;
8051
8052 procedure TCustomGrid.CalcFocusRect(var ARect: TRect; adjust: boolean = true);
8053 begin
8054 if goRowSelect in Options then begin
8055
8056 if UseRightToLeftAlignment then begin
8057 aRect.Left := GCache.ClientWidth - GCache.MaxClientXY.x;
8058 aRect.Right := GCache.ClientWidth - GCache.FixedWidth;
8059 end else begin
8060 aRect.Left := GCache.FixedWidth;
8061 aRect.Right := GCache.MaxClientXY.x;
8062 end;
8063
8064 FlipRect(aRect);
8065 end;
8066
8067 if not adjust then
8068 exit;
8069
8070 if goHorzLine in Options then
8071 dec(aRect.Bottom, 1 + FGridLineWidth div 2);
8072
8073 if goVertLine in Options then
8074 if UseRightToLeftAlignment then
8075 inc(aRect.Left, 1 + FGridLineWidth div 2)
8076 else
8077 dec(aRect.Right, 1 + FGridLineWidth div 2);
8078 end;
8079
8080 procedure TCustomGrid.CalcScrollbarsRange;
8081 var
8082 HsbVisible, VsbVisible: boolean;
8083 HsbRange,VsbRange: Integer;
8084 HsbPage, VsbPage: Integer;
8085 HsbPos, VsbPos: Integer;
8086 begin
8087 with FGCache do begin
8088 GetSBVisibility(HsbVisible, VsbVisible);
8089 GetSBRanges(HsbVisible,VsbVisible,HsbRange,VsbRange,HsbPage,VsbPage,HsbPos,VsbPos);
8090 UpdateVertScrollBar(VsbVisible, VsbRange, VsbPage, VsbPos);
8091 UpdateHorzScrollBar(HsbVisible, HsbRange, HsbPage, HsbPos);
8092 {$ifdef DbgScroll}
8093 DebugLn('VRange=',dbgs(VsbRange),' Visible=',dbgs(VSbVisible));
8094 DebugLn('HRange=',dbgs(HsbRange),' Visible=',dbgs(HSbVisible));
8095 {$endif}
8096 end;
8097 end;
8098
8099 procedure TCustomGrid.CalculatePreferredSize(var PreferredWidth,
8100 PreferredHeight: integer; WithThemeSpace: Boolean);
8101 begin
8102 PreferredWidth:=0;
8103 PreferredHeight:=0;
8104 end;
8105
8106 procedure TCustomGrid.CalcMaxTopLeft;
8107 var
8108 i: Integer;
8109 W,H: Integer;
8110 begin
8111 FGCache.MaxTopLeft:=Point(ColCount-1, RowCount-1);
8112 FGCache.MaxTLOffset.x:=0;
8113 FGCache.MaxTLOffset.y:=0;
8114 W:=0;
8115 if not(goScrollToLastCol in FOptions2) then
8116 begin
8117 for i:=ColCount-1 downto FFixedCols do
8118 begin
8119 W:=W+GetColWidths(i);
8120 if W<=FGCache.ScrollWidth then
8121 FGCache.MaxTopLeft.x:=i
8122 else
8123 begin
8124 if GetSmoothScroll(SB_Horz) then
8125 begin
8126 FGCache.MaxTopLeft.x:=i;
8127 FGCache.MaxTLOffset.x:=W-FGCache.ScrollWidth;
8128 end;
8129 Break;
8130 end;
8131 end;
8132 end;
8133 H:=0;
8134 if not(goScrollToLastRow in FOptions2) then
8135 begin
8136 for i:=RowCount-1 downto FFixedRows do
8137 begin
8138 H:=H+GetRowHeights(i);
8139 if H<=FGCache.ScrollHeight then
8140 FGCache.MaxTopLeft.y:=i
8141 else
8142 begin
8143 if GetSmoothScroll(SB_Vert) then
8144 begin
8145 FGCache.MaxTopLeft.y:=i;
8146 FGCache.MaxTLOffset.y:=H-FGCache.ScrollHeight
8147 end;
8148 Break;
8149 end;
8150 end;
8151 end;
8152 FGCache.MaxTopLeft.x:=Max(FGCache.MaxTopLeft.x, FixedCols);
8153 FGCache.MaxTopLeft.y:=Max(FGCache.MaxTopLeft.y, FixedRows);
8154 end;
8155
8156 procedure TCustomGrid.CellClick(const aCol, aRow: Integer; const Button:TMouseButton);
8157 begin
8158 end;
8159
8160 procedure TCustomGrid.CellExtent(const aCol, aRow: Integer; var R: TRect; out
8161 exCol: Integer);
8162 var
8163 Extent: TRect;
8164 begin
8165 Extent := R;
8166 exCol := aCol;
8167 CalcCellExtent(aCol, aRow, R);
8168 // TODO: check RTL
8169 while (exCol<=FGCache.VisibleGrid.Right) and (Extent.Right<R.Right) do begin
8170 inc(exCol);
8171 ColRowToOffset(True, True, exCol, Extent.Left, Extent.Right);
8172 end;
8173 end;
8174
8175 procedure TCustomGrid.CheckLimits(var aCol, aRow: Integer);
8176 begin
8177 if aCol<FFixedCols then aCol:=FFixedCols else
8178 if aCol>ColCount-1 then acol:=ColCount-1;
8179 if aRow<FFixedRows then aRow:=FFixedRows else
8180 if aRow>RowCount-1 then aRow:=RowCount-1;
8181 end;
8182
8183 // We don't want to do this inside CheckLimits() because keyboard handling
8184 // shouldn't raise an error whereas setting the Row or Col property it should.
8185 procedure TCustomGrid.CheckLimitsWithError(const aCol, aRow: Integer);
8186 begin
8187 if not IsColumnIndexValid(aCol) or not IsRowIndexValid(aRow) then
8188 raise EGridException.Create(rsGridIndexOutOfRange);
8189 end;
8190
8191 procedure TCustomGrid.ClearSelections;
8192 begin
8193 SetLength(FSelections, 0);
8194 UpdateSelectionRange;
8195 FPivot := Point(Col, Row);
8196 InvalidateGrid;
8197 end;
8198
8199 procedure TCustomGrid.CMBiDiModeChanged(var Message: TLMessage);
8200 begin
8201 VisualChange;
8202 inherited CMBidiModeChanged(Message);
8203 end;
8204
8205 procedure TCustomGrid.CMMouseEnter(var Message: TLMessage);
8206 begin
8207 inherited;
8208 FSavedHint := Hint;
8209 // Note: disable hint when entering grid's border, we'll manage our own hints
8210 Application.Hint := '';
8211 Application.CancelHint;
8212 end;
8213
8214 procedure TCustomGrid.CMMouseLeave(var Message: TLMessage);
8215 begin
8216 Hint := FSavedHint;
8217 ResetHotCell;
8218 inherited CMMouseLeave(Message);
8219 end;
8220
8221 // This procedure checks if cursor cell position is allowed
8222 // if not it tries to find a suitable position based on
8223 // AutoAdvance and SelectCell.
8224 procedure TCustomGrid.CheckPosition;
8225 var
8226 OldAA: TAutoAdvance;
8227 DeltaCol,DeltaRow: Integer;
8228 begin
8229 // first tries to find if current position is allowed
8230 if SelectCell(Col,Row) then
8231 exit;
8232
8233 // current position is not valid, look for another position
8234 OldAA := FAutoAdvance;
8235
8236 if OldAA=aaNone then
8237 FAutoAdvance := aaRightDown;
8238
8239 try
8240 // try first normal movement then inverse movement
8241 if GetDeltaMoveNext(false, DeltaCol,DeltaRow,FAutoAdvance) or
8242 GetDeltaMoveNext(true, DeltaCol,DeltaRow,FAutoAdvance)
8243 then begin
8244 MoveNextSelectable(True, DeltaCol, DeltaRow)
8245 end else begin
8246 // some combinations of AutoAdvance and current position
8247 // will always fail, for example if user set current
8248 // column not selectable and autoadvance is aaDown will
8249 // fail always, in this case as a last resource do a full
8250 // scan until a cell is available
8251 for DeltaCol:=FixedCols to ColCount-1 do
8252 for DeltaRow:=FixedRows to RowCount-1 do begin
8253 if SelectCell(DeltaCol,DeltaRow) then begin
8254 // found one selectable cell
8255 MoveNextSelectable(False, DeltaCol,DeltaRow);
8256 exit;
8257 end;
8258 end;
8259 // user has created weird situation.
8260 // can't do more about it.
8261 end;
8262
8263 finally
8264 FAutoAdvance := OldAA;
8265 end;
8266 end;
8267
8268 procedure TCustomGrid.MoveSelection;
8269 begin
8270 if Assigned(OnSelection) then OnSelection(Self, FCol, FRow);
8271 end;
8272
8273 procedure TCustomGrid.BeginUpdate;
8274 begin
8275 Inc(FUpdateCount);
8276 end;
8277
BoxRectnull8278 function TCustomGrid.BoxRect(ALeft, ATop, ARight, ABottom: Longint): TRect;
8279 begin
8280 if ARight<ALeft then
8281 SwapInt(ALeft, ARight);
8282 if ABottom<ATop then
8283 SwapInt(ATop, ABottom);
8284
8285 Result := CellRect(ALeft, ATop);
8286 Result.BottomRight := CellRect(ARight, ABottom).BottomRight;
8287
8288 IntersectRect(Result, Result, FGCache.VisibleGrid);
8289 end;
8290
8291 procedure TCustomGrid.CacheMouseDown(const X, Y: Integer);
8292 var
8293 ParentForm: TCustomForm;
8294 begin
8295 FGCache.ClickMouse := Point(X,Y);
8296 FGCache.ClickCell := MouseToCell(FGCache.ClickMouse);
8297 if (FGCache.HotGridZone=gzInvalid) then begin
8298 ParentForm := GetParentForm(Self);
8299 if (ParentForm<>nil) and ParentForm.Active then
8300 FGCache.HotGridZone := CellToGridZone(FGCache.ClickCell.X, FGCache.ClickCell.Y);
8301 end;
8302 end;
8303
8304 procedure TCustomGrid.EndUpdate(aRefresh: boolean = true);
8305 begin
8306 Dec(FUpdateCount);
8307 if (FUpdateCount=0) and aRefresh then
8308 VisualChange;
8309 end;
8310
8311 procedure TCustomGrid.EraseBackground(DC: HDC);
8312 begin
8313 //
8314 end;
8315
Focusednull8316 function TCustomGrid.Focused: Boolean;
8317 begin
8318 Result := CanTab and (HandleAllocated and
8319 (FindOwnerControl(GetFocus)=Self) or
8320 ((FEditor<>nil) and FEditor.Visible and FEditor.Focused));
8321 end;
8322
8323 procedure TCustomGrid.InvalidateCell(aCol, aRow: Integer);
8324 begin
8325 InvalidateCell(ACol,ARow, False);
8326 end;
8327
HasMultiSelectionnull8328 function TCustomGrid.HasMultiSelection: Boolean;
8329 begin
8330 Result := (goRangeSelect in Options) and
8331 (FRangeSelectMode = rsmMulti) and (Length(FSelections) > 0);
8332 end;
8333
8334 procedure TCustomGrid.InvalidateCell(aCol, aRow: Integer; Redraw: Boolean);
8335 var
8336 R: TRect;
8337 begin
8338 {$IfDef dbgPaint}
8339 DebugLn(['InvalidateCell Col=',aCol,
8340 ' Row=',aRow,' Redraw=', Redraw]);
8341 {$Endif}
8342 if HandleAllocated and (IsCellVisible(aCol, aRow) or IsFixedCellVisible(aCol, aRow)) then begin
8343 R:=CellRect(aCol, aRow);
8344 InvalidateRect(Handle, @R, Redraw);
8345 end;
8346 end;
8347
8348 procedure TCustomGrid.InvalidateRange(const aRange: TRect);
8349 var
8350 RIni,RFin: TRect;
8351 begin
8352 if not HandleAllocated then
8353 exit;
8354 RIni := CellRect(aRange.Left, aRange.Top);
8355 RFin := CellRect(aRange.Right, aRange.Bottom);
8356 if UseRightToLeftAlignment then
8357 RIni.Left := RFin.Left
8358 else
8359 RIni.Right := RFin.Right;
8360 RIni.Bottom:= RFin.Bottom;
8361 InvalidateRect(Handle, @RIni, False);
8362 end;
8363
8364 procedure TCustomGrid.InvalidateGrid;
8365 begin
8366 if FUpdateCount=0 then Invalidate;
8367 end;
8368
8369 procedure TCustomGrid.Invalidate;
8370 begin
8371 if FUpdateCount=0 then begin
8372 {$IfDef dbgPaint} DebugLn('Invalidate');{$Endif}
8373 inherited Invalidate;
8374 end;
8375 end;
8376
8377 procedure TCustomGrid.EditingDone;
8378 begin
8379 if not FEditorShowing then
8380 inherited EditingDone;
8381 end;
8382
EditorGetValuenull8383 function TCustomGrid.EditorGetValue(validate:boolean=false): boolean;
8384 var
8385 CurValue,NewValue: string;
8386 begin
8387 result := true;
8388 if (([csDesigning, csDestroying] * ComponentState) = [])
8389 and (Editor<>nil) and Editor.Visible then begin
8390
8391 if validate then begin
8392 CurValue := GetCells(FCol,FRow);
8393 NewValue := CurValue;
8394 result := ValidateEntry(FCol,FRow,FEditorOldValue,NewValue);
8395 if (CurValue<>NewValue) then begin
8396 SetEditText(FCol,FRow,NewValue);
8397 if result then
8398 EditorHide
8399 else
8400 EditorDoSetValue;
8401 exit;
8402 end;
8403 end;
8404
8405 if result then begin
8406 EditorDoGetValue;
8407 EditorHide;
8408 end;
8409 end;
8410 end;
8411
8412 procedure TCustomGrid.EditorSetValue;
8413 begin
8414 if not (csDesigning in ComponentState) then begin
8415 EditorPos;
8416 EditordoSetValue;
8417 end;
8418 end;
8419
8420 procedure TCustomGrid.EditorHide;
8421 var
8422 WasFocused: boolean;
8423 begin
8424 if not EditorLocked and (Editor<>nil) and Editor.Visible then
8425 begin
8426 FEditorMode := False;
8427 FGridState := gsNormal;
8428 if Editor.Parent<>nil then // May be nil when the form is closing.
8429 begin
8430 WasFocused := Editor.Focused;
8431 {$ifdef dbgGrid}DebugLnEnter('EditorHide [',Editor.ClassName,'] INIT FCol=',IntToStr(FCol),' FRow=',IntToStr(FRow));{$endif}
8432 LockEditor;
8433 try
8434 DoEditorHide;
8435 finally
8436 if WasFocused then
8437 SetFocus;
8438 UnLockEditor;
8439 end;
8440 {$ifdef dbgGrid}DebugLnExit('EditorHide END');{$endif}
8441 end;
8442 end;
8443 end;
8444
EditorLockednull8445 function TCustomGrid.EditorLocked: boolean;
8446 begin
8447 Result := FEditorHidingCount <> 0;
8448 end;
8449
EditingAllowednull8450 function TCustomGrid.EditingAllowed(ACol: Integer = -1): Boolean;
8451 var
8452 C: TGridColumn;
8453 begin
8454 Result:=(goEditing in options) and IsColumnIndexValid(ACol) and (RowCount>FixedRows);
8455 if Result and Columns.Enabled then begin
8456 C:=ColumnFromGridColumn(ACol);
8457 Result:=(C<>nil) and (not C.ReadOnly);
8458 end;
8459 end;
8460
8461 procedure TCustomGrid.EditorShow(const SelAll: boolean);
8462 begin
8463 if ([csLoading,csDestroying,csDesigning]*ComponentState<>[])
8464 or (not Enabled) or (not IsVisible)
8465 or (not HandleAllocated) then
8466 Exit;
8467
8468 if EditingAllowed(FCol) and CanEditShow and (not FEditorShowing) and
8469 (Editor<>nil) and (not Editor.Visible) and (not EditorLocked) then
8470 begin
8471 {$ifdef dbgGrid} DebugLnEnter('EditorShow [',Editor.ClassName,'] INIT FCol=',IntToStr(FCol),' FRow=',IntToStr(FRow));{$endif}
8472 FEditorMode:=True;
8473 FEditorOldValue := GetCells(FCol,FRow);
8474 FEditorShowing:=True;
8475 doEditorShow;
8476 FEditorShowing:=False;
8477 if SelAll then
8478 EditorSelectAll;
8479 FGridState := gsNormal;
8480 {$ifdef dbgGrid} DebugLnExit('EditorShow END');{$endif}
8481 end;
8482 end;
8483
8484 procedure TCustomGrid.EditorShowInCell(const aCol, aRow: Integer);
8485 var
8486 OldCol,OldRow: Integer;
8487 begin
8488 OldCol:=FCol;
8489 OldRow:=FRow;
8490 try
8491 EditorGetValue;
8492 FCol:=aCol;
8493 FRow:=aRow;
8494 SelectEditor;
8495 EditorShow(True);
8496 finally
8497 if (FCol=aCol)and(FRow=aRow) then
8498 begin
8499 // Current col,row didn't change, restore old ones
8500 FCol:=OldCol;
8501 FRow:=OldRow;
8502 end;
8503 end;
8504 end;
8505
8506 procedure TCustomGrid.EditorTextChanged(const aCol,aRow: Integer; const aText:string);
8507 begin
8508 SetEditText(aCol, aRow, aText);
8509 end;
8510
8511 procedure TCustomGrid.EditorWidthChanged(aCol, aWidth: Integer);
8512 begin
8513 EditorPos;
8514 end;
8515
FirstGridColumnnull8516 function TCustomGrid.FirstGridColumn: integer;
8517 begin
8518 result := FixedCols;
8519 end;
8520
8521 procedure TCustomGrid.FixDesignFontsPPI(const ADesignTimePPI: Integer);
8522 var
8523 LTitleFontIsDefault: Boolean;
8524 I: Integer;
8525 begin
8526 inherited FixDesignFontsPPI(ADesignTimePPI);
8527
8528 LTitleFontIsDefault := FTitleFontIsDefault;
8529 DoFixDesignFontPPI(TitleFont, ADesignTimePPI);
8530 FTitleFontIsDefault := LTitleFontIsDefault;
8531 for I := 0 to FColumns.Count-1 do
8532 FColumns[I].FixDesignFontsPPI(ADesignTimePPI);
8533 end;
8534
FixedGridnull8535 function TCustomGrid.FixedGrid: boolean;
8536 begin
8537 result := (FixedCols=ColCount) or (FixedRows=RowCount)
8538 end;
8539
8540 procedure TCustomGrid.FontChanged(Sender: TObject);
8541 begin
8542 FRealizedDefRowHeight := 0;
8543 FRealizedDefColWidth := 0;
8544 if csCustomPaint in ControlState then
8545 Canvas.Font := Font
8546 else begin
8547 inherited FontChanged(Sender);
8548 if FColumns.Enabled then
8549 FColumns.FontChanged;
8550 if FTitleFontIsDefault then begin
8551 FTitleFont.Assign(Font);
8552 FTitleFontIsDefault := True;
8553 end;
8554 end;
8555 end;
8556
8557 procedure TCustomGrid.EditorPos;
8558 var
8559 msg: TGridMessage;
8560 CellR: TRect;
8561 PosValid: Boolean;
8562 begin
8563 {$ifdef dbgGrid} DebugLn('Grid.EditorPos INIT');{$endif}
8564 if HandleAllocated and (FEditor<>nil) then begin
8565
8566 // send editor position
8567 Msg.LclMsg.msg:=GM_SETPOS;
8568 Msg.Grid:=Self;
8569 Msg.Col:=FCol;
8570 Msg.Row:=FRow;
8571 FEditor.Dispatch(Msg);
8572
8573 // send editor bounds
8574 PosValid := ColRowToOffset(True, True, FCol, CellR.Left, CellR.Right)
8575 and ColRowToOffSet(False,True, FRow, CellR.Top, CellR.Bottom);
8576 if not PosValid then // Can't position editor; ensure sane values
8577 CellR := Rect(0,0,FEditor.Width, FEditor.Height);
8578
8579 if not PosValid or (CellR.Top<FGCache.FixedHeight) or (CellR.Top>FGCache.ClientHeight) or
8580 (UseRightToLeftAlignment and ((CellR.Right-1>FlipX(FGCache.FixedWidth)) or (CellR.Right<0))) or
8581 (not UseRightToLeftAlignment and ((CellR.Left<FGCache.FixedWidth) or (CellR.Left>FGCache.ClientWidth)))
8582 then
8583 // if editor will be out of sight, make the out of sight coords fixed
8584 // this should avoid range check errors on widgetsets that can't handle
8585 // high control coords (like GTK2)
8586 CellR := Bounds(-FEditor.Width-100, -FEditor.Height-100, CellR.Right-CellR.Left, CellR.Bottom-CellR.Top);
8587
8588 // Make sure to use the grid font, not that of the title (issue #38203).
8589 Canvas.Font.Assign(Font);
8590
8591 if FEditorOptions and EO_AUTOSIZE = EO_AUTOSIZE then begin
8592 if (FEditor = FStringEditor) and (EditorBorderStyle = bsNone) then
8593 CellR := TWSCustomGridClass(WidgetSetClass).
8594 GetEditorBoundsFromCellRect(Canvas, CellR, GetColumnLayout(FCol, False))
8595 else
8596 AdjustInnerCellRect(CellR);
8597 FEditor.BoundsRect := CellR;
8598 end else begin
8599 Msg.LclMsg.msg:=GM_SETBOUNDS;
8600 Msg.CellRect:=CellR;
8601 Msg.Grid:=Self;
8602 Msg.Col:=FCol;
8603 Msg.Row:=FRow;
8604 FEditor.Dispatch(Msg);
8605 end;
8606 end;
8607 {$ifdef dbgGrid} DebugLn('Grid.EditorPos END');{$endif}
8608 end;
8609
8610 procedure TCustomGrid.EditorSelectAll;
8611 var
8612 Msg: TGridMessage;
8613 begin
8614 {$ifdef dbgGrid}DebugLn('EditorSelectALL INIT');{$endif}
8615 if FEditor<>nil then
8616 if FEditorOptions and EO_SELECTALL = EO_SELECTALL then begin
8617 Msg.LclMsg.msg:=GM_SELECTALL;
8618 FEditor.Dispatch(Msg);
8619 end;
8620 {$ifdef dbgGrid}DebugLn('EditorSelectALL END');{$endif}
8621 end;
8622
8623 procedure TCustomGrid.EditordoGetValue;
8624 var
8625 msg: TGridMessage;
8626 begin
8627 if (FEditor<>nil) and FEditor.Visible then begin
8628 Msg.LclMsg.msg:=GM_GETVALUE;
8629 Msg.grid:=Self;
8630 Msg.Col:=FCol;
8631 Msg.Row:=FRow;
8632 Msg.Value:=GetCells(FCol, FRow);
8633 FEditor.Dispatch(Msg);
8634 SetEditText(Msg.Col, Msg.Row, Msg.Value);
8635 end;
8636 end;
8637
8638 procedure TCustomGrid.EditordoResetValue;
8639 var
8640 msg: TGridMessage;
8641 begin
8642 if (FEditor<>nil) and FEditor.Visible then begin
8643 Msg.LclMsg.msg:=GM_SETVALUE;
8644 Msg.grid:=Self;
8645 Msg.Col:=FCol;
8646 Msg.Row:=FRow;
8647 Msg.Value:=FEditorOldValue;
8648 FEditor.Dispatch(Msg);
8649 SetEditText(Msg.Col, Msg.Row, Msg.Value);
8650 end;
8651 end;
8652
8653 procedure TCustomGrid.EditordoSetValue;
8654 var
8655 msg: TGridMessage;
8656 begin
8657 if FEditor<>nil then begin
8658 // Set the editor mask
8659 Msg.LclMsg.msg:=GM_SETMASK;
8660 Msg.Grid:=Self;
8661 Msg.Col:=FCol;
8662 Msg.Row:=FRow;
8663 Msg.Value:=GetEditMask(FCol, FRow);
8664 FEditor.Dispatch(Msg);
8665 // Set the editor value
8666 Msg.LclMsg.msg:=GM_SETVALUE;
8667 Msg.Grid:=Self;
8668 Msg.Col:=FCol;
8669 Msg.Row:=FRow;
8670 Msg.Value:=GetEditText(Fcol, FRow);
8671 FEditor.Dispatch(Msg);
8672 end;
8673 end;
8674
TCustomGrid.EditorCanAcceptKeynull8675 function TCustomGrid.EditorCanAcceptKey(const ch: TUTF8Char): boolean;
8676 begin
8677 result := True;
8678 end;
8679
TCustomGrid.EditorIsReadOnlynull8680 function TCustomGrid.EditorIsReadOnly: boolean;
8681 begin
8682 result := GetColumnReadonly(Col);
8683 end;
8684
8685 procedure TCustomGrid.GetAutoFillColumnInfo(const Index: Integer; var aMin,aMax,aPriority: Integer);
8686 var
8687 C: TGridColumn;
8688 begin
8689 if Index<FixedCols then
8690 APriority := 0
8691 else if Columns.Enabled then begin
8692 C := ColumnFromGridColumn(Index);
8693 if C<>nil then begin
8694 aMin := C.MinSize;
8695 aMax := C.MaxSize;
8696 aPriority := C.SizePriority;
8697 end else
8698 APriority := 1;
8699 end else
8700 APriority := 1;
8701 end;
8702
GetCellHintTextnull8703 function TCustomGrid.GetCellHintText(ACol, ARow: Integer): string;
8704 begin
8705 Result := '';
8706 if Assigned(FOnGetCellHint) then
8707 FOnGetCellHint(self, ACol, ARow, result);
8708 end;
8709
GetTruncCellHintTextnull8710 function TCustomGrid.GetTruncCellHintText(ACol, ARow: Integer): string;
8711 begin
8712 Result := GetCells(ACol, ARow);
8713 if Assigned(FOnGetCellHint) and (FCellHintPriority = chpTruncOnly) then
8714 FOnGetCellHint(self, ACol, ARow, result);
8715 end;
8716
TCustomGrid.GetCellsnull8717 function TCustomGrid.GetCells(ACol, ARow: Integer): string;
8718 begin
8719 result := '';
8720 end;
8721
8722 procedure TCustomGrid.EditorKeyDown(Sender: TObject; var Key:Word; Shift:TShiftState);
8723 begin
8724 {$ifdef dbgGrid}DebugLn('Grid.EditorKeyDown Key=',dbgs(Key),' INIT');{$endif}
8725 FEditorKey:=True; // Just a flag to see from where the event comes
8726 KeyDown(Key, shift);
8727 FEditorKey:=False;
8728 {$ifdef dbgGrid}DebugLn('Grid.EditorKeyDown Key=',dbgs(Key),' END');{$endif}
8729 end;
8730
8731 procedure TCustomGrid.EditorKeyPress(Sender: TObject; var Key: Char);
8732 var
8733 AChar: TUTF8Char;
8734 {$ifdef dbgGrid}
PrintKeynull8735 function PrintKey:String;
8736 begin
8737 Result := Dbgs(ord(key))+' $' + IntToHex(ord(key),2);
8738 if Key>#31 then
8739 Result := Key + ' ' + Result
8740 end;
8741 {$endif}
8742 begin
8743 {$ifdef dbgGrid}DebugLn('Grid.EditorKeyPress: INIT Key=',PrintKey);{$Endif}
8744 FEditorKey := True;
8745 KeyPress(Key); // grid must get all keypresses, even if they are from the editor
8746 {$ifdef dbgGrid}DebugLn('Grid.EditorKeyPress: inter Key=',PrintKey);{$Endif}
8747 case Key of
8748 #0, ^C,^V,^X:;
8749
8750 ^M:
8751 begin
8752 Include(FGridFlags, gfEditingDone);
8753 if not MoveNextAuto(GetKeyState(VK_SHIFT) < 0) then
8754 ResetEditor;
8755 Exclude(FGridFlags, gfEditingDone);
8756 Key := #0;
8757 end;
8758
8759 else begin
8760 AChar := Key;
8761 if not EditorCanAcceptKey(AChar) or EditorIsReadOnly then
8762 Key := #0
8763 else
8764 Key := AChar[1];
8765 end;
8766 end;
8767 FEditorKey := False;
8768 {$ifdef dbgGrid}DebugLn('Grid.EditorKeyPress: END Key=',PrintKey);{$Endif}
8769 end;
8770
8771 procedure TCustomGrid.EditorUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char
8772 );
8773 begin
8774 FEditorKey := True;
8775 UTF8KeyPress(UTF8Key);
8776 FEditorKey := false;
8777 end;
8778
8779 procedure TCustomGrid.EditorKeyUp(Sender: TObject; var key: Word;
8780 shift: TShiftState);
8781 begin
8782 FEditorKey := True;
8783 KeyUp(Key, Shift);
8784 FEditorKey := False;
8785 end;
8786
8787 procedure TCustomGrid.SelectEditor;
8788 var
8789 aEditor: TWinControl;
8790 begin
8791 {$ifdef DbgGrid}
8792 DebugLnEnter('TCustomGrid.SelectEditor INIT');
8793 {$endif}
8794 aEditor := GetDefaultEditor(Col);
8795 if EditingAllowed(FCol) and Assigned(OnSelectEditor) then begin
8796 // in some situations there are only non-selectable cells
8797 // if goAlwaysShowEditor is on set initially editor to nil,
8798 // user can modify this value in OnSelectEditor if needed
8799 if not SelectCell(FCol,FRow) then
8800 aEditor:=nil;
8801 OnSelectEditor(Self, fCol, FRow, aEditor);
8802 end;
8803 if aEditor<>Editor then
8804 Editor := aEditor;
8805 if Assigned(Editor) and not Assigned(Editor.Popupmenu) then
8806 Editor.PopupMenu := PopupMenu;
8807 {$ifdef DbgGrid}
8808 DebugLnExit('TCustomGrid.SelectEditor END');
8809 {$endif}
8810 end;
8811
EditorAlwaysShownnull8812 function TCustomGrid.EditorAlwaysShown: Boolean;
8813 begin
8814 Result:=EditingAllowed(FCol) and (goAlwaysShowEditor in Options) and not FixedGrid;
8815 end;
8816
8817 //
8818 procedure TCustomGrid.FixPosition(IsColumn: Boolean; aIndex: Integer);
8819 var
8820 OldCol,OldRow: Integer;
8821
8822 procedure FixSelection;
8823 begin
8824 if FRow > FRows.Count - 1 then
8825 FRow := FRows.Count - 1
8826 else if (FRow < FixedRows) and (FixedRows<FRows.Count) then
8827 FRow := FixedRows;
8828 if FCol > FCols.Count - 1 then
8829 FCol := FCols.Count - 1
8830 else if (FCol < FixedCols) and (FixedCols<FCols.Count) then
8831 FCol := FixedCols;
8832 end;
8833 procedure FixTopLeft;
8834 var
8835 oldTL: TPoint;
8836 VisCount: Integer;
8837 begin
8838 OldTL:=FTopLeft;
8839 VisCount := FGCache.VisibleGrid.Right-FGCache.VisibleGrid.Left+1;
8840 if OldTL.X+VisCount>FCols.Count then begin
8841 OldTL.X := FCols.Count - VisCount;
8842 if OldTL.X<FixedCols then
8843 OldTL.X := FixedCols;
8844 end;
8845 VisCount := FGCache.VisibleGrid.Bottom-FGCache.VisibleGrid.Top+1;
8846 if OldTL.Y+VisCount>FRows.Count then begin
8847 OldTL.Y := FRows.Count - VisCount;
8848 if OldTL.Y<FixedRows then
8849 OldTL.Y:=FixedRows;
8850 end;
8851 if not PointIgual(OldTL, FTopleft) then begin
8852 fTopLeft := OldTL;
8853 //DebugLn('TCustomGrid.FixPosition ',DbgSName(Self),' FTopLeft=',dbgs(FTopLeft));
8854 topleftChanged;
8855 end;
8856 end;
8857 procedure FixEditor;
8858 var
8859 ColRow: Integer;
8860 begin
8861 if FixedGrid then begin
8862 EditorMode:=False;
8863 exit;
8864 end;
8865 if IsColumn then
8866 ColRow:=OldCol
8867 else
8868 ColRow:=OldRow;
8869 {$ifdef dbgeditor}
8870 DebugLn('FixEditor: aIndex=%d ColRow=%d EditorMode=%s',[aIndex,ColRow,dbgs(EditorMode)]);
8871 {$endif}
8872 // Changed index is same as current colrow, new colrow may change
8873 if AIndex=ColRow then begin
8874 EditorMode:=False;
8875 if EditorAlwaysShown then begin
8876 SelectEditor;
8877 EditorMode:=True;
8878 end;
8879 end else
8880 // Changed index in before current colrow, just translate editor
8881 if (AIndex<ColRow) and EditorMode then begin
8882 if IsColumn then
8883 AdjustEditorBounds(ColRow-1, OldRow)
8884 else
8885 AdjustEditorBounds(OldCol, ColRow-1)
8886 end;
8887 // else: changed index is after current colrow, it doesn't affect editor
8888 end;
8889 begin
8890 OldCol := Col;
8891 OldRow := Row;
8892 FixTopleft;
8893 FixSelection;
8894 CheckPosition;
8895 UpdateSelectionRange;
8896 VisualChange;
8897 FixEditor;
8898 end;
8899
8900 procedure TCustomGrid.FixScroll;
8901 var
8902 OldColOffset: Integer;
8903 OldTopLeft: TPoint;
8904 begin
8905 // TODO: fix rows too
8906 // column handling
8907 if FGCache.OldMaxTopLeft.x<>FGCache.MaxTopLeft.x then begin
8908 // keeping FullVisibleGrid try to find a better topleft. We care are only
8909 // if the grid is smaller than before, comparing GridWidth should work also
8910 // but MaxTopLeft has better granularity
8911 if FGCache.MaxTopLeft.x<FGCache.OldMaxTopLeft.x then begin
8912 OldColOffset := FGCache.TLColOff;
8913 OldTopLeft := fTopLeft;
8914 FGCache.TLColOff := 0;
8915 fTopleft.x := FixedCols;
8916 if not ScrollToCell(FGCache.FullVisibleGrid.Right, Row, True) then begin
8917 // target cell is now visible ....
8918 if OldTopLeft.x<>fTopLeft.x then
8919 // but the supposed startig left col is not the same as the current one
8920 doTopleftChange(False)
8921 else begin
8922 FGCache.TLColOff := OldColOffset;
8923 fTopLeft := OldTopLeft;
8924 end;
8925 end;
8926 end;
8927 end;
8928 end;
8929
8930 procedure TCustomGrid.EditorShowChar(Ch: TUTF8Char);
8931 begin
8932 SelectEditor;
8933 if FEDitor<>nil then begin
8934 if EditorCanAcceptKey(ch) and not EditorIsReadOnly then begin
8935 EditorShow(true);
8936 TWSCustomGridClass(WidgetSetClass).SendCharToEditor(Editor, Ch);
8937 //this method bypasses Self.KeyDown and therefore will not reset FRowAutoInserted there
8938 //So, set it to false, unless pressing a backspace caused the editor to pop-up
8939 if (Ch <> ^H) then FRowAutoInserted := False;
8940 end;
8941 end;
8942 end;
8943
8944 procedure TCustomGrid.EditorSetMode(const AValue: Boolean);
8945 begin
8946 {$ifdef dbgGrid}DebugLn('Grid.EditorSetMode=',dbgs(Avalue),' INIT');{$endif}
8947 if not AValue then
8948 EditorHide
8949 else
8950 EditorShow(false);
8951 {$ifdef dbgGrid}DebugLn('Grid.EditorSetMode END');{$endif}
8952 end;
8953
GetSelectedColornull8954 function TCustomGrid.GetSelectedColor: TColor;
8955 begin
8956 Result:=FSelectedColor;
8957 end;
8958
GetTitleShowPrefixnull8959 function TCustomGrid.GetTitleShowPrefix(Column: Integer): boolean;
8960 var
8961 C: TGridColumn;
8962 begin
8963 C := ColumnFromGridColumn(Column);
8964 if C<>nil then
8965 result := C.Title.PrefixOption<>poNone
8966 else
8967 result := false;
8968 end;
8969
GridColumnFromColumnIndexnull8970 function TCustomGrid.GridColumnFromColumnIndex(ColumnIndex: Integer): Integer;
8971 begin
8972 {$ifdef NewCols}
8973 result := ColumnIndex + FirstGridColumn;
8974 if Result>ColCount-1 then
8975 Result := -1;
8976 {$else}
8977 result := Columns.VisibleIndex(ColumnIndex);
8978 if result>=0 then
8979 result := result + FixedCols;
8980 {$endif}
8981 end;
8982
8983 procedure TCustomGrid.GridMouseWheel(Shift: TShiftState; Delta: Integer);
8984 begin
8985 // Ctrl-key is to support horiz scrolling with basic mouse
8986 if ssCtrl in Shift then
8987 MoveNextSelectable(true, Delta, 0)
8988 else
8989 MoveNextSelectable(true, 0, Delta);
8990 end;
8991
GetEditMasknull8992 function TCustomGrid.GetEditMask(ACol, ARow: Longint): string;
8993 begin
8994 result:='';
8995 end;
8996
GetEditTextnull8997 function TCustomGrid.GetEditText(ACol, ARow: Longint): string;
8998 begin
8999 result:='';
9000 end;
9001
GetColumnAlignmentnull9002 function TCustomGrid.GetColumnAlignment(Column: Integer; ForTitle: Boolean): TAlignment;
9003 var
9004 C: TGridColumn;
9005 begin
9006 C := ColumnFromGridColumn(Column);
9007 if C<>nil then
9008 if ForTitle then
9009 Result := C.Title.Alignment
9010 else
9011 Result := C.Alignment
9012 else
9013 result := GetDefaultColumnAlignment(Column);
9014 end;
9015
GetColumnColornull9016 function TCustomGrid.GetColumnColor(Column: Integer; ForTitle: Boolean): TColor;
9017 var
9018 C: TGridColumn;
9019 begin
9020 C := ColumnFromGridColumn(Column);
9021 if C<>nil then
9022 if ForTitle then
9023 result := C.Title.Color
9024 else
9025 result := C.Color
9026 else
9027 if ForTitle then
9028 result := FixedColor
9029 else
9030 result := Self.Color;
9031 end;
9032
GetColumnFontnull9033 function TCustomGrid.GetColumnFont(Column: Integer; ForTitle: Boolean): TFont;
9034 var
9035 C: TGridColumn;
9036 begin
9037 C := ColumnFromGridColumn(Column);
9038 if C<>nil then
9039 if ForTitle then
9040 Result := C.Title.Font
9041 else
9042 Result := C.Font
9043 else begin
9044 if ForTitle then
9045 Result := TitleFont
9046 else
9047 Result := Self.Font;
9048 end;
9049 end;
9050
GetColumnLayoutnull9051 function TCustomGrid.GetColumnLayout(Column: Integer; ForTitle: boolean): TTextLayout;
9052 var
9053 C: TGridColumn;
9054 begin
9055 C := ColumnFromGridColumn(Column);
9056 if C<>nil then
9057 if ForTitle then
9058 Result := C.Title.Layout
9059 else
9060 Result := C.Layout
9061 else
9062 result := GetDefaultColumnLayout(Column);
9063 end;
9064
GetColumnReadonlynull9065 function TCustomGrid.GetColumnReadonly(Column: Integer): boolean;
9066 var
9067 C: TGridColumn;
9068 begin
9069 C := ColumnFromGridColumn(Column);
9070 if C<>nil then
9071 result := C.ReadOnly
9072 else
9073 result := GetDefaultColumnReadOnly(Column);
9074 end;
9075
GetColumnTitlenull9076 function TCustomGrid.GetColumnTitle(Column: Integer): string;
9077 var
9078 C: TGridColumn;
9079 begin
9080 C := ColumnFromGridColumn(Column);
9081 if C<>nil then
9082 Result := C.Title.Caption
9083 else
9084 result := GetDefaultColumnTitle(Column);
9085 end;
9086
GetColumnWidthnull9087 function TCustomGrid.GetColumnWidth(Column: Integer): Integer;
9088 var
9089 C: TGridColumn;
9090 begin
9091 C := ColumnFromGridColumn(Column);
9092 if C<>nil then
9093 Result := C.Width
9094 else
9095 Result := GetDefaultColumnWidth(Column);
9096 end;
9097
9098 // return the relative cell coordinate of the next cell
9099 // considering AutoAdvance property and selectable cells.
GetDeltaMoveNextnull9100 function TCustomGrid.GetDeltaMoveNext(const Inverse: boolean;
9101 var ACol, ARow: Integer; const AAutoAdvance: TAutoAdvance): boolean;
9102 var
9103
9104 DeltaCol,DeltaRow: Integer;
9105
9106 function CalcNextStep: boolean;
9107 var
9108 aa: TAutoAdvance;
9109 cCol,cRow: Integer;
9110 begin
9111
9112 DeltaCol := 0;
9113 DeltaRow := 0;
9114
9115 aa := AAutoAdvance;
9116 if Inverse then
9117 case aa of
9118 aaRight: aa := aaLeft;
9119 aaLeft: aa := aaRight;
9120 aaRightDown: aa := aaLeftUp;
9121 aaLeftDown: aa := aaRightUp;
9122 aaRightUP: aa := aaLeftDown;
9123 aaLeftUP: aa := aaRightDown;
9124 end;
9125
9126 case aa of
9127 aaRight:
9128 DeltaCol := 1;
9129
9130 aaLeft:
9131 DeltaCol := -1;
9132
9133 aaDown:
9134 DeltaRow := 1;
9135
9136 aaRightDown:
9137 if ACol<ColCount-1 then
9138 DeltaCol := 1
9139 else begin
9140 DeltaCol := FixedCols-ACol;
9141 DeltaRow := 1;
9142 end;
9143
9144 aaRightUP:
9145 if ACol<ColCount-1 then
9146 DeltaCol := 1
9147 else begin
9148 DeltaCol := FixedCols-ACol;
9149 DeltaRow := -1;
9150 end;
9151
9152 aaLeftUP:
9153 if ACol>FixedCols then
9154 DeltaCol := -1
9155 else begin
9156 DeltaCol := ColCount-1-ACol;
9157 DeltaRow := -1;
9158 end;
9159
9160 aaLeftDown:
9161 if ACol>FixedCols then
9162 DeltaCol := -1
9163 else begin
9164 DeltaCol := ColCount-1-ACol;
9165 DeltaRow := 1;
9166 end;
9167 end;
9168
9169 CCol := ACol + DeltaCol;
9170 CRow := ARow + DeltaRow;
9171
9172 // is CCol,CRow within range?
9173 result :=
9174 (CCol<=ColCount-1)and(CCol>=FixedCols)and
9175 (CRow<=RowCount-1)and(CRow>=FixedRows);
9176 end;
9177
9178 begin
9179 ACol := FCol;
9180 ARow := FRow;
9181
9182 result := False;
9183
9184 if AAutoAdvance=aaNone then begin
9185 ACol := 0;
9186 ARow := 0;
9187 exit; // quick case, no auto movement allowed
9188 end;
9189
9190 if [goRowSelect,goRelaxedRowSelect]*Options=[goRowSelect] then begin
9191 if Inverse then
9192 ACol := FixedCols
9193 else
9194 ACol := ColCount-1;
9195 end;
9196
9197 // browse the grid in autoadvance order
9198 while CalcNextStep do begin
9199 ACol := ACol + DeltaCol;
9200 ARow := ARow + DeltaRow;
9201 // is cell ACol,ARow selectable?
9202 result := SelectCell(ACol,ARow);
9203 if Result then
9204 break;
9205 end;
9206
9207 if result then begin
9208 // return relative position
9209 ACol := ACol - FCol;
9210 ARow := ARow - FRow;
9211 end else begin
9212 // no available next cell, return delta anyway
9213 ACol := DeltaCol;
9214 ARow := DeltaRow;
9215 end;
9216 end;
9217
GetDefaultColumnAlignmentnull9218 function TCustomGrid.GetDefaultColumnAlignment(Column: Integer): TAlignment;
9219 begin
9220 result := DefaultTextStyle.Alignment;
9221 end;
9222
GetDefaultEditornull9223 function TCustomGrid.GetDefaultEditor(Column: Integer): TWinControl;
9224 var
9225 C: TGridColumn;
9226 bs: TColumnButtonStyle;
9227 begin
9228 result := nil;
9229 if EditingAllowed(Col) then begin
9230 C := ColumnFromGridColumn(Column);
9231 if C<>nil then begin
9232 bs := C.ButtonStyle;
9233 if (bs=cbsAuto) and (C.PickList<>nil) and (C.PickList.Count>0) then
9234 bs := cbsPicklist
9235 end else
9236 bs := cbsAuto;
9237
9238 result := EditorByStyle( Bs );
9239
9240 // by default do the editor setup here
9241 // if user wants to change our setup, this can
9242 // be done in OnSelectEditor
9243 if (bs=cbsPickList) and (C<>nil) and (C.PickList<>nil) and
9244 (result = FPicklistEditor) then begin
9245 FPickListEditor.Items.Assign(C.PickList);
9246 FPickListEditor.DropDownCount := C.DropDownRows;
9247 end
9248
9249 end;
9250 end;
9251
GetDefaultRowHeightnull9252 function TCustomGrid.GetDefaultRowHeight: integer;
9253 var
9254 TmpCanvas: TCanvas;
9255 begin
9256 tmpCanvas := GetWorkingCanvas(Canvas);
9257 tmpCanvas.Font := Font;
9258 tmpCanvas.Font.PixelsPerInch := Font.PixelsPerInch;
9259 result := tmpCanvas.TextHeight('Fj')+7;
9260 if tmpCanvas<>Canvas then
9261 FreeWorkingCanvas(tmpCanvas);
9262 end;
9263
GetGridDrawStatenull9264 function TCustomGrid.GetGridDrawState(ACol, ARow: Integer): TGridDrawState;
9265 begin
9266 Result := [];
9267 if ARow < FFixedRows then
9268 include(Result, gdFixed)
9269 else begin
9270 if (aCol = FCol) and (aRow = FRow) then
9271 Result := Result + [gdFocused, gdSelected]
9272 else
9273 if IsCellSelected[aCol, aRow] then
9274 include(Result, gdSelected);
9275 end;
9276 if (aRow=FRow) and (goRowHighlight in FOptions) and not (gdFixed in Result) then
9277 Result := Result + [gdRowHighlight];
9278 with FGCache do begin
9279 if (ACol = HotCell.x) and (ARow = HotCell.y) and not IsPushCellActive()
9280 then Include(Result, gdHot);
9281 if ClickCellPushed and (ACol = PushedCell.x) and (ARow = PushedCell.y)
9282 then Include(Result, gdPushed);
9283 end;
9284 end;
9285
GetScrollBarPositionnull9286 function TCustomGrid.GetScrollBarPosition(Which: integer): Integer;
9287 var
9288 ScrollInfo: TScrollInfo;
9289 begin
9290 if HandleAllocated then begin
9291 ScrollInfo.cbSize := SizeOf(ScrollInfo);
9292 ScrollInfo.fMask := SIF_POS;
9293 GetScrollInfo(Handle, Which, ScrollInfo);
9294 Result:=ScrollInfo.nPos;
9295 end
9296 else
9297 Result:=0;
9298 end;
9299
GetDefaultColumnWidthnull9300 function TCustomGrid.GetDefaultColumnWidth(Column: Integer): Integer;
9301 begin
9302 Result := FDefColWidth;
9303 end;
9304
GetDefaultColumnLayoutnull9305 function TCustomGrid.GetDefaultColumnLayout(Column: Integer): TTextLayout;
9306 begin
9307 result := DefaultTextStyle.Layout;
9308 end;
9309
GetDefaultColumnReadOnlynull9310 function TCustomGrid.GetDefaultColumnReadOnly(Column: Integer): boolean;
9311 begin
9312 result := false;
9313 end;
9314
GetDefaultColumnTitlenull9315 function TCustomGrid.GetDefaultColumnTitle(Column: Integer): string;
9316 begin
9317 result := '';
9318 end;
9319
9320 procedure TCustomGrid.SetEditText(ACol, ARow: Longint; const Value: string);
9321 begin
9322 end;
9323
CanGridAcceptKeynull9324 function TCustomGrid.CanGridAcceptKey(Key: Word; Shift: TShiftState): Boolean;
9325 begin
9326 Result := True;
9327 end;
9328
9329 procedure TCustomGrid.SetSelectedColor(const AValue: TColor);
9330 begin
9331 if FSelectedColor<>AValue then begin
9332 FSelectedColor:=AValue;
9333 Invalidate;
9334 end;
9335 end;
9336
9337 procedure TCustomGrid.SetFixedcolor(const AValue: TColor);
9338 begin
9339 if FFixedColor<>AValue then begin
9340 FFixedColor:=Avalue;
9341 Invalidate;
9342 end;
9343 end;
9344
GetFixedcolornull9345 function TCustomGrid.GetFixedcolor: TColor;
9346 begin
9347 result:=FFixedColor;
9348 end;
9349
GetFirstVisibleColumnnull9350 function TCustomGrid.GetFirstVisibleColumn: Integer;
9351 begin
9352 result := FixedCols;
9353 while (result<ColCount) and (ColWidths[result]=0) do
9354 inc(result); // extreme case may return colcount
9355 end;
9356
GetFirstVisibleRownull9357 function TCustomGrid.GetFirstVisibleRow: Integer;
9358 begin
9359 result := FixedRows;
9360 while (result<RowCount) and (RowHeights[result]=0) do
9361 inc(result); // ditto
9362 end;
9363
GetLastVisibleColumnnull9364 function TCustomGrid.GetLastVisibleColumn: Integer;
9365 begin
9366 result := ColCount-1;
9367 while (result>=0) and (ColWidths[result]=0) do
9368 dec(result); // extreme case may return -1
9369 end;
9370
GetLastVisibleRownull9371 function TCustomGrid.GetLastVisibleRow: Integer;
9372 begin
9373 result := RowCount-1;
9374 while (result>=0) and (RowHeights[result]=0) do
9375 dec(result); // ditto
9376 end;
9377
9378 procedure TCustomGrid.ColWidthsChanged;
9379 begin
9380 //
9381 end;
9382 procedure TCustomGrid.RowHeightsChanged;
9383 begin
9384 //
9385 end;
9386
RTLSignnull9387 function TCustomGrid.RTLSign: Integer;
9388 const
9389 cRTLSign: array[TBiDiMode] of Integer = (1, -1, 1, 1);
9390 begin
9391 Result := cRTLSign[BiDiMode];
9392 end;
9393
9394 procedure TCustomGrid.SaveColumns(cfg: TXMLConfig; Version: integer);
9395 var
9396 Path,cPath: string;
9397 i: Integer;
9398 c: TGridColumn;
9399 begin
9400 Path := 'grid/design/columns/';
9401 cfg.SetValue(Path + 'columnsenabled', True);
9402 cfg.SetValue(Path + 'columncount', columns.Count);
9403 for i := 0 to columns.Count - 1 do begin
9404 c := Columns[i];
9405 cPath := Path + 'column' + IntToStr(i);
9406 cfg.setValue(cPath + '/index/value', c.Index);
9407 if c.IsWidthStored then
9408 cfg.setValue(cPath + '/width/value', c.Width);
9409 if c.IsAlignmentStored then
9410 cfg.setValue(cPath + '/alignment/value', ord(c.Alignment));
9411 if c.IsLayoutStored then
9412 cfg.setValue(cPath + '/layout/value', ord(c.Layout));
9413 cfg.setValue(cPath + '/buttonstyle/value', ord(c.ButtonStyle));
9414 if c.IsColorStored then
9415 cfg.setValue(cPath + '/color/value', colortostring(c.Color));
9416 if c.IsValueCheckedStored then
9417 cfg.setValue(cPath + '/valuechecked/value', c.ValueChecked);
9418 if c.IsValueUncheckedStored then
9419 cfg.setValue(cPath + '/valueunchecked/value', c.ValueUnChecked);
9420 if c.PickList.Count>0 then
9421 cfg.SetValue(cPath + '/picklist/value', c.PickList.CommaText);
9422 if c.IsSizePriorityStored then
9423 cfg.SetValue(cPath + '/sizepriority/value', c.SizePriority);
9424 if not c.IsDefaultFont then
9425 CfgSetFontValue(cfg, cPath + '/font', c.Font);
9426 cfg.setValue(cPath + '/title/caption/value', c.Title.Caption);
9427 if not c.Title.IsDefaultFont then
9428 CfgSetFontValue(cfg, cPath + '/title/font', c.Title.Font);
9429 if c.Title.IsAlignmentStored then
9430 cfg.setValue(cPath + '/title/alignment/value', ord(c.Title.Alignment));
9431 if c.Title.IsColorStored then
9432 cfg.setValue(cPath + '/title/color/value', colortostring(c.Title.Color));
9433 if c.Title.IsLayoutStored then
9434 cfg.setValue(cPath + '/title/layout/value', ord(c.Title.Layout));
9435
9436 doSaveColumn(self, c, -1, Cfg, Version, cPath);
9437 end;
9438 end;
9439
9440 procedure TCustomGrid.SaveContent(cfg: TXMLConfig);
9441 var
9442 i,j,k: Integer;
9443 Path, tmpPath: string;
9444 begin
9445 cfg.SetValue('grid/version', GRIDFILEVERSION);
9446
9447 Cfg.SetValue('grid/saveoptions/create', soDesign in SaveOptions);
9448 if soDesign in SaveOptions then begin
9449 Cfg.SetValue('grid/design/columncount', ColCount);
9450 Cfg.SetValue('grid/design/rowcount', RowCount);
9451 Cfg.SetValue('grid/design/fixedcols', FixedCols);
9452 Cfg.SetValue('grid/design/fixedrows', Fixedrows);
9453 Cfg.SetValue('grid/design/defaultcolwidth', DefaultColWidth);
9454 Cfg.SetValue('grid/design/isdefaultcolwidth', ord(DefaultColWidthIsStored));
9455 Cfg.SetValue('grid/design/defaultrowheight',DefaultRowHeight);
9456 Cfg.SetValue('grid/design/isdefaultrowheight', ord(DefaultRowHeightIsStored));
9457 Cfg.Setvalue('grid/design/color',ColorToString(Color));
9458
9459 if Columns.Enabled then
9460 saveColumns(cfg, GRIDFILEVERSION)
9461 else begin
9462 j:=0;
9463 for i:=0 to ColCount-1 do begin
9464 k:=FCols[i];
9465 if (k>=0)and(k<>DefaultColWidth) then begin
9466 inc(j);
9467 tmpPath := 'grid/design/columns/column'+IntToStr(j);
9468 cfg.SetValue('grid/design/columns/columncount',j);
9469 cfg.SetValue(tmpPath+'/index', i);
9470 cfg.SetValue(tmpPath+'/width', k);
9471 doSaveColumn(self, nil, i, Cfg, GRIDFILEVERSION, tmpPath);
9472 end;
9473 end;
9474 end;
9475
9476 j:=0;
9477 for i:=0 to RowCount-1 do begin
9478 k:=FRows[i];
9479 if (k>=0)and(k<>DefaultRowHeight) then begin
9480 inc(j);
9481 cfg.SetValue('grid/design/rows/rowcount',j);
9482 cfg.SetValue('grid/design/rows/row'+IntToStr(j)+'/index', i);
9483 cfg.SetValue('grid/design/rows/row'+IntToStr(j)+'/height',k);
9484 end;
9485 end;
9486
9487 SaveGridOptions(Cfg);
9488 end;
9489
9490 Cfg.SetValue('grid/saveoptions/position', soPosition in SaveOptions);
9491 if soPosition in SaveOptions then begin
9492 Cfg.SetValue('grid/position/topleftcol',ftopleft.x);
9493 Cfg.SetValue('grid/position/topleftrow',ftopleft.y);
9494 Cfg.SetValue('grid/position/col',fCol);
9495 Cfg.SetValue('grid/position/row',fRow);
9496 if goRangeSelect in Options then begin
9497 Cfg.SetValue('grid/position/selection/left',Selection.left);
9498 Cfg.SetValue('grid/position/selection/top',Selection.top);
9499 Cfg.SetValue('grid/position/selection/right',Selection.right);
9500 Cfg.SetValue('grid/position/selection/bottom',Selection.bottom);
9501 end;
9502 end;
9503 end;
9504
9505 procedure TCustomGrid.SaveGridOptions(cfg: TXMLConfig);
9506 var
9507 Path: string;
9508 begin
9509 Path:='grid/design/options/';
9510 Cfg.SetValue(Path+'goFixedVertLine/value', goFixedVertLine in options);
9511 Cfg.SetValue(Path+'goFixedHorzLine/value', goFixedHorzLine in options);
9512 Cfg.SetValue(Path+'goVertLine/value', goVertLine in options);
9513 Cfg.SetValue(Path+'goHorzLine/value', goHorzLine in options);
9514 Cfg.SetValue(Path+'goRangeSelect/value', goRangeSelect in options);
9515 Cfg.SetValue(Path+'goDrawFocusSelected/value', goDrawFocusSelected in options);
9516 Cfg.SetValue(Path+'goRowSizing/value', goRowSizing in options);
9517 Cfg.SetValue(Path+'goColSizing/value', goColSizing in options);
9518 Cfg.SetValue(Path+'goRowMoving/value', goRowMoving in options);
9519 Cfg.SetValue(Path+'goColMoving/value', goColMoving in options);
9520 Cfg.SetValue(Path+'goEditing/value', goEditing in options);
9521 Cfg.SetValue(Path+'goAutoAddRows/value', goAutoAddRows in options);
9522 Cfg.SetValue(Path+'goTabs/value', goTabs in options);
9523 Cfg.SetValue(Path+'goRowSelect/value', goRowSelect in options);
9524 Cfg.SetValue(Path+'goAlwaysShowEditor/value', goAlwaysShowEditor in options);
9525 Cfg.SetValue(Path+'goThumbTracking/value', goThumbTracking in options);
9526 Cfg.SetValue(Path+'goColSpanning/value', goColSpanning in options);
9527 cfg.SetValue(Path+'goRelaxedRowSelect/value', goRelaxedRowSelect in options);
9528 cfg.SetValue(Path+'goDblClickAutoSize/value', goDblClickAutoSize in options);
9529 Cfg.SetValue(Path+'goSmoothScroll/value', goSmoothScroll in Options);
9530 Cfg.SetValue(Path+'goAutoAddRowsSkipContentCheck/value', goAutoAddRowsSkipContentCheck in Options);
9531 Cfg.SetValue(Path+'goRowHighlight/value', goRowHighlight in Options);
9532 Cfg.SetValue(Path+'goScrollToLastCol/value', goScrollToLastCol in Options2);
9533 Cfg.SetValue(Path+'goScrollToLastRow/value', goScrollToLastRow in Options2);
9534 end;
9535
9536 procedure TCustomGrid.LoadColumns(cfg: TXMLConfig; Version: integer);
9537 var
9538 i, k: integer;
9539 path, cPath, s: string;
9540 c: TGridColumn;
9541 begin
9542 Path := 'grid/design/columns/';
9543 k := cfg.getValue(Path + 'columncount', 0);
9544 for i := 0 to k - 1 do
9545 Columns.Add;
9546 for i := 0 to k - 1 do begin
9547 c := Columns[i];
9548 cPath := Path + 'column' + IntToStr(i);
9549 c.index := cfg.getValue(cPath + '/index/value', i);
9550 s := cfg.GetValue(cPath + '/width/value', '');
9551 if s<>'' then
9552 c.Width := StrToIntDef(s, 64);
9553 s := cfg.getValue(cPath + '/alignment/value', '');
9554 if s<>'' then
9555 c.Alignment := TAlignment(StrToIntDef(s, 0));
9556 s := cfg.GetValue(cPath + '/layout/value', '');
9557 if s<>'' then
9558 c.Layout := TTextLayout(StrToIntDef(s, 0));
9559 s := cfg.getValue(cPath + '/buttonstyle/value', '0');
9560 c.ButtonStyle := TColumnButtonStyle(StrToInt(s));
9561 s := cfg.getValue(cPath + '/color/value', '');
9562 if s<>'' then
9563 c.Color := StringToColor(s);
9564 s := cfg.getValue(cPath + '/valuechecked/value', '');
9565 if s<>'' then
9566 c.ValueChecked := s;
9567 s := cfg.getValue(cPath + '/valueunchecked/value', '');
9568 if s<>'' then
9569 c.ValueUnChecked := s;
9570 s := cfg.GetValue(cPath + '/picklist/value', '');
9571 if s<>'' then
9572 c.PickList.CommaText := s;
9573 s := cfg.GetValue(cPath + '/sizepriority/value', '');
9574 if s<>'' then
9575 c.SizePriority := StrToIntDef(s, 0);
9576 s := cfg.GetValue(cPath + '/font/name/value', '');
9577 if s<>'' then
9578 cfgGetFontValue(cfg, cPath + '/font', c.Font);
9579 c.Title.Caption := cfg.getValue(cPath + '/title/caption/value', 'title ' + IntToStr(i));
9580 s := cfg.GetValue(cPath + '/title/font/name/value', '');
9581 if s<>'' then
9582 cfgGetFontValue(cfg, cPath + '/title/font', c.Title.Font);
9583 s := cfg.getValue(cPath + '/title/alignment/value', '');
9584 if s<>'' then
9585 c.Title.Alignment := TAlignment(StrToIntDef(s, 0));
9586 s := cfg.getValue(cPath + '/title/color/value', '');
9587 if s<>'' then
9588 c.Title.Color := StringToColor(s);
9589 s := cfg.GetValue(cPath + 'title/layout/value', '');
9590 if s<>'' then
9591 c.Title.Layout := TTextLayout(StrToIntDef(s, 0));
9592
9593 doLoadColumn(self, c, -1, cfg, version, cpath);
9594 end;
9595 end;
9596
9597
9598 procedure TCustomGrid.LoadContent(cfg: TXMLConfig; Version: Integer);
9599 var
9600 CreateSaved: Boolean;
9601 i,j,k: Integer;
9602 Path, tmpPath: string;
9603 begin
9604 if soDesign in FSaveOptions then begin
9605 CreateSaved:=Cfg.GetValue('grid/saveoptions/create', false);
9606 if CreateSaved then begin
9607 Clear;
9608 Columns.Clear;
9609 FixedCols:=0;
9610 FixedRows:=0;
9611
9612 if cfg.getValue('grid/design/columns/columnsenabled', False) then
9613 LoadColumns(cfg, version)
9614 else
9615 ColCount := Cfg.GetValue('grid/design/columncount', 5);
9616
9617 RowCount:=Cfg.GetValue('grid/design/rowcount', 5);
9618 FixedCols:=Cfg.GetValue('grid/design/fixedcols', 1);
9619 FixedRows:=Cfg.GetValue('grid/design/fixedrows', 1);
9620
9621 k := Cfg.GetValue('grid/design/isdefaultrowheight', -1);
9622 if k<>0 then
9623 DefaultRowheight:=Cfg.GetValue('grid/design/defaultrowheight', -1)
9624 else
9625 DefaultRowheight:=-1;
9626
9627 k := Cfg.GetValue('grid/design/isdefaultcolwidth', -1);
9628 if k<>0 then
9629 DefaultColWidth:=Cfg.getValue('grid/design/defaultcolwidth', -1)
9630 else
9631 DefaultColWidth:=-1;
9632
9633 try
9634 Color := StringToColor(cfg.GetValue('grid/design/color', 'clWindow'));
9635 except
9636 end;
9637
9638 if not Columns.Enabled then begin
9639 Path:='grid/design/columns/';
9640 k:=cfg.getValue(Path+'columncount',0);
9641 for i:=1 to k do begin
9642 tmpPath := Path+'column'+IntToStr(i);
9643 j:=cfg.getValue(tmpPath+'/index',-1);
9644 if IsColumnIndexValid(j) then begin
9645 ColWidths[j]:=cfg.getValue(tmpPath+'/width',-1);
9646 doLoadColumn(self, nil, j, Cfg, Version, tmpPath);
9647 end;
9648 end;
9649 end;
9650
9651 Path:='grid/design/rows/';
9652 k:=cfg.getValue(Path+'rowcount',0);
9653 for i:=1 to k do begin
9654 j:=cfg.getValue(Path+'row'+IntToStr(i)+'/index',-1);
9655 if IsRowIndexValid(j) then begin
9656 RowHeights[j]:=cfg.getValue(Path+'row'+IntToStr(i)+'/height',-1);
9657 end;
9658 end;
9659
9660 LoadGridOptions(cfg, Version);
9661 end;
9662
9663 CreateSaved:=Cfg.GetValue('grid/saveoptions/position', false);
9664 if CreateSaved then begin
9665 i:=Cfg.GetValue('grid/position/topleftcol',-1);
9666 j:=Cfg.GetValue('grid/position/topleftrow',-1);
9667 if CellToGridZone(i,j)=gzNormal then begin
9668 TryScrollTo(i,j,True,True);
9669 end;
9670 i:=Cfg.GetValue('grid/position/col',-1);
9671 j:=Cfg.GetValue('grid/position/row',-1);
9672 if IsColumnIndexVariable(i) and
9673 IsRowIndexVariable(j) then begin
9674 MoveExtend(false, i,j, True);
9675 end;
9676 if goRangeSelect in Options then begin
9677 FRange.left:=Cfg.getValue('grid/position/selection/left',FCol);
9678 FRange.Top:=Cfg.getValue('grid/position/selection/top',FRow);
9679 FRange.Right:=Cfg.getValue('grid/position/selection/right',FCol);
9680 FRange.Bottom:=Cfg.getValue('grid/position/selection/bottom',FRow);
9681 end;
9682 end;
9683 end;
9684 end;
9685
9686 procedure TCustomGrid.LoadGridOptions(cfg: TXMLConfig; Version: Integer);
9687 var
9688 Opt: TGridOptions;
9689 Opt2: TGridOptions2;
9690 Path: string;
9691
9692 procedure GetValue(optStr:string; aOpt:TGridOption);
9693 begin
9694 if Cfg.GetValue(Path+OptStr+'/value', False) then Opt:=Opt+[aOpt];
9695 end;
9696 procedure GetValue2(optStr:string; aOpt:TGridOption2);
9697 begin
9698 if Cfg.GetValue(Path+OptStr+'/value', False) then Opt2:=Opt2+[aOpt];
9699 end;
9700 begin
9701 Opt:=[];
9702 Opt2:=[];
9703 Path:='grid/design/options/';
9704 GetValue('goFixedVertLine', goFixedVertLine);
9705 GetValue('goFixedHorzLine', goFixedHorzLine);
9706 GetValue('goVertLine',goVertLine);
9707 GetValue('goHorzLine',goHorzLine);
9708 GetValue('goRangeSelect',goRangeSelect);
9709 GetValue('goDrawFocusSelected',goDrawFocusSelected);
9710 GetValue('goRowSizing',goRowSizing);
9711 GetValue('goColSizing',goColSizing);
9712 GetValue('goRowMoving',goRowMoving);
9713 GetValue('goColMoving',goColMoving);
9714 GetValue('goEditing',goEditing);
9715 GetValue('goAutoAddRows',goAutoAddRows);
9716 GetValue('goRowSelect',goRowSelect);
9717 GetValue('goTabs',goTabs);
9718 GetValue('goAlwaysShowEditor',goAlwaysShowEditor);
9719 GetValue('goThumbTracking',goThumbTracking);
9720 GetValue('goColSpanning', goColSpanning);
9721 GetValue('goRelaxedRowSelect',goRelaxedRowSelect);
9722 GetValue('goDblClickAutoSize',goDblClickAutoSize);
9723 GetValue('goAutoAddRowsSkipContentCheck',goAutoAddRowsSkipContentCheck);
9724 GetValue('goRowHighlight',goRowHighlight);
9725 if Version>=2 then begin
9726 GetValue('goSmoothScroll',goSmoothScroll);
9727 end;
9728 GetValue2('goScrollToLastRow',goScrollToLastRow);
9729 GetValue2('goScrollToLastCol',goScrollToLastCol);
9730
9731 Options:=Opt;
9732 Options2:=Opt2;
9733 end;
9734
9735 procedure TCustomGrid.Loaded;
9736 begin
9737 inherited Loaded;
9738 VisualChange;
9739 end;
9740
9741 procedure TCustomGrid.LockEditor;
9742 begin
9743 inc(FEditorHidingCount);
9744 {$ifdef dbgGrid}DebugLn('==> LockEditor: ', dbgs(FEditorHidingCount)); {$endif}
9745 end;
9746
9747 constructor TCustomGrid.Create(AOwner: TComponent);
9748 begin
9749 // Inherited create Calls SetBounds->WM_SIZE->VisualChange so
9750 // fGrid needs to be created before that
9751 FCols:=TIntegerList.Create;
9752 FRows:=TIntegerList.Create;
9753 FGCache.AccumWidth:=TIntegerList.Create;
9754 FGCache.AccumHeight:=TIntegerList.Create;
9755 FGCache.ClickCell := point(-1, -1);
9756 inherited Create(AOwner);
9757
9758 FVSbVisible := -1;
9759 FHSbVisible := -1;
9760
9761 FColumns := CreateColumns;
9762
9763 FTitleFont := TFont.Create;
9764 FTitleFont.OnChange := @OnTitleFontChanged;
9765 FTitleFontIsDefault := True;
9766
9767 FAutoAdvance := aaRight;
9768 FTabAdvance := aaRightDown;
9769 FAutoEdit := True;
9770 FFocusRectVisible := True;
9771 FDefaultDrawing := True;
9772 FOptions:=
9773 [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect,
9774 goSmoothScroll ];
9775 FScrollbars:=ssAutoBoth;
9776 fGridState:=gsNormal;
9777 FDefColWidth:=-1;
9778 FDefRowHeight:=-1;
9779 FGridLineColor:=clSilver;
9780 FFixedGridLineColor := cl3DDKShadow;
9781 FGridLineStyle:=psSolid;
9782 FGridLineWidth := 1;
9783 fFocusColor:=clRed;
9784 FFixedColor:=clBtnFace;
9785 FFixedHotColor:=cl3DLight;
9786 FSelectedColor:= clHighlight;
9787 FDisabledFontColor:=clGrayText;
9788 FRange:=Rect(-1,-1,-1,-1);
9789 FDragDx:=3;
9790 SetBounds(0,0,200,100);
9791 ColCount:=5;
9792 RowCount:=5;
9793 FixedCols:=1;
9794 FixedRows:=1;
9795 Editor:=nil;
9796 FBorderColor := cl3DDKShadow;
9797 FGridBorderStyle := bsSingle;
9798 UpdateBorderStyle;
9799 FIgnoreClick := False;
9800
9801 ParentColor := False;
9802 Color:=clWindow;
9803 FAlternateColor := Color;
9804 FAltColorStartNormal := true;
9805
9806 FDefaultTextStyle := Canvas.TextStyle;
9807 FDefaultTextStyle.Wordbreak := False;
9808 FDefaultTextStyle.SingleLine:= True;
9809
9810 FCellHintPriority := chpAllNoDefault;
9811
9812 FButtonEditor := TButtonCellEditor.Create(nil);
9813 FButtonEditor.Name:='ButtonEditor';
9814 FButtonEditor.Caption:='...';
9815 FButtonEditor.Visible:=False;
9816 FButtonEditor.Width:=25;
9817 FButtonEditor.OnClick := @EditButtonClicked;
9818
9819 FStringEditor := TStringCellEditor.Create(nil);
9820 FStringEditor.name :='StringEditor';
9821 FStringEditor.Text:='';
9822 FStringEditor.Visible:=False;
9823 FStringEditor.Align:=alNone;
9824 FStringEditor.BorderStyle := bsNone;
9825
9826 FPicklistEditor := TPickListCellEditor.Create(nil);
9827 FPickListEditor.Name := 'PickListEditor';
9828 FPickListEditor.Visible := False;
9829 FPickListEditor.AutoSize := false;
9830
9831 FButtonStringEditor := TCompositeCellEditor.Create(nil);
9832 FButtonStringEditor.Name:='ButtonTextEditor';
9833 FButtonStringEditor.Visible:=False;
9834 FButtonStringEditor.AddEditor(FStringEditor, alClient, true);
9835 FButtonStringEditor.AddEditor(FButtonEditor, alRight, false);
9836
9837 FFastEditing := True;
9838 TabStop := True;
9839 FAllowOutboundEvents:=True;
9840
9841 FHeaderHotZones := [gzFixedCols];
9842 FHeaderPushZones := [gzFixedCols];
9843 ResetHotCell;
9844 ResetPushedCell;
9845 FSortOrder := soAscending;
9846 FSortColumn:=-1;
9847 FAscImgInd:=-1;
9848 FDescImgInd:=-1;
9849
9850 FValidateOnSetSelection := false;
9851
9852 FColRowDragIndicatorColor := clRed;
9853
9854 FSpecialCursors[gcsColWidthChanging] := crHSplit;
9855 FSpecialCursors[gcsRowHeightChanging] := crVSplit;
9856 FSpecialCursors[gcsDragging] := crMultiDrag;
9857
9858 varRubberSpace := Scale96ToScreen(constRubberSpace);
9859 varCellPadding := Scale96ToScreen(constCellPadding);
9860 varColRowBorderTolerance := Scale96ToScreen(constColRowBorderTolerance);
9861 end;
9862
9863 destructor TCustomGrid.Destroy;
9864 begin
9865 {$Ifdef DbgGrid}DebugLn('TCustomGrid.Destroy');{$Endif}
9866 FreeThenNil(FButtonStringEditor);
9867 FreeThenNil(FPickListEditor);
9868 FreeThenNil(FStringEditor);
9869 FreeThenNil(FButtonEditor);
9870 FreeThenNil(FColumns);
9871 FreeThenNil(FGCache.AccumWidth);
9872 FreeThenNil(FGCache.AccumHeight);
9873 FreeThenNil(FCols);
9874 FreeThenNil(FRows);
9875 FreeThenNil(FTitleFont);
9876 FEditor := nil;
9877 inherited Destroy;
9878 end;
9879
9880 procedure TCustomGrid.LoadSub(ACfg: TXMLConfig);
9881 var
9882 Version: Integer;
9883 begin
9884 Version:=ACfg.GetValue('grid/version',-1);
9885 if Version=-1 then raise Exception.Create(rsNotAValidGridFile);
9886 BeginUpdate;
9887 LoadContent(ACfg, Version);
9888 EndUpdate;
9889 end;
9890
9891 procedure TCustomGrid.LoadFromFile(FileName: string);
9892 var
9893 Cfg: TXMLConfig;
9894 begin
9895 if not FileExistsUTF8(FileName) then
9896 raise Exception.Create(rsGridFileDoesNotExist);
9897 Cfg:=TXMLConfig.Create(nil);
9898 Try
9899 Cfg.Filename := FileName;
9900 LoadSub(Cfg);
9901 Finally
9902 FreeThenNil(Cfg);
9903 end;
9904 end;
9905
9906 procedure TCustomGrid.LoadFromStream(AStream: TStream);
9907 var
9908 Cfg: TXMLConfig;
9909 begin
9910 Cfg:=TXMLConfig.Create(nil);
9911 Try
9912 Cfg.ReadFromStream(AStream);
9913 LoadSub(Cfg);
9914 Finally
9915 FreeThenNil(Cfg);
9916 end;
9917 end;
9918
9919 procedure TCustomGrid.SaveToFile(FileName: string);
9920 var
9921 Cfg: TXMLConfig;
9922 begin
9923 if FileExistsUTF8(FileName) then
9924 DeleteFileUTF8(FileName);
9925 Cfg:=TXMLConfig.Create(nil);
9926 Try
9927 Cfg.FileName := FileName;
9928 SaveContent(Cfg);
9929 Cfg.Flush;
9930 Finally
9931 FreeThenNil(Cfg);
9932 end;
9933 end;
9934
9935 procedure TCustomGrid.SaveToStream(AStream: TStream);
9936 var
9937 Cfg: TXMLConfig;
9938 begin
9939 Cfg:=TXMLConfig.Create(nil);
9940 Try
9941 Cfg.Clear;
9942 SaveContent(Cfg);
9943 Cfg.WriteToStream(AStream);
9944 Finally
9945 FreeThenNil(Cfg);
9946 end;
9947 end;
9948
9949 procedure TCustomGrid.ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double);
9950 var
9951 LTitleFontIsDefault: Boolean;
9952 I: Integer;
9953 begin
9954 inherited ScaleFontsPPI(AToPPI, AProportion);
9955 LTitleFontIsDefault := FTitleFontIsDefault;
9956 DoScaleFontPPI(TitleFont, AToPPI, AProportion);
9957 FTitleFontIsDefault := LTitleFontIsDefault;
9958 for I := 0 to FColumns.Count-1 do
9959 FColumns[I].ScaleFontsPPI(AToPPI, AProportion);
9960 end;
9961
9962 type
9963 TWinCtrlAccess=class(TWinControl);
9964
9965 procedure TCustomGrid.SetFocus;
9966 var
9967 NextControl: TWinControl;
9968 ParentForm: TCustomForm;
9969 ForwardTab: boolean;
9970 begin
9971 {$IFDEF dbgGrid}
9972 DebugLnEnter('TCustomGrid.SetFocus INIT.');
9973 {$ENDIF}
9974 if (Editor<>nil) and Editor.Focused and
9975 ([gfEditorTab,gfRevEditorTab]*GridFlags<>[]) then begin
9976 // Editor was doing TAB. Focus next control instead
9977 ForwardTab:= gfEditorTab in GridFlags;
9978 GridFlags:=GridFlags-[gfEditorTab,gfRevEditorTab];
9979 ParentForm:=GetParentForm(Self);
9980 if ParentForm<>nil then begin
9981 NextControl:=TWinCtrlAccess(Pointer(ParentForm)).FindNextControl(Self,
9982 ForwardTab, true, false);
9983 if NextControl<>nil then begin
9984 {$IFDEF dbgGrid}
9985 DebugLn('Was tabbing, will focus: ',dbgsname(NextControl));
9986 {$ENDIF}
9987 if (NextControl<>Self) and (NextControl<>Editor) then begin
9988 NextControl.SetFocus;
9989 {$ifdef DbgGrid}
9990 DebugLnExit('Skipping inherited, EXIT');
9991 {$endif}
9992 exit;
9993 end;
9994 end;
9995 end;
9996 end;
9997
9998 if (Editor <> nil) and (Editor.Visible) then
9999 Editor.SetFocus
10000 else
10001 inherited SetFocus;
10002
10003 {$IFDEF dbgGrid}
10004 DebugLnExit('TCustomGrid.SetFocus END');
10005 {$ENDIF}
10006 end;
10007
10008 {$ifdef WINDOWS}
10009 // editor focusing make bad on IME input.
10010 procedure TCustomGrid.IMEStartComposition(var Msg: TMessage);
10011 begin
10012 EditorSetValue;
10013 if EditingAllowed(FCol) and CanEditShow and (not FEditorShowing) and
10014 (Editor<>nil) and (not Editor.Visible) and (not EditorLocked) then
10015 begin
10016 // prepare IME input on Editor
10017 Editor.Visible:=True;
10018 FEditorOldValue := GetCells(FCol,FRow);
10019 EditorSelectAll;
10020 FGridState := gsNormal;
10021 Editor.Dispatch(Msg);
10022 end;
10023 end;
10024
10025 procedure TCustomGrid.IMEComposition(var Msg: TMessage);
10026 begin
10027 if EditingAllowed(FCol) and CanEditShow and (not FEditorShowing) and
10028 (Editor<>nil) and (not Editor.Visible) and (not EditorLocked) then
10029 Editor.Dispatch(Msg);
10030 end;
10031
10032 procedure TCustomGrid.IMEEndComposition(var Msg: TMessage);
10033 begin
10034 if EditingAllowed(FCol) and CanEditShow and (not FEditorShowing) and
10035 (Editor<>nil) and (not Editor.Visible) and (not EditorLocked) then
10036 Editor.Dispatch(Msg);
10037 end;
10038
10039 {$endif}
10040
ClearColsnull10041 function TCustomGrid.ClearCols: Boolean;
10042 begin
10043 Result:=False;
10044 if FCols.Count=0 then
10045 exit; // already cleared
10046 if EditorMode then
10047 EditorMode:=False;
10048 // save some properties
10049 FGridPropBackup.FixedColCount := FFixedCols;
10050 FGridPropBackup.ColCount := ColCount;
10051 // clear structure
10052 FFixedCols:=0;
10053 FCols.Count:=0;
10054 FGCache.TLColOff := 0;
10055 Result:=True;
10056 end;
10057
ClearRowsnull10058 function TCustomGrid.ClearRows: Boolean;
10059 begin
10060 Result:=False;
10061 if FRows.Count=0 then
10062 exit; // already cleared
10063 if EditorMode then
10064 EditorMode:=False;
10065 // save some properties
10066 FGridPropBackup.FixedRowCount := FFixedRows;
10067 FGridPropBackup.RowCount := RowCount;
10068 // clear structure
10069 FFixedRows:=0;
10070 FRows.Count:=0;
10071 FGCache.TlRowOff := 0;
10072 Result:=True;
10073 end;
10074
10075 procedure TCustomGrid.Clear;
10076 var
10077 OldR,OldC: Integer;
10078 RowChanged, ColChanged: Boolean;
10079 begin
10080 if EditorMode then
10081 EditorMode := false;
10082 OldR:=RowCount;
10083 OldC:=ColCount;
10084 RowChanged := ClearRows;
10085 ColChanged := ClearCols;
10086 if not (RowChanged or ColChanged) then
10087 exit; // already cleared
10088 FGridPropBackup.ValidData := True;
10089 FTopLeft:=Point(-1,-1);
10090 FRange:=Rect(-1,-1,-1,-1);
10091 FGCache.HotCellPainted := false;
10092 ResetHotCell;
10093 VisualChange;
10094 SizeChanged(OldR,OldC);
10095 end;
10096
10097 procedure TCustomGrid.AutoAdjustColumns;
10098 var
10099 i: Integer;
10100 begin
10101 For i:=0 to ColCount-1 do
10102 AutoAdjustColumn(i);
10103 end;
10104
10105 { TVirtualGrid }
10106
GetCellsnull10107 function TVirtualGrid.GetCells(Col, Row: Integer): PCellProps;
10108 begin
10109 // todo: Check range
10110 Result:=nil;
10111 if not IsColumnIndexValid(Col) or not IsRowIndexValid(Row) then
10112 raise EGridException.CreateFmt(rsIndexOutOfRange, [Col, Row]);
10113 Result:=FCellArr[Col,Row];
10114 end;
10115
GetRowsnull10116 function TVirtualGrid.GetRows(Row: Integer): PColRowProps;
10117 begin
10118 Result:= FRowArr[Row, 0];
10119 end;
10120
GetColsnull10121 function TVirtualGrid.GetCols(Col: Integer): PColRowProps;
10122 begin
10123 result:=FColArr[Col, 0];
10124 end;
10125
10126 procedure TVirtualGrid.SetCells(Col, Row: Integer; const AValue: PCellProps);
10127 var
10128 Cell: PCellProps;
10129 begin
10130 // todo: Check range
10131 Cell:=FCellArr[Col,Row];
10132 if Cell<>nil then
10133 DisposeCell(Cell);
10134 Cell:=AValue;
10135 FCellArr[Col,Row]:=Cell;
10136 end;
10137
10138 procedure TVirtualGrid.SetRows(Row: Integer; const Avalue: PColRowProps);
10139 var
10140 C: PColRowProps;
10141 begin
10142 // todo: Check range
10143 C:=FRowArr[Row,0];
10144 if C<>nil then DisposeColRow(C);
10145 FRowArr[Row,0]:=AValue;
10146 end;
10147
10148 procedure TVirtualGrid.SetColCount(const Avalue: Integer);
10149 begin
10150 if FColCount=Avalue then Exit;
10151 {$Ifdef dbgMem}
10152 DebugLn('TVirtualGrid.SetColCount Value=',AValue);
10153 {$Endif}
10154 FColCount:=AValue;
10155 {$Ifdef dbgMem}
10156 DBGOut('TVirtualGrid.SetColCount->FCOLS: ');
10157 {$Endif}
10158 FColArr.SetLength(FColCount, 1);
10159 {$Ifdef dbgMem}
10160 DBGOut('TVirtualGrid.SetColCount->FCELLS(',FColCount,',',FRowCount,'): ');
10161 {$Endif}
10162 FCellArr.SetLength(FColCount, FRowCount);
10163 end;
10164
10165
10166 procedure TVirtualGrid.SetRowCount(const Avalue: Integer);
10167 begin
10168 if FRowCount=AValue then Exit;
10169 {$Ifdef dbgMem}
10170 DebugLn('TVirtualGrid.SetRowCount Value=',AValue);
10171 {$Endif}
10172 FRowCount:=AValue;
10173 {$Ifdef dbgMem}
10174 DBGOut('TVirtualGrid.SetRowCount->FROWS: ');
10175 {$Endif}
10176 FRowArr.SetLength(FRowCount,1);
10177 {$Ifdef dbgMem}
10178 DBGOut('TVirtualGrid.SetRowCount->FCELLS(',FColCount,',',FRowCount,'): ');
10179 {$Endif}
10180 FCellArr.SetLength(FColCount, FRowCount);
10181 end;
10182
10183 procedure TVirtualGrid.SetCols(Col: Integer; const Avalue: PColRowProps);
10184 var
10185 C: PColRowProps;
10186 begin
10187 // todo: Check range
10188 C:=FColArr[Col,0];
10189 if C<>nil then DisposeColRow(C);
10190 FColArr[Col,0]:=AValue;
10191 end;
10192
10193 procedure TVirtualGrid.Clear;
10194 begin
10195 {$Ifdef dbgMem}DBGOut('FROWARR: ');{$Endif}FRowArr.Clear;
10196 {$Ifdef dbgMem}DBGOut('FCOLARR: ');{$Endif}FColArr.Clear;
10197 {$Ifdef dbgMem}DBGOut('FCELLARR: ');{$Endif}FCellArr.Clear;
10198 FColCount:=0;
10199 FRowCount:=0;
10200 end;
10201
10202 procedure TVirtualGrid.DisposeCell(var P: PCellProps);
10203 begin
10204 if P<>nil then begin
10205 if P^.Text<>nil then StrDispose(P^.Text);
10206 Dispose(P);
10207 P:=nil;
10208 end;
10209 end;
10210
10211 procedure TVirtualGrid.DisposeColRow(var p: PColRowProps);
10212 begin
10213 if P<>nil then begin
10214 Dispose(P);
10215 P:=nil;
10216 end;
10217 end;
10218
IsColumnIndexValidnull10219 function TVirtualGrid.IsColumnIndexValid(AIndex: Integer): boolean;
10220 begin
10221 Result := (AIndex>=0) and (AIndex<ColCount);
10222 end;
10223
IsRowIndexValidnull10224 function TVirtualGrid.IsRowIndexValid(AIndex: Integer): boolean;
10225 begin
10226 Result := (AIndex>=0) and (AIndex<RowCount);
10227 end;
10228
GetDefaultCellnull10229 function TVirtualGrid.GetDefaultCell: PcellProps;
10230 begin
10231 New(Result);
10232 Result^.Text:=nil;
10233 Result^.Attr:=nil;
10234 end;
10235
GetDefaultColRownull10236 function TVirtualGrid.GetDefaultColRow: PColRowProps;
10237 begin
10238 New(Result);
10239 Result^.FixedAttr:=nil;
10240 Result^.NormalAttr:=nil;
10241 Result^.Size:=-1;
10242 end;
10243
10244 procedure TVirtualGrid.doDestroyItem(Sender: TObject; Col,Row: Integer;
10245 var Item: Pointer);
10246 begin
10247 {$Ifdef dbgMem}
10248 DebugLn('TVirtualGrid.doDestroyItem Col=',Col,' Row= ',
10249 Row,' Item=',Integer(Item));
10250 {$endif}
10251 if Item<>nil then begin
10252 if (Sender=FColArr)or(Sender=FRowArr) then begin
10253 DisposeColRow(PColRowProps(Item));
10254 end else begin
10255 DisposeCell(PCellProps(Item));
10256 end;
10257 Item:=nil;
10258 end;
10259 end;
10260
10261 procedure TVirtualGrid.doNewItem(Sender: TObject; Col,Row: Integer;
10262 var Item: Pointer);
10263 begin
10264 {$Ifdef dbgMem}
10265 DebugLn('TVirtualGrid.doNewItem Col=',Col,' Row= ',
10266 Row,' Item=',Integer(Item));
10267 {$endif}
10268 if Sender=FColArr then begin
10269 // Procesar Nueva Columna
10270 Item:=GetDefaultColRow;
10271 end else
10272 if Sender=FRowArr then begin
10273 // Procesar Nuevo Renglon
10274 Item:=GetDefaultColRow;
10275 end else begin
10276 // Procesar Nueva Celda
10277 Item:=nil;
10278 end;
10279 end;
10280
10281 constructor TVirtualGrid.Create;
10282 begin
10283 Inherited Create;
10284 {$Ifdef DbgGrid}DebugLn('TVirtualGrid.Create');{$Endif}
10285 FCellArr:=TPointerPointerArray.Create;
10286 FCellArr.OnDestroyItem:=@doDestroyItem;
10287 FCellArr.OnNewItem:=@doNewItem;
10288 FColArr:= TPointerPointerArray.Create;
10289 FColArr.OnDestroyItem:=@doDestroyItem;
10290 FColArr.OnNewItem:=@doNewItem;
10291 FRowArr:=TPointerPointerArray.Create;
10292 FRowArr.OnDestroyItem:=@doDestroyItem;
10293 FRowArr.OnNewItem:=@doNewItem;
10294 RowCount:=4;
10295 ColCount:=4;
10296 end;
10297
10298 destructor TVirtualGrid.Destroy;
10299 begin
10300 {$Ifdef DbgGrid}DebugLn('TVirtualGrid.Destroy');{$Endif}
10301 Clear;
10302 FreeThenNil(FRowArr);
10303 FreeThenNil(FColArr);
10304 FreeThenNil(FCellArr);
10305 inherited Destroy;
10306 end;
10307
10308 procedure TVirtualGrid.DeleteColRow(IsColumn: Boolean; index: Integer);
10309 begin
10310 FCellArr.DeleteColRow(IsColumn, index);
10311 if IsColumn then begin
10312 FColArr.DeleteColRow(True, index);
10313 Dec(FColCount);
10314 end else begin
10315 FRowArr.DeleteColRow(True, index);
10316 Dec(fRowCount);
10317 end;
10318 end;
10319
10320 procedure TVirtualGrid.MoveColRow(IsColumn: Boolean; FromIndex, ToIndex: Integer);
10321 begin
10322 FCellArr.MoveColRow(IsColumn, FromIndex, ToIndex);
10323 if IsColumn then FColArr.MoveColRow(True, FromIndex, ToIndex)
10324 else FRowArr.MoveColRow(True, FromIndex, ToIndex);
10325 end;
10326
10327 procedure TVirtualGrid.ExchangeColRow(IsColumn: Boolean; index, WithIndex: Integer);
10328 begin
10329 FCellArr.ExchangeColRow(IsColumn, index, WithIndex);
10330 if IsColumn then FColArr.ExchangeColRow(true, index, WithIndex)
10331 else FRowArr.ExchangeColRow(True, index, WithIndex);
10332 end;
10333
10334 procedure TVirtualGrid.InsertColRow(IsColumn: Boolean; Index: Integer);
10335 begin
10336 if IsColumn then begin
10337 ColCount := ColCount + 1;
10338 MoveColRow(true, ColCount-1, Index);
10339 end else begin
10340 RowCount := RowCount + 1;
10341 MoveColRow(false, RowCount-1, Index);
10342 end;
10343 end;
10344
10345 procedure TStringCellEditor.WndProc(var TheMessage: TLMessage);
10346 begin
10347 {$IfDef GridTraceMsg}
10348 TransMsg('StrCellEditor: ', TheMessage);
10349 {$Endif}
10350 if FGrid<>nil then
10351 case TheMessage.Msg of
10352 LM_CLEAR,
10353 LM_CUT,
10354 LM_PASTE:
10355 begin
10356 if FGrid.EditorIsReadOnly then
10357 exit;
10358 end;
10359 end;
10360 inherited WndProc(TheMessage);
10361 end;
10362
10363 { TStringCellEditor }
10364
10365 procedure TStringCellEditor.Change;
10366 begin
10367 {$IfDef DbgGrid} DebugLn('TStringCellEditor.Change INIT text=',Text);{$ENDIF}
10368 inherited Change;
10369 if (FGrid<>nil) and Visible then begin
10370 FGrid.EditorTextChanged(FCol, FRow, Text);
10371 end;
10372 {$IfDef DbgGrid} DebugLn('TStringCellEditor.Change END');{$ENDIF}
10373 end;
10374
10375 procedure TStringCellEditor.EditingDone;
10376 begin
10377 inherited EditingDone;
10378 if FGrid<>nil then
10379 FGrid.EditingDone;
10380 end;
10381
10382 procedure TStringCellEditor.KeyDown(var Key: Word; Shift: TShiftState);
10383 function AllSelected: boolean;
10384 begin
10385 result := (SelLength>0) and (SelLength=UTF8Length(Text));
10386 end;
10387 function AtStart: Boolean;
10388 begin
10389 Result:= (SelStart=0);
10390 end;
10391 function AtEnd: Boolean;
10392 begin
10393 result := ((SelStart+1)>UTF8Length(Text)) or AllSelected;
10394 end;
10395 procedure doEditorKeyDown;
10396 begin
10397 if FGrid<>nil then
10398 FGrid.EditorkeyDown(Self, key, shift);
10399 end;
10400 procedure doGridKeyDown;
10401 begin
10402 if FGrid<>nil then
10403 FGrid.KeyDown(Key, shift);
10404 end;
10405 function GetFastEntry: boolean;
10406 begin
10407 if FGrid<>nil then
10408 Result := FGrid.FastEditing
10409 else
10410 Result := False;
10411 end;
10412 procedure CheckEditingKey;
10413 begin
10414 if (FGrid=nil) or FGrid.EditorIsReadOnly then
10415 Key := 0;
10416 end;
10417 var
10418 IntSel: boolean;
10419 begin
10420 {$IfDef dbgGrid}
10421 DebugLn('TStringCellEditor.KeyDown INIT: Key=', Dbgs(Key),
10422 ' SelStart=',Dbgs(SelStart),' SelLenght=',dbgs(SelLength),
10423 ' Len(text)=',dbgs(Length(Text)),' Utf8Len(Text)=',dbgs(UTF8Length(Text)));
10424 {$Endif}
10425 inherited KeyDown(Key,Shift);
10426 case Key of
10427 VK_F2:
10428 begin
10429 doEditorKeyDown;
10430 if (key<>0) then begin
10431 if AllSelected then begin
10432 SelLength := 0;
10433 SelStart := Length(Text);
10434 end else if GetFastEntry then
10435 SelectAll;
10436 end;
10437 end;
10438 VK_DELETE, VK_BACK:
10439 begin
10440 CheckEditingKey;
10441 if key<>0 then
10442 doEditorKeyDown;
10443 end;
10444 VK_UP, VK_DOWN:
10445 doGridKeyDown;
10446 VK_LEFT, VK_RIGHT:
10447 begin
10448 if GetFastEntry then begin
10449 IntSel:=
10450 ((Key=VK_LEFT) and not AtStart) or
10451 ((Key=VK_RIGHT) and not AtEnd);
10452 if not IntSel then
10453 doGridKeyDown
10454 else
10455 doEditorKeyDown;
10456 end else
10457 doEditorKeyDown;
10458 end;
10459 VK_ESCAPE:
10460 begin
10461 doGridKeyDown;
10462 if key<>0 then begin
10463 SetEditText(FGrid.FEditorOldValue);
10464 FGrid.EditorHide;
10465 end;
10466 end;
10467 else
10468 doEditorKeyDown;
10469 end;
10470 {$IfDef dbgGrid}
10471 DebugLn('TStringCellEditor.KeyDown END: Key=', Dbgs(Key),
10472 ' SelStart=',Dbgs(SelStart),' SelLenght=',Dbgs(SelLength));
10473 {$Endif}
10474 end;
10475
10476 procedure TStringCellEditor.msg_SetMask(var Msg: TGridMessage);
10477 begin
10478 EditMask:=msg.Value;
10479 end;
10480
10481
10482 procedure TStringCellEditor.msg_SetValue(var Msg: TGridMessage);
10483 begin
10484 Text:=Msg.Value;
10485 SelStart := UTF8Length(Text);
10486 end;
10487
10488 procedure TStringCellEditor.msg_GetValue(var Msg: TGridMessage);
10489 begin
10490 Msg.Col:=FCol;
10491 Msg.Row:=FRow;
10492 Msg.Value:=Text;
10493 end;
10494
10495 procedure TStringCellEditor.msg_SetGrid(var Msg: TGridMessage);
10496 begin
10497 FGrid:=Msg.Grid;
10498 Msg.Options:=EO_AUTOSIZE or EO_SELECTALL or EO_HOOKKEYPRESS or EO_HOOKKEYUP;
10499 end;
10500
10501 procedure TStringCellEditor.msg_SelectAll(var Msg: TGridMessage);
10502 begin
10503 SelectAll;
10504 end;
10505
10506 procedure TStringCellEditor.msg_SetPos(var Msg: TGridMessage);
10507 begin
10508 FCol := Msg.Col;
10509 FRow := Msg.Row;
10510 end;
10511
10512 procedure TStringCellEditor.msg_GetGrid(var Msg: TGridMessage);
10513 begin
10514 Msg.Grid := FGrid;
10515 Msg.Options:= EO_IMPLEMENTED;
10516 end;
10517
10518 constructor TStringCellEditor.Create(Aowner: TComponent);
10519 begin
10520 inherited Create(Aowner);
10521 AutoSize := false;
10522 end;
10523
10524 { TStringGridStrings }
10525
ConvertIndexLineColnull10526 function TStringGridStrings.ConvertIndexLineCol(Index: Integer; var Line, Col: Integer): boolean;
10527 begin
10528 if FIsCol then
10529 if (Index < 0) or (Index >= FGrid.RowCount) then
10530 Result := False
10531 else begin
10532 Line := FIndex;
10533 Col := Index;
10534 Result := True;
10535 end
10536 else
10537 if (Index < 0) or (Index >= FGrid.ColCount) then
10538 Result := False
10539 else begin
10540 Line := Index;
10541 Col := FIndex;
10542 Result := True;
10543 end;
10544 end;
10545
10546 procedure TStringGridStrings.Clear;
10547 var
10548 I: Integer;
10549 begin
10550 if FIsCol then begin
10551 for I := 0 to FGrid.RowCount - 1 do begin
10552 FGrid.Cells[FIndex, I] := '';
10553 FGrid.Objects[FIndex, I] := nil;
10554 end;
10555 end else begin
10556 for I := 0 to FGrid.ColCount - 1 do begin
10557 FGrid.Cells[I, FIndex] := '';
10558 FGrid.Objects[I, FIndex] := nil;
10559 end;
10560 end;
10561 FAddedCount := 0;
10562 end;
10563
Addnull10564 function TStringGridStrings.Add(const S: string): Integer;
10565 var
10566 Line, Col: Integer;
10567 begin
10568 if ConvertIndexLineCol(FAddedCount, Line, Col) then begin
10569 FGrid.Cells[Line, Col] := S;
10570 Result := FAddedCount;
10571 Inc(FAddedCount);
10572 end else
10573 Result := -1;
10574 end;
10575
Getnull10576 function TStringGridStrings.Get(Index: Integer): string;
10577 var
10578 Line, Col: Integer;
10579 begin
10580 if ConvertIndexLineCol(Index, Line, Col) then
10581 Result := FGrid.Cells[Line, Col]
10582 else
10583 Result := ''
10584 end;
10585
GetCountnull10586 function TStringGridStrings.GetCount: Integer;
10587 begin
10588 if FIsCol then
10589 Result := FGrid.RowCount
10590 else
10591 Result := FGrid.ColCount;
10592 end;
10593
GetObjectnull10594 function TStringGridStrings.GetObject(Index: Integer): TObject;
10595 var
10596 Line, Col: Integer;
10597 begin
10598 if ConvertIndexLineCol(Index, Line, Col) then
10599 Result := FGrid.Objects[Line, Col]
10600 else
10601 Result := nil;
10602 end;
10603
10604 procedure TStringGridStrings.Put(Index: Integer; const S: string);
10605 var
10606 Line, Col: Integer;
10607
10608 procedure RaiseError;
10609 begin
10610 raise EGridException.Create('Can not add String');
10611 end;
10612
10613 begin
10614 if ConvertIndexLineCol(Index, Line, Col) then
10615 FGrid.Cells[Line, Col] := S
10616 else
10617 RaiseError;
10618 end;
10619
10620 procedure TStringGridStrings.PutObject(Index: Integer; aObject: TObject);
10621 var
10622 Line, Col: Integer;
10623
10624 procedure RaiseError;
10625 begin
10626 raise EGridException.Create('Can not add Object');
10627 end;
10628
10629 begin
10630 if ConvertIndexLineCol(Index, Line, Col) then
10631 FGrid.Objects[Line, Col] := aObject
10632 else
10633 RaiseError;
10634 end;
10635
10636 constructor TStringGridStrings.Create(aGrid: TCustomStringGrid; OwnerMap: TMap; aIscol: boolean;
10637 aIndex: Longint);
10638 begin
10639 inherited Create;
10640 FGrid := aGrid;
10641 FIsCol := aIsCol;
10642 FIndex := aIndex;
10643 FOwner := OwnerMap;
10644 if FOwner<>nil then
10645 FOwner.Add(FIndex, Self);
10646 end;
10647
10648 destructor TStringGridStrings.Destroy;
10649 begin
10650 if FOwner<>nil then
10651 FOwner.Delete(FIndex);
10652 inherited Destroy;
10653 end;
10654
10655 procedure TStringGridStrings.Assign(Source: TPersistent);
10656 var
10657 I, StrNum: Integer;
10658 begin
10659 if Source is TStrings then begin
10660 try
10661 BeginUpdate;
10662 StrNum := TStrings(Source).Count;
10663 if StrNum > GetCount then StrNum := GetCount;
10664 for I := 0 to StrNum - 1 do begin
10665 Put(I, TStrings(Source).Strings[I]);
10666 PutObject(I, TStrings(Source).Objects[I]);
10667 end;
10668 finally
10669 EndUpdate;
10670 end;
10671 end else
10672 inherited Assign(Source);
10673 end;
10674
10675 procedure TStringGridStrings.Delete(Index: Integer);
10676 begin
10677 raise EGridException.Create('Can not delete value.');
10678 end;
10679
10680 procedure TStringGridStrings.Insert(Index: Integer; const S: string);
10681 begin
10682 raise EGridException.Create('Can not insert value.');
10683 end;
10684
10685
10686
10687 { TCustomDrawGrid }
10688
CellNeedsCheckboxBitmapsnull10689 function TCustomDrawGrid.CellNeedsCheckboxBitmaps(const aCol, aRow: Integer): boolean;
10690 var
10691 C: TGridColumn;
10692 begin
10693 Result := false;
10694 if (aRow>=FixedRows) and Columns.Enabled then begin
10695 C := ColumnFromGridColumn(aCol);
10696 result := (C<>nil) and (C.ButtonStyle=cbsCheckboxColumn)
10697 end;
10698 end;
10699
10700 procedure TCustomDrawGrid.DrawCellCheckboxBitmaps(const aCol, aRow: Integer;
10701 const aRect: TRect);
10702 var
10703 AState: TCheckboxState;
10704 begin
10705 AState := cbUnchecked;
10706 GetCheckBoxState(aCol, aRow, aState);
10707 DrawGridCheckboxBitmaps(aCol, aRow, aRect, aState);
10708 end;
10709
GetEditorValuenull10710 function TCustomDrawGrid.GetEditorValue(ACol, ARow: Integer): String;
10711 var
10712 msg: TGridMessage;
10713 begin
10714 if Assigned(Editor) and Editor.Visible then begin
10715 Msg.LclMsg.msg:=GM_GETVALUE;
10716 Msg.grid:=Self;
10717 Msg.Col:=ACol;
10718 Msg.Row:=ARow;
10719 Msg.Value:='';
10720 Editor.Dispatch(Msg);
10721 Result:=Msg.Value;
10722 end;
10723 end;
10724
10725 procedure TCustomDrawGrid.CellClick(const ACol, ARow: Integer; const Button:TMouseButton);
10726 begin
10727 if (Button=mbLeft) and CellNeedsCheckboxBitmaps(ACol, ARow) then
10728 ToggleCheckbox;
10729 end;
10730
10731 procedure TCustomDrawGrid.DrawCell(aCol,aRow: Integer; aRect: TRect;
10732 aState:TGridDrawState);
10733 var
10734 OldDefaultDrawing: boolean;
10735 begin
10736 if Assigned(OnDrawCell) and not(CsDesigning in ComponentState) then begin
10737 PrepareCanvas(aCol, aRow, aState);
10738 if DefaultDrawing then
10739 DefaultDrawCell(aCol, aRow, aRect, aState);
10740 OnDrawCell(Self,aCol,aRow,aRect,aState)
10741 end else begin
10742 OldDefaultDrawing:=FDefaultDrawing;
10743 FDefaultDrawing:=True;
10744 try
10745 PrepareCanvas(aCol, aRow, aState);
10746 finally
10747 FDefaultDrawing:=OldDefaultDrawing;
10748 end;
10749 DefaultDrawCell(aCol,aRow,aRect,aState);
10750 end;
10751 DrawCellGrid(aCol,aRow,aRect,aState);
10752 end;
10753
10754 procedure TCustomDrawGrid.DrawFocusRect(aCol, aRow: Integer; ARect: TRect);
10755 var
10756 OldFocusColor: TColor;
10757 OldPenMode: TFPPenMode;
10758 DrawBits: Byte;
10759 begin
10760 // Draw focused cell if we have the focus
10761 if DefaultDrawing and (Self.Focused or
10762 (EditorAlwaysShown and ((Feditor=nil) or not Feditor.Focused))) then
10763 begin
10764 CalcFocusRect(aRect);
10765 if FUseXORFeatures then begin
10766 Canvas.SaveHandleState;
10767 OldFocusColor := FFocusColor;
10768 FFocusColor:= clWhite;
10769 OldPenMode:=Canvas.Pen.Mode;
10770 Canvas.Pen.Mode := pmXOR;
10771 end;
10772 DrawBits := BF_RECT;
10773 if (goRowSelect in Options) then begin
10774 if ((fTopLeft.x>FixedCols) or (FGCache.TLColOff<>0)) then
10775 DrawBits := DrawBits and not BF_LEFT;
10776 if (FGCache.VisibleGrid.Right<ColCount-1) then
10777 DrawBits := DrawBits and not BF_RIGHT;
10778 end;
10779 DrawRubberRect(Canvas, aRect, FFocusColor, DrawBits);
10780 if FUseXORFeatures then begin
10781 Canvas.Pen.Mode := OldPenMode;
10782 Canvas.RestoreHandleState;
10783 FFocusColor := OldFocusColor;
10784 end;
10785 end;
10786 end;
10787
GetCellsnull10788 function TCustomDrawGrid.GetCells(ACol, ARow: Integer): string;
10789 begin
10790 Result:=inherited GetCells(ACol, ARow);
10791 if (ACol = FEditorCol) and (ARow = FEditorRow) then
10792 Result:=GetEditorValue(ACol, ARow);
10793 end;
10794
10795 procedure TCustomDrawGrid.GetCheckBoxState(const aCol, aRow: Integer;
10796 var aState: TCheckboxState);
10797 begin
10798 if assigned(FOnGetCheckboxState) then
10799 OnGetCheckboxState(self, aCol, aRow, aState);
10800 end;
10801
10802 procedure TCustomDrawGrid.ColRowExchanged(IsColumn:Boolean; index, WithIndex: Integer);
10803 begin
10804 if not IsColumn or not Columns.Enabled then
10805 Fgrid.ExchangeColRow(IsColumn, index, WithIndex);
10806 if Assigned(OnColRowExchanged) then
10807 OnColRowExchanged(Self, IsColumn, index, WithIndex);
10808 end;
10809
10810 procedure TCustomDrawGrid.ColRowInserted(IsColumn: boolean; index: integer);
10811 begin
10812 if not IsColumn or not Columns.Enabled then
10813 FGrid.InsertColRow(IsColumn, Index);
10814 NotifyColRowChange(True, IsColumn, Index, Index);
10815 end;
10816
10817 procedure TCustomDrawGrid.ColRowDeleted(IsColumn: Boolean; index: Integer);
10818 begin
10819 FGrid.DeleteColRow(IsColumn, index);
10820 NotifyColRowChange(False, IsColumn, Index, Index);
10821 end;
10822
10823 procedure TCustomDrawGrid.ColRowMoved(IsColumn: Boolean; FromIndex, ToIndex: Integer);
10824 begin
10825 inherited ColRowMoved(IsColumn, FromIndex, ToIndex);
10826
10827 // now move content, if Columns.Enabled and IsColumn then
10828 // first row header has been already moved, what is in
10829 // cells[0,0]-cells[colCount-1,0] doesn't matter because
10830 // columns should take precedence.
10831 FGrid.MoveColRow(IsColumn, FromIndex, ToIndex);
10832
10833 if Assigned(OnColRowMoved) then
10834 OnColRowMoved(Self, IsColumn, FromIndex, toIndex);
10835 end;
10836
10837 procedure TCustomDrawGrid.HeaderClick(IsColumn: Boolean; index: Integer);
10838 begin
10839 inherited HeaderClick(IsColumn, index);
10840 if Assigned(OnHeaderClick) then OnHeaderClick(Self, IsColumn, index);
10841 end;
10842
10843 procedure TCustomDrawGrid.HeaderSized(IsColumn: Boolean; index: Integer);
10844 begin
10845 inherited HeaderSized(IsColumn, index);
10846 if Assigned(OnHeaderSized) then OnHeaderSized(Self, IsColumn, index);
10847 end;
10848
10849 procedure TCustomDrawGrid.HeaderSizing(const IsColumn: boolean; const AIndex,
10850 ASize: Integer);
10851 begin
10852 inherited HeaderSizing(IsColumn, AIndex, ASize);
10853 if Assigned(OnHeaderSizing) then
10854 OnHeaderSizing(self, IsColumn, AIndex, ASize);
10855 end;
10856
10857 procedure TCustomDrawGrid.KeyDown(var Key: Word; Shift: TShiftState);
10858 begin
10859 inherited KeyDown(Key, Shift);
10860
10861 if (Key=VK_SPACE) and CellNeedsCheckboxBitmaps(col, row) then begin
10862 ToggleCheckbox;
10863 Key:=0;
10864 end;
10865 end;
10866
GetEditMasknull10867 function TCustomDrawGrid.GetEditMask(aCol, aRow: Longint): string;
10868 begin
10869 result:='';
10870 if assigned(OnGetEditMask) then OnGetEditMask(self, aCol, aRow, Result);
10871 end;
10872
TCustomDrawGrid.GetEditTextnull10873 function TCustomDrawGrid.GetEditText(aCol, aRow: Longint): string;
10874 begin
10875 result:='';
10876 if assigned(OnGetEditText) then OnGetEditText(self, aCol, aRow, Result);
10877 FEditorOldValue:=Result;
10878 FEditorCol:=aCol;
10879 FEditorRow:=aRow;
10880 end;
10881
10882 procedure TCustomDrawGrid.GridMouseWheel(shift: TShiftState; Delta: Integer);
10883 var
10884 ScrollCols: boolean;
10885 begin
10886 if MouseWheelOption=mwCursor then
10887 inherited GridMouseWheel(shift, Delta)
10888 else
10889 if Delta<>0 then begin
10890 ScrollCols := (ssCtrl in shift);
10891 if ScrollCols then
10892 begin
10893 if not TrySmoothScrollBy(Delta*DefaultColWidth, 0) then
10894 TryScrollTo(FTopLeft.x+Delta, FTopLeft.y, True, False);
10895 end else
10896 begin
10897 if not TrySmoothScrollBy(0, Delta*DefaultRowHeight*Mouse.WheelScrollLines) then
10898 TryScrollTo(FTopLeft.x, FTopLeft.y+Delta, False, True); // scroll only 1 line if above scrolling failed (probably due to too high line)
10899 end;
10900 if EditorMode then
10901 EditorPos;
10902 end;
10903 end;
10904
10905 procedure TCustomDrawGrid.NotifyColRowChange(WasInsert, IsColumn: boolean;
10906 FromIndex,ToIndex: Integer);
10907 begin
10908 if WasInsert then begin
10909 if assigned(OnColRowInserted) then
10910 OnColRowInserted(Self, IsColumn, FromIndex, ToIndex)
10911 end else begin
10912 if assigned(OnColRowDeleted) then
10913 OnColRowDeleted(Self, IsColumn, FromIndex, ToIndex);
10914 end;
10915 end;
10916
10917 procedure TCustomDrawGrid.SetEditText(ACol, ARow: Longint; const Value: string);
10918 begin
10919 if Assigned(OnSetEditText) then
10920 OnSetEditText(Self, aCol, aRow, Value);
10921 inherited SetEditText(aCol, aRow, Value);
10922 end;
10923
10924 procedure TCustomDrawGrid.SizeChanged(OldColCount, OldRowCount: Integer);
10925 begin
10926 if OldColCount<>ColCount then begin
10927 fGrid.ColCount:=ColCount;
10928 if OldColCount>ColCount then
10929 NotifyColRowChange(False, True, ColCount, OldColCount-1)
10930 else
10931 NotifyColRowChange(True, True, OldColCount, ColCount-1);
10932 end;
10933 if OldRowCount<>RowCount then begin
10934 fGrid.RowCount:=RowCount;
10935 if OldRowCount>RowCount then
10936 NotifyColRowChange(False, False, RowCount, OldRowCount-1)
10937 else
10938 NotifyColRowChange(True, False, OldRowCount, RowCount-1);
10939 end;
10940 end;
10941
10942 procedure TCustomDrawGrid.ToggleCheckbox;
10943 var
10944 TempColumn: TGridColumn;
10945 AState: TCheckboxState;
10946 begin
10947 if not EditingAllowed(Col) then
10948 exit;
10949
10950 TempColumn := ColumnFromGridColumn(Col);
10951 if (TempColumn<>nil) and not TempColumn.ReadOnly then
10952 begin
10953
10954 AState := cbGrayed;
10955 GetCheckboxState(Col, Row, AState);
10956
10957 if AState=cbChecked then
10958 AState := cbUnchecked
10959 else
10960 AState := cbChecked;
10961
10962 SetCheckboxState(Col, Row, AState);
10963
10964 if Assigned(OnCheckboxToggled) then
10965 OnCheckboxToggled(self, Col, Row, AState);
10966 end;
10967 end;
10968
10969 procedure TCustomDrawGrid.DrawCellAutonumbering(aCol, aRow: Integer;
10970 aRect: TRect; const aValue: string);
10971 begin
10972 DrawCellText(aCol, aRow, aRect, [], aValue);
10973 end;
10974
SelectCellnull10975 function TCustomDrawGrid.SelectCell(aCol, aRow: Integer): boolean;
10976 begin
10977 Result := inherited SelectCell(aCol, aRow);
10978 if Assigned(OnSelectCell) then
10979 OnSelectCell(Self, aCol, aRow, Result);
10980 end;
10981
10982 procedure TCustomDrawGrid.SetColor(Value: TColor);
10983 begin
10984 inherited SetColor(Value);
10985 Invalidate;
10986 end;
10987
10988 procedure TCustomDrawGrid.SetCheckboxState(const aCol, aRow: Integer;
10989 const aState: TCheckboxState);
10990 begin
10991 if assigned(FOnSetCheckboxState) then begin
10992 OnSetCheckboxState(self, aCol, aRow, aState);
10993 if DefaultDrawing then
10994 InvalidateCell(aCol, aRow);
10995 end;
10996 end;
10997
TCustomDrawGrid.CreateVirtualGridnull10998 function TCustomDrawGrid.CreateVirtualGrid: TVirtualGrid;
10999 begin
11000 Result:=TVirtualGrid.Create;
11001 end;
11002
11003 constructor TCustomDrawGrid.Create(AOwner: TComponent);
11004 begin
11005 fGrid:=CreateVirtualGrid;
11006 inherited Create(AOwner);
11007 end;
11008
11009 destructor TCustomDrawGrid.Destroy;
11010 begin
11011 {$Ifdef DbgGrid}DebugLn('TCustomDrawGrid.Destroy');{$Endif}
11012 FreeThenNil(FGrid);
11013 inherited Destroy;
11014 end;
11015
11016 procedure TCustomDrawGrid.DeleteColRow(IsColumn: Boolean; index: Integer);
11017 begin
11018 DoOPDeleteColRow(IsColumn, Index);
11019 end;
11020
11021 procedure TCustomDrawGrid.DeleteCol(Index: Integer);
11022 begin
11023 DeleteColRow(True, Index);
11024 end;
11025
11026 procedure TCustomDrawGrid.DeleteRow(Index: Integer);
11027 begin
11028 DeleteColRow(False, Index);
11029 end;
11030
11031 procedure TCustomDrawGrid.ExchangeColRow(IsColumn: Boolean; index,
11032 WithIndex: Integer);
11033 begin
11034 DoOPExchangeColRow(IsColumn, Index, WithIndex);
11035 end;
11036
11037 procedure TCustomDrawGrid.InsertColRow(IsColumn: boolean; index: integer);
11038 begin
11039 doOPInsertColRow(IsColumn, Index);
11040 end;
11041
11042 procedure TCustomDrawGrid.MoveColRow(IsColumn: Boolean; FromIndex,
11043 ToIndex: Integer);
11044 begin
11045 DoOPMoveColRow(IsColumn, FromIndex, ToIndex);
11046 end;
11047
11048 procedure TCustomDrawGrid.SortColRow(IsColumn: Boolean; index: Integer);
11049 begin
11050 if IsColumn then begin
11051 if (FFixedRows < RowCount) and (RowCount > 0) then
11052 Sort(IsColumn, index, FFixedRows, RowCount-1)
11053 end
11054 else begin
11055 if (FFixedCols < ColCount) and (ColCount > 0) then
11056 Sort(IsColumn, index, FFixedCols, ColCount-1);
11057 end
11058 end;
11059
11060 procedure TCustomDrawGrid.SortColRow(IsColumn: Boolean; Index, FromIndex,
11061 ToIndex: Integer);
11062 begin
11063 Sort(IsColumn, Index, FromIndex, ToIndex);
11064 end;
11065
11066 procedure TCustomDrawGrid.DefaultDrawCell(aCol, aRow: Integer; var aRect: TRect;
11067 aState: TGridDrawState);
11068 begin
11069 if (FTitleStyle=tsNative) and (gdFixed in AState) then
11070 DrawThemedCell(aCol, aRow, aRect, aState)
11071 else
11072 DrawFillRect(Canvas, aRect);
11073
11074 if CellNeedsCheckboxBitmaps(aCol,aRow) then
11075 DrawCellCheckboxBitmaps(aCol,aRow,aRect)
11076 else
11077 begin
11078 if IsCellButtonColumn(Point(aCol,aRow)) then begin
11079 DrawButtonCell(aCol,aRow,aRect,aState);
11080 end
11081 else begin
11082 if (goFixedRowNumbering in Options) and (ARow>=FixedRows) and (aCol=0) and
11083 (FixedCols>0)
11084 then
11085 DrawCellAutonumbering(aCol, aRow, aRect, IntToStr(aRow-FixedRows+1));
11086 end;
11087 //draw text
11088 if GetIsCellTitle(aCol, aRow) then
11089 DrawColumnText(aCol, aRow, aRect, aState)
11090 else
11091 DrawTextInCell(aCol,aRow, aRect,aState);
11092 end;
11093 end;
11094
11095 { TCustomStringGrid }
11096
11097 procedure TCustomStringGrid.MapFree(var aMap: TMap);
11098 var
11099 Iterator: TMapIterator;
11100 SGL: TStringGridStrings;
11101 begin
11102 if AMap=nil then
11103 exit;
11104 Iterator := TMapIterator.Create(AMap);
11105 Iterator.First;
11106 while not Iterator.EOM do begin
11107 Iterator.GetData(SGL);
11108 if SGL<>nil then
11109 SGL.Free;
11110 Iterator.Next;
11111 end;
11112 Iterator.Free;
11113 FreeAndNil(AMap);
11114 end;
11115
MapGetColsRowsnull11116 function TCustomStringGrid.MapGetColsRows(IsCols: boolean; Index: Integer;
11117 var AMap: TMap): TStrings;
11118 begin
11119 if AMap=nil then
11120 AMap := TMap.Create(itu4, SizeOf(TStringGridStrings));
11121
11122 if AMap.HasId(Index) then
11123 AMap.GetData(index, Result)
11124 else
11125 Result:=TStringGridStrings.Create(Self, AMap, IsCols, index);
11126 end;
11127
GetCellsnull11128 function TCustomStringGrid.GetCells(ACol, ARow: Integer): string;
11129 var
11130 C: PCellProps;
11131 begin
11132 Result:='';
11133 C:=FGrid.Celda[aCol,aRow];
11134 if C<>nil then Result:=C^ .Text;
11135 end;
11136
TCustomStringGrid.GetColsnull11137 function TCustomStringGrid.GetCols(index: Integer): TStrings;
11138 begin
11139 Result := MapGetColsRows(True, Index, FColsMap);
11140 end;
11141
TCustomStringGrid.GetObjectsnull11142 function TCustomStringGrid.GetObjects(ACol, ARow: Integer): TObject;
11143 var
11144 C: PCellProps;
11145 begin
11146 Result:=nil;
11147 C:=Fgrid.Celda[aCol,aRow];
11148 if C<>nil then Result:=C^.Data;
11149 end;
11150
TCustomStringGrid.GetRowsnull11151 function TCustomStringGrid.GetRows(index: Integer): TStrings;
11152 begin
11153 Result := MapGetColsRows(False, Index, FRowsMap);
11154 end;
11155
11156 procedure TCustomStringGrid.ReadCells(Reader: TReader);
11157 var
11158 aCol,aRow: Integer;
11159 i, c: Integer;
11160 begin
11161 with Reader do begin
11162 ReadListBegin;
11163 c := ReadInteger;
11164 for i:=1 to c do begin
11165 aCol := ReadInteger;
11166 aRow := ReadInteger;
11167 Cells[aCol,aRow]:= ReadString;
11168 end;
11169 {
11170 repeat
11171 aCol := ReadInteger;
11172 aRow := ReadInteger;
11173 Cells[aCol,aRow] := ReadString;
11174 until NextValue = vaNull;
11175 }
11176 ReadListEnd;
11177 end;
11178 end;
11179
11180 procedure TCustomStringGrid.SetCells(ACol, ARow: Integer; const AValue: string);
11181 procedure UpdateCell;
11182 begin
11183 if EditorMode and (aCol=FCol)and(aRow=FRow) and
11184 not (gfEditorUpdateLock in GridFlags) then
11185 begin
11186 EditorDoSetValue;
11187 end;
11188 InvalidateCell(aCol, aRow);
11189 end;
11190 var
11191 C: PCellProps;
11192 begin
11193 C:= FGrid.Celda[aCol,aRow];
11194 if C<>nil then begin
11195 if C^.Text<>nil then
11196 StrDispose(C^.Text);
11197 C^.Text:=StrNew(pchar(aValue));
11198 UpdateCell;
11199 FModified := True;
11200 end else begin
11201 if AValue<>'' then begin
11202 New(C);
11203 C^.Text:=StrNew(pchar(Avalue));
11204 C^.Attr:=nil;
11205 C^.Data:=nil;
11206 FGrid.Celda[aCol,aRow]:=C;
11207 UpdateCell;
11208 FModified := True;
11209 end;
11210 end;
11211 end;
11212
11213 procedure TCustomStringGrid.SetCols(index: Integer; const AValue: TStrings);
11214 var
11215 SGL: TStringGridStrings;
11216 begin
11217 SGL := TStringGridStrings.Create(Self, nil, True, index);
11218 SGL.Assign(AValue);
11219 SGL.Free;
11220 end;
11221
11222 procedure TCustomStringGrid.SetObjects(ACol, ARow: Integer; AValue: TObject);
11223 var
11224 c: PCellProps;
11225 begin
11226 C:=FGrid.Celda[aCol,aRow];
11227 if c<>nil then C^.Data:=AValue
11228 else begin
11229 c:=fGrid.GetDefaultCell;
11230 c^.Data:=Avalue;
11231 FGrid.Celda[aCol,aRow]:=c;
11232 end;
11233 end;
11234
11235 procedure TCustomStringGrid.SetRows(index: Integer; const AValue: TStrings);
11236 var
11237 SGL: TStringGridStrings;
11238 begin
11239 SGL := TStringGridStrings.Create(Self, nil, False, index);
11240 SGL.Assign(AValue);
11241 SGL.Free;
11242 end;
11243
11244 procedure TCustomStringGrid.WriteCells(Writer: TWriter);
11245 var
11246 i,j: Integer;
11247 c: Integer;
11248 begin
11249 with writer do begin
11250 WriteListBegin;
11251 //cell count
11252 c:=0;
11253 for i:=0 to ColCount-1 do
11254 for j:=0 to RowCount-1 do
11255 if Cells[i,j]<>'' then Inc(c);
11256 WriteInteger(c);
11257
11258 for i:=0 to ColCount-1 do
11259 for j:=0 to RowCount-1 do
11260 if Cells[i,j]<>'' then begin
11261 WriteInteger(i);
11262 WriteInteger(j);
11263 WriteString(Cells[i,j]);
11264 end;
11265 WriteListEnd;
11266 end;
11267 end;
11268
11269 procedure TCustomStringGrid.CopyCellRectToClipboard(const R: TRect);
11270 var
11271 SelStr, SelHTMLStr: String;
11272 aRow,aCol,k: LongInt;
11273
QuoteTextnull11274 function QuoteText(s: string): string;
11275 begin
11276 DoCellProcess(aCol, aRow, cpCopy, s);
11277 if (pos(#9, s)>0) or
11278 (pos(#10, s)>0) or
11279 (pos(#13, s)>0)
11280 then
11281 result := AnsiQuotedStr(s, '"')
11282 else
11283 result := s;
11284 end;
11285
PrepareToHTMLnull11286 function PrepareToHTML(s: string): string;
11287 var
11288 i1: Integer;
11289 s1: string;
11290 begin
11291 Result := '';
11292 for i1 := 1 to Length(s) do
11293 begin
11294 case s[i1] of
11295 #13: s1 := '<br>';
11296 #10: if i1 > 1 then if s[i1 - 1] = #13 then s1 := '' else s1 := '<br>';
11297 '<': s1 := '<';
11298 '>': s1 := '>';
11299 '"': s1 := '"';
11300 '&': s1 := '&';
11301 else s1 := s[i1];
11302 end;
11303 Result := Result + s1;
11304 end;
11305 end;
11306
11307 begin
11308 SelStr := '';
11309
11310 SelHTMLStr := '<head><style><!--table br {mso-data-placement:same-cell;} --></style></head>' + #13#10 +
11311 '<table>' + #13#10;
11312
11313 //<head>...</head> MS Excel crutch, otherwise Excel split merged cell if it found <br> tag
11314
11315 for aRow := R.Top to R.Bottom do begin
11316
11317 SelHTMLStr := SelHTMLStr + '<tr>' + #13#10;
11318
11319 for aCol := R.Left to R.Right do begin
11320
11321 if Columns.Enabled and (aCol >= FirstGridColumn) then begin
11322
11323 k := ColumnIndexFromGridColumn(aCol);
11324 if not Columns[k].Visible then
11325 continue;
11326
11327 if (aRow = 0) and (FixedRows > 0) then
11328 begin
11329 SelStr := SelStr + QuoteText(Columns[k].Title.Caption);
11330 SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Columns[k].Title.Caption) + '</td>' + #13#10;
11331 end
11332 else
11333 begin
11334 SelStr := SelStr + QuoteText(Cells[aCol,aRow]);
11335 SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Cells[aCol,aRow]) + '</td>' + #13#10;
11336 end;
11337
11338 end else
11339 begin
11340 SelStr := SelStr + QuoteText(Cells[aCol,aRow]);
11341 SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Cells[aCol,aRow]) + '</td>' + #13#10;
11342 end;
11343
11344 if aCol <> R.Right then
11345 SelStr := SelStr + #9;
11346 end;
11347
11348 SelStr := SelStr + sLineBreak;
11349 SelHTMLStr := SelHTMLStr + '</tr>' + #13#10;
11350 end;
11351 SelHTMLStr := SelHTMLStr + #13#10 + '</table>';
11352 Clipboard.SetAsHtml(SelHTMLStr, SelStr);
11353 end;
11354
11355 procedure TCustomStringGrid.AssignTo(Dest: TPersistent);
11356 var
11357 i, j: Integer;
11358 begin
11359 if Dest is TCustomStringGrid then begin
11360 BeginUpdate;
11361 inherited AssignTo(Dest);
11362 for i:=0 to ColCount-1 do
11363 for j:=0 to RowCount-1 do
11364 TCustomStringGrid(Dest).Cells[i,j] := Cells[i,j];
11365 EndUpdate;
11366 end else
11367 inherited AssignTo(Dest);
11368 end;
11369
11370 procedure TCustomStringGrid.AutoAdjustColumn(aCol: Integer);
11371 var
11372 i,W, imgWidth: Integer;
11373 Ts: TSize;
11374 TmpCanvas: TCanvas;
11375 C: TGridColumn;
11376 aRect: TRect;
11377 isMultiLine, B: Boolean;
11378 aText: string;
11379 aLayout: TButtonLayout;
11380 imgList: TCustomImageList;
11381 begin
11382 if not IsColumnIndexValid(aCol) then
11383 Exit;
11384
11385 GetTitleImageInfo(aCol, i, aLayout);
11386 if (i>=0) and (FTitleImageList<>nil) and (aLayout in [blGlyphLeft, blGlyphRight]) then
11387 imgWidth := FTitleImageList.WidthForPPI[FTitleImageListWidth, Font.PixelsPerInch] + 2*DEFIMAGEPADDING
11388 else
11389 imgWidth := 0;
11390 GetSortTitleImageInfo(aCol, imgList, i, W, B);
11391 if (imgList<>nil) and (i>=0) then
11392 Inc(imgWidth, imgList.WidthForPPI[W, Font.PixelsPerInch] + DEFIMAGEPADDING);
11393
11394 tmpCanvas := GetWorkingCanvas(Canvas);
11395
11396 C := ColumnFromGridColumn(aCol);
11397 isMultiLine := (C<>nil) and C.Title.MultiLine;
11398
11399 try
11400 W:=0;
11401 for i := 0 to RowCount-1 do begin
11402
11403 if C<>nil then begin
11404 if i<FixedRows then
11405 tmpCanvas.Font := C.Title.Font
11406 else
11407 tmpCanvas.Font := C.Font;
11408 end else begin
11409 if i<FixedRows then
11410 tmpCanvas.Font := TitleFont
11411 else
11412 tmpCanvas.Font := Font;
11413 end;
11414
11415 if (i=0) and (FixedRows>0) and (C<>nil) then
11416 aText := C.Title.Caption
11417 else
11418 aText := Cells[aCol, i];
11419
11420 if isMultiLine then begin
11421 aRect := rect(0, 0, MaxInt, MaxInt);
11422 DrawText(tmpCanvas.Handle, pchar(aText), Length(aText), aRect, DT_CALCRECT or DT_WORDBREAK);
11423 Ts.cx := aRect.Right-aRect.Left;
11424 end else
11425 Ts := tmpCanvas.TextExtent(aText);
11426
11427 if Ts.Cx>W then
11428 W := Ts.Cx;
11429 end;
11430 finally
11431 if tmpCanvas<>Canvas then
11432 FreeWorkingCanvas(tmpCanvas);
11433 end;
11434
11435 W := W + imgWidth;
11436 if W=0 then
11437 W := DefaultColWidth
11438 else
11439 W := W + 2*varCellpadding + 1;
11440
11441 ColWidths[aCol] := W;
11442 end;
11443
11444 procedure TCustomStringGrid.CalcCellExtent(acol, aRow: Integer; var aRect: TRect);
11445 var
11446 S: string;
11447 Ts: Tsize;
11448 nc: PcellProps;
11449 i: integer;
11450 TextStyle : TTextStyle;
11451 begin
11452 inherited CalcCellExtent(acol,arow, aRect);
11453 S:=Cells[aCol,aRow];
11454 TextStyle := Canvas.TextStyle;
11455 if not TextStyle.Clipping then begin
11456 //if not FCellAttr.TextStyle.Clipping then begin
11457 // Calcular el numero de celdas necesarias para contener todo
11458 // El Texto
11459 Ts:=Canvas.TextExtent(S);
11460 i:=aCol;
11461 while (Ts.Cx>(aRect.Right-aRect.Left))and(i<ColCount) do begin
11462 inc(i);
11463 Nc:=FGrid.Celda[i, aRow];
11464 if (nc<>nil)and(Nc^.Text<>'')then Break;
11465 aRect.Right:=aRect.Right + getColWidths(i);
11466 end;
11467 //fcellAttr.TextStyle.Clipping:=i<>aCol;
11468 TextStyle.Clipping:=i<>aCol;
11469 Canvas.TextStyle:=TextStyle;
11470 end;
11471 end;
11472
11473 procedure TCustomStringGrid.DefineProperties(Filer: TFiler);
11474 begin
11475 inherited DefineProperties(Filer);
11476 DefineCellsProperty(Filer);
11477 end;
11478
11479 procedure TCustomStringGrid.DefineCellsProperty(Filer: TFiler);
NeedCellsnull11480 function NeedCells: boolean;
11481 var
11482 i,j: integer;
11483 AntGrid: TCustomStringGrid;
11484 begin
11485 result := false;
11486 if Filer.Ancestor is TCustomStringGrid then begin
11487 AntGrid := TCustomStringGrid(Filer.Ancestor);
11488 result := (AntGrid.ColCount<>ColCount) or (AntGrid.RowCount<>RowCount);
11489 if not result then
11490 for i:=0 to AntGrid.ColCount-1 do
11491 for j:=0 to AntGrid.RowCount-1 do
11492 if Cells[i,j]<>AntGrid.Cells[i,j] then begin
11493 result := true;
11494 break;
11495 end
11496 end else
11497 for i:=0 to ColCount-1 do
11498 for j:=0 to RowCount-1 do
11499 if Cells[i,j]<>'' then begin
11500 result := true;
11501 break;
11502 end;
11503 end;
11504 begin
11505 with Filer do begin
11506 DefineProperty('Cells', @ReadCells, @WriteCells, NeedCells);
11507 end;
11508 end;
11509
TCustomStringGrid.DoCompareCellsnull11510 function TCustomStringGrid.DoCompareCells(Acol, ARow, Bcol, BRow: Integer): Integer;
11511 begin
11512 if Assigned(OnCompareCells) then
11513 Result:=inherited DoCompareCells(Acol, ARow, Bcol, BRow)
11514 else begin
11515 Result:=UTF8CompareLatinTextFast(Cells[ACol,ARow], Cells[BCol,BRow]);
11516 if SortOrder=soDescending then
11517 result:=-result;
11518 end;
11519 end;
11520
11521 procedure TCustomStringGrid.DoCopyToClipboard;
11522 begin
11523 CopyCellRectToClipboard(Selection);
11524 end;
11525
11526 procedure TCustomStringGrid.DoCutToClipboard;
11527 begin
11528 if EditingAllowed(Col) then begin
11529 doCopyToClipboard;
11530 Clean(Selection, []);
11531 end;
11532 end;
11533
11534 procedure TCustomStringGrid.DoPasteFromClipboard;
11535 begin
11536 // Unpredictable results when a multiple selection is pasted back in.
11537 // Therefore we inhibit this here.
11538 if HasMultiSelection then
11539 exit;
11540
11541 if EditingAllowed(Col) then
11542 begin
11543 if Clipboard.HasFormat(CF_TEXT) and not Clipboard.HasFormat(CF_HTML) then SelectionSetText(Clipboard.AsText);
11544 if Clipboard.HasFormat(CF_TEXT) and Clipboard.HasFormat(CF_HTML) then SelectionSetHTML(Clipboard.GetAsHtml(True), Clipboard.AsText);
11545 end;
11546 end;
11547
11548 procedure TCustomStringGrid.DoCellProcess(aCol, aRow: Integer;
11549 processType: TCellProcessType; var aValue: string);
11550 begin
11551 if Assigned(fOnCellProcess) then
11552 OnCellProcess(Self, aCol, aRow, processType, aValue);
11553 end;
11554
11555 procedure TCustomStringGrid.DrawTextInCell(aCol, aRow: Integer; aRect: TRect;
11556 aState: TGridDrawState);
11557 begin
11558 DrawCellText(aCol, aRow, aRect, aState, Cells[aCol,aRow]);
11559 end;
11560
11561 procedure TCustomStringGrid.DrawCellAutonumbering(aCol, aRow: Integer;
11562 aRect: TRect; const aValue: string);
11563 begin
11564 if Cells[aCol,aRow]='' then
11565 inherited DrawCellAutoNumbering(aCol,aRow,aRect,aValue);
11566 end;
11567
11568 procedure TCustomStringGrid.DrawColumnText(aCol, aRow: Integer; aRect: TRect;
11569 aState: TGridDrawState);
11570 begin
11571 if Columns.Enabled then
11572 inherited
11573 else begin
11574 DrawColumnTitleImage(aRect, aCol);
11575 DrawCellText(aCol,aRow,aRect,aState,Cells[aCol,aRow])
11576 end;
11577 end;
11578
11579 procedure TCustomStringGrid.GetCheckBoxState(const aCol, aRow: Integer;
11580 var aState: TCheckboxState);
11581 var
11582 s:string;
11583 begin
11584 if Assigned(OnGetCheckboxState) then
11585 inherited GetCheckBoxState(aCol, aRow, aState)
11586 else begin
11587 s := Cells[ACol, ARow];
11588 if s=ColumnFromGridColumn(aCol).ValueChecked then
11589 aState := cbChecked
11590 else
11591 if s=ColumnFromGridColumn(aCol).ValueUnChecked then
11592 aState := cbUnChecked
11593 else
11594 aState := cbGrayed;
11595 end;
11596 end;
11597
TCustomStringGrid.GetEditTextnull11598 function TCustomStringGrid.GetEditText(aCol, aRow: Integer): string;
11599 begin
11600 Result:=Cells[aCol, aRow];
11601 if Assigned(OnGetEditText) then OnGetEditText(Self, aCol, aRow, result);
11602 end;
11603
11604 procedure TCustomStringGrid.SaveContent(cfg: TXMLConfig);
11605 var
11606 i,j,k: Integer;
11607 c: PCellProps;
11608 begin
11609 inherited SaveContent(cfg);
11610 cfg.SetValue('grid/saveoptions/content', soContent in SaveOptions);
11611 if soContent in SaveOptions then begin
11612 // Save Cell Contents
11613 k:=0;
11614 For i:=0 to ColCount-1 do
11615 For j:=0 to RowCount-1 do begin
11616 C:=fGrid.Celda[i,j];
11617 if (c<>nil) and (C^.Text<>'') then begin
11618 Inc(k);
11619 Cfg.SetValue('grid/content/cells/cellcount',k);
11620 cfg.SetValue('grid/content/cells/cell'+IntToStr(k)+'/column',i);
11621 cfg.SetValue('grid/content/cells/cell'+IntToStr(k)+'/row',j);
11622 cfg.SetValue('grid/content/cells/cell'+IntToStr(k)+'/text', UTF8Decode(C^.Text));
11623 end;
11624 end;
11625 end;
11626 end;
11627
11628 procedure TCustomStringGrid.SelectionSetText(TheText: String);
11629 var
11630 StartCol,StartRow: Integer;
11631 Stream: TStringStream;
11632
11633 procedure LoadTSV(Fields: TStringList);
11634 var
11635 i, aCol, aRow: Integer;
11636 NewValue: string;
11637 begin
11638 if StartRow<RowCount then begin
11639 aRow := StartRow;
11640 for i := 0 to Fields.Count-1 do begin
11641 aCol := StartCol + i;
11642 if (aCol<ColCount) and not GetColumnReadonly(aCol) then begin
11643 NewValue := Fields[i];
11644 if ValidateOnSetSelection and not ValidateEntry(aCol,aRow,Cells[aCol,aRow],NewValue) then
11645 break;
11646 DoCellProcess(aCol, aRow, cpPaste, NewValue);
11647 Cells[aCol, aRow] := NewValue;
11648 end;
11649 end;
11650 inc(StartRow);
11651 end;
11652 end;
11653
11654 begin
11655 Stream := TStringStream.Create(TheText);
11656 try
11657 StartCol := Selection.left;
11658 StartRow := Selection.Top;
11659 LCSVUtils.LoadFromCSVStream(Stream, @LoadTSV, #9);
11660 finally
11661 Stream.Free;
11662 if ValidateOnSetSelection then
11663 EditingDone;
11664 end;
11665 end;
11666
11667
11668 procedure TCustomStringGrid.SelectionSetHTML(TheHTML, TheText: String);
11669 var
11670 bStartCol, bStartRow, bCol, bRow: Integer;
11671 bCellStr: string;
11672 bSelRect: TRect;
11673
11674 bCellData, bTagEnd: Boolean;
11675 bStr, bEndStr: PChar;
11676
ReplaceEntitiesnull11677 function ReplaceEntities(cSt: string): string;
11678 var
11679 o,a,b: pchar;
11680 dName: widestring;
11681 dEntity: WideChar;
11682 begin
11683 while true do begin
11684 result := cSt;
11685 if cSt = '' then
11686 break;
11687 o := @cSt[1];
11688 a := strscan(o, '&');
11689 if a = nil then
11690 break;
11691 b := strscan(a + 1, ';');
11692 if b = nil then
11693 break;
11694 dName := UTF8Decode(copy(cSt, a - o + 2, b - a - 1));
11695 dEntity := ' ';
11696 if ResolveHTMLEntityReference(dName, dEntity) then begin
11697 system.delete(cSt, a - o + 1, b - a + 1);
11698 system.insert(UTF8Encode(dEntity), cSt, a - o + 1);
11699 end;
11700 end;
11701 end;
11702
11703 begin
11704 if theHTML <> '' then
11705 begin
11706 bSelRect := Selection;
11707 bStartCol := Selection.Left;
11708 bStartRow := Selection.Top;
11709 bCol := bStartCol;
11710 bRow := bStartRow;
11711 bStr := PChar(theHTML);
11712 bEndStr := bStr + StrLen(bStr) - 4;
11713 bCellStr := '';
11714 bCellData := False;
11715
11716 while bStr < bEndStr do
11717 begin
11718 if bStr^ = #13 then // delete #13#10#20...#20 Excel place this after <br> tag.
11719 begin
11720 while bStr < (bEndStr - 1) do
11721 begin
11722 Inc(bStr);
11723 if (bStr^ <> #10) and (bStr^ <> ' ') then Break;
11724 end;
11725 end;
11726 if bStr^ = '<' then // tag start sign '<'
11727 begin
11728 bTagEnd := False;
11729 Inc(bStr);
11730
11731 if UpCase(bStr^) = 'B' then
11732 begin
11733 Inc(bStr);
11734 if (UpCase(bStr^) = 'R') and bCellData then bCellStr := bCellStr + #10; // tag <br> in table cell
11735 end;
11736
11737 if bStr^ = '/' then // close tag sign '/'
11738 begin
11739 bTagEnd := True;
11740 Inc(bStr);
11741 end;
11742
11743 if UpCase(bStr^) = 'T' then
11744 begin
11745 Inc(bStr);
11746
11747 if UpCase(bStr^) = 'R' then // table start row tag <tr>
11748 begin
11749 bCellData := False;
11750 if bTagEnd then // table end row tag </tr>
11751 begin
11752 bSelRect.Bottom := bRow;
11753 Inc(bRow);
11754 bCol := bStartCol;
11755 end;
11756 end;
11757
11758 if UpCase(bStr^) = 'D' then // table start cell tag <td>
11759 begin
11760 bCellData := not bTagEnd;
11761 if bTagEnd then // table end cell tag </td>
11762 begin
11763 if IsColumnIndexValid(bCol) and IsRowIndexValid(bRow) then
11764 begin
11765 bCellStr := ReplaceEntities(bCellStr);
11766 DoCellProcess(bCol, bRow, cpPaste, bCellStr);
11767 Cells[bCol, bRow] := bCellStr;
11768 end;
11769 bSelRect.Right := bCol;
11770 Inc(bCol);
11771 bCellStr := '';
11772 end;
11773 end;
11774 end;
11775
11776 while bStr < bEndStr do
11777 begin
11778 Inc(bStr);
11779 if bStr^ = '>' then // tag end sign '>'
11780 begin
11781 Inc(bStr);
11782 Break;
11783 end;
11784 end;
11785 end else
11786 begin
11787 if (bStr^ <> #13) and (bStr^ <> #10) and (bStr^ <> #9) and bCellData then bCellStr := bCellStr + bStr^;
11788 Inc(bStr);
11789 end;
11790 end;
11791
11792 if (bCol = bStartCol) and (bRow = bStartRow) then
11793 begin
11794 DoCellProcess(bCol, bRow, cpPaste, TheText);
11795 Cells[bCol, bRow] := TheText; //set text in cell if clipboard has CF_HTML fomat, but havent HTML table
11796 end;
11797 Selection := bSelRect; // set correct selection
11798 end;
11799 end;
11800
11801
11802 procedure TCustomStringGrid.SetCheckboxState(const aCol, aRow: Integer;
11803 const aState: TCheckboxState);
11804 begin
11805 if Assigned(OnSetCheckboxState) then
11806 inherited SetCheckBoxState(aCol, aRow, aState)
11807 else begin
11808 if aState=cbChecked then
11809 Cells[ACol, ARow] := ColumnFromGridColumn(aCol).ValueChecked
11810 else
11811 Cells[ACol, ARow] := ColumnFromGridColumn(aCol).ValueUnChecked;
11812 end;
11813 end;
11814
11815 procedure TCustomStringGrid.LoadContent(cfg: TXMLConfig; Version: Integer);
11816 var
11817 ContentSaved: Boolean;
11818 i,j,k: Integer;
11819 begin
11820 inherited LoadContent(Cfg, Version);
11821 if soContent in FSaveOptions then begin
11822 ContentSaved:=Cfg.GetValue('grid/saveoptions/content', false);
11823 if ContentSaved then begin
11824 k:=cfg.getValue('grid/content/cells/cellcount', 0);
11825 while k>0 do begin
11826 i:=cfg.GetValue('grid/content/cells/cell'+IntToStr(k)+'/column', -1);
11827 j:=cfg.GetValue('grid/content/cells/cell'+IntTostr(k)+'/row',-1);
11828 if IsRowIndexValid(j) and IsColumnIndexValid(i) then
11829 Cells[i,j]:=UTF8Encode(cfg.GetValue('grid/content/cells/cell'+IntToStr(k)+'/text',''));
11830 Dec(k);
11831 end;
11832 end;
11833 end;
11834 end;
11835
11836 procedure TCustomStringGrid.Loaded;
11837 begin
11838 inherited Loaded;
11839 FModified := False;
11840 end;
11841
11842 procedure TCustomStringGrid.SetEditText(aCol, aRow: Longint; const aValue: string);
11843 begin
11844 if not EditorIsReadOnly then begin
11845 GridFlags := GridFlags + [gfEditorUpdateLock];
11846 try
11847 if Cells[aCol, aRow]<>aValue then
11848 Cells[aCol, aRow]:= aValue;
11849 finally
11850 GridFlags := GridFlags - [gfEditorUpdateLock];
11851 end;
11852 end;
11853 inherited SetEditText(aCol, aRow, aValue);
11854 end;
11855
11856 constructor TCustomStringGrid.Create(AOwner: TComponent);
11857 begin
11858 inherited Create(AOwner);
11859 with DefaultTextStyle do begin
11860 Alignment := taLeftJustify;
11861 Layout := tlCenter;
11862 Clipping := True;
11863 //WordBreak := False
11864 end;
11865 ExtendedSelect := True;
11866 SaveOptions := [soContent];
11867 end;
11868
11869 destructor TCustomStringGrid.Destroy;
11870 begin
11871 MapFree(FRowsMap);
11872 MapFree(FColsMap);
11873 inherited Destroy;
11874 end;
11875
11876 procedure TCustomStringGrid.AutoSizeColumn(aCol: Integer);
11877 begin
11878 AutoAdjustColumn(aCol);
11879 end;
11880
11881 procedure TCustomStringGrid.AutoSizeColumns;
11882 var
11883 i: Integer;
11884 begin
11885 for i:=0 to ColCount-1 do
11886 AutoAdjustColumn(i)
11887 end;
11888
11889 procedure TCustomStringGrid.Clean;
11890 begin
11891 Clean([gzNormal, gzFixedCols, gzFixedRows, gzFixedCells]);
11892 end;
11893
11894 procedure TCustomStringGrid.Clean(CleanOptions: TGridZoneSet);
11895 begin
11896 Clean(0,0,ColCount-1,RowCount-1, CleanOptions);
11897 end;
11898
11899 procedure TCustomStringGrid.Clean(aRect: TRect; CleanOptions: TGridZoneSet);
11900 begin
11901 with aRect do
11902 Clean(Left, Top, Right, Bottom, CleanOptions);
11903 end;
11904
11905 procedure TCustomStringGrid.Clean(StartCol, StartRow, EndCol, EndRow: integer;
11906 CleanOptions: TGridZoneSet);
11907 var
11908 aCol: LongInt;
11909 aRow: LongInt;
11910 begin
11911 if StartCol>EndCol then SwapInt(StartCol,EndCol);
11912 if StartRow>EndRow then SwapInt(StartRow,EndRow);
11913
11914 if StartCol<0 then StartCol:=0;
11915 if EndCol>ColCount-1 then EndCol:=ColCount-1;
11916 if StartRow<0 then StartRow:=0;
11917 if EndRow>RowCount-1 then EndRow:=RowCount-1;
11918
11919 BeginUpdate;
11920 for aCol:=StartCol to EndCol do
11921 for aRow:= StartRow to EndRow do
11922 if (CleanOptions=[]) or (CellToGridZone(aCol,aRow) in CleanOptions) then
11923 Cells[aCol,aRow] := '';
11924 EndUpdate;
11925 end;
11926
11927 procedure TCustomStringGrid.CopyToClipboard(AUseSelection: boolean = false);
11928 begin
11929 if AUseSelection then
11930 doCopyToClipboard
11931 else
11932 CopyCellRectToClipboard(Rect(0,0,ColCount-1,RowCount-1));
11933 end;
11934
11935 procedure TCustomStringGrid.InsertRowWithValues(Index: Integer;
11936 Values: array of String);
11937 var
11938 i, OldRC, Diff: Integer;
11939 begin
11940 OldRC := RowCount;
11941 Diff := Length(Values) - ColCount;
11942 if Diff > 0 then
11943 begin
11944 if Columns.Enabled then
11945 begin
11946 for i := 1 to Diff do with Columns.Add do Title.Caption := '';
11947 end
11948 else
11949 ColCount := Length(Values);
11950 end;
11951 InsertColRow(false, Index);
11952 //if RowCount was 0, then setting ColCount restores RowCount (from FGridPropBackup)
11953 //which is unwanted here, so reset it (Issue #0026943)
11954 if (OldRc = 0) then RowCount := 1;
11955 for i := 0 to Length(Values)-1 do
11956 Cells[i, Index] := Values[i];
11957 end;
11958
11959 procedure TCustomStringGrid.LoadFromCSVStream(AStream: TStream;
11960 ADelimiter: Char=','; UseTitles: boolean=true; FromLine: Integer=0;
11961 SkipEmptyLines: Boolean=true);
11962 var
11963 MaxCols: Integer = 0;
11964 MaxRows: Integer = 0;
11965 LineCounter: Integer = -1;
11966
RowOffsetnull11967 function RowOffset: Integer;
11968 begin
11969 // return row offset of current CSV record (MaxRows) which is 1 based
11970 if UseTitles then
11971 result := Max(0, FixedRows-1) + Max(MaxRows-1, 0)
11972 else
11973 result := FixedRows + Max(MaxRows-1, 0);
11974 end;
11975
11976 procedure NewRecord(Fields:TStringlist);
11977 var
11978 i, aRow, aIndex: Integer;
11979 begin
11980 inc(LineCounter);
11981 if (LineCounter < FromLine) then
11982 exit;
11983
11984 if Fields.Count=0 then
11985 exit;
11986
11987 if SkipEmptyLines and (Fields.Count=1) and (Fields[0]='') then
11988 exit;
11989
11990 // make sure we have enough columns
11991 if MaxCols<Fields.Count then
11992 MaxCols := Fields.Count;
11993 if Columns.Enabled then begin
11994 while Columns.VisibleCount+FirstGridColumn>MaxCols do Columns.Delete(Columns.Count-1);
11995 while Columns.VisibleCount+FirstGridColumn<MaxCols do Columns.Add;
11996 end
11997 else begin
11998 if ColCount<MaxCols then
11999 ColCount := MaxCols;
12000 end;
12001
12002 // setup columns captions if enabled by UseTitles
12003 if (MaxRows = 0) and UseTitles then begin
12004 for i:= 0 to Fields.Count-1 do begin
12005 if Columns.Enabled and (i>=FirstGridColumn) then begin
12006 aIndex := ColumnIndexFromGridColumn(i);
12007 if aIndex>=0 then
12008 Columns[aIndex].Title.Caption:=Fields[i];
12009 end else
12010 Cells[i, 0] := Fields[i]
12011 end;
12012 inc(MaxRows);
12013 exit;
12014 end;
12015
12016 // Make sure we have enough rows
12017 Inc(MaxRows);
12018 aRow := RowOffset;
12019 if aRow>RowCount-1 then
12020 RowCount := aRow + 20;
12021
12022 // Copy line data to cells
12023 for i:=0 to Fields.Count-1 do
12024 Cells[i, aRow] := Fields[i];
12025 end;
12026
12027 begin
12028 BeginUpdate;
12029 try
12030 LCSVUtils.LoadFromCSVStream(AStream, @NewRecord, ADelimiter);
12031
12032 // last row offset + 1 (offset is 0 based)
12033 RowCount := RowOffset + 1;
12034
12035 if not Columns.Enabled then
12036 ColCount := MaxCols
12037 else
12038 while Columns.Count > MaxCols do
12039 Columns.Delete(Columns.Count-1);
12040
12041 finally
12042 EndUpdate;
12043 end;
12044 end;
12045
12046 procedure TCustomStringGrid.LoadFromCSVFile(AFilename: string;
12047 ADelimiter: Char=','; UseTitles: boolean=true; FromLine: Integer=0;
12048 SkipEmptyLines: Boolean=true);
12049 var
12050 TheStream: TFileStream;
12051 begin
12052 TheStream:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite);
12053 try
12054 LoadFromCSVStream(TheStream, ADelimiter, UseTitles, FromLine, SkipEmptyLines);
12055 finally
12056 TheStream.Free;
12057 end;
12058 end;
12059
12060 procedure TCustomStringGrid.SaveToCSVStream(AStream: TStream; ADelimiter: Char;
12061 WriteTitles: boolean=true; VisibleColumnsOnly: boolean=false);
12062 var
12063 i,j,StartRow: Integer;
12064 HeaderL, Lines: TStringList;
12065 C: TGridColumn;
12066 begin
12067 if (RowCount=0) or (ColCount=0) then
12068 exit;
12069 Lines := TStringList.Create;
12070 try
12071 if WriteTitles then begin
12072 if Columns.Enabled then begin
12073 if FixedRows>0 then begin
12074 HeaderL := TStringList.Create;
12075 try
12076 // Collect header column names to a temporary StringList
12077 for i := 0 to ColCount-1 do begin
12078 c := ColumnFromGridColumn(i);
12079 if (c <> nil) then begin
12080 if c.Visible or not VisibleColumnsOnly then
12081 HeaderL.Add(c.Title.Caption);
12082 end
12083 else
12084 if not VisibleColumnsOnly then
12085 HeaderL.Add(Cells[i, 0]);
12086 end;
12087 HeaderL.Delimiter:=ADelimiter;
12088 Headerl.StrictDelimiter := False; //force quoting of strings that contain whitespace or Delimiter
12089 Lines.Add(HeaderL.DelimitedText); // Add as a first row in Lines
12090 finally
12091 HeaderL.Free;
12092 end;
12093 end;
12094 StartRow := FixedRows;
12095 end else
12096 if FixedRows>0 then
12097 StartRow := FixedRows-1
12098 else
12099 StartRow := 0;
12100 end else
12101 StartRow := FixedRows;
12102 for i:=StartRow to RowCount-1 do begin
12103 if Columns.Enabled and VisibleColumnsOnly then begin
12104 HeaderL := TStringList.Create;
12105 try
12106 for j := 0 to ColCount-1 do begin
12107 c := ColumnFromGridColumn(j);
12108 if c=nil then Continue;
12109 if c.Visible then
12110 HeaderL.Add(Cells[j,i]);
12111 end;
12112 HeaderL.Delimiter:=ADelimiter;
12113 HeaderL.StrictDelimiter := False; //force quoting of strings that contain whitespace or Delimiter
12114 Lines.Add(HeaderL.DelimitedText); // Add the row in Lines
12115 finally
12116 HeaderL.Free;
12117 end;
12118 end
12119 else
12120 begin
12121 Rows[i].StrictDelimiter := False; //force quoting of strings that contain whitespace or Delimiter
12122 Rows[i].Delimiter:=ADelimiter;
12123 Lines.Add(Rows[i].DelimitedText);
12124 end;
12125 end;
12126 Lines.SaveToStream(AStream);
12127 finally
12128 Lines.Free;
12129 end;
12130 end;
12131
12132 procedure TCustomStringGrid.SaveToCSVFile(AFileName: string; ADelimiter: Char;
12133 WriteTitles: boolean=true; VisibleColumnsOnly: boolean=false);
12134 var
12135 TheStream: TFileStream;
12136 begin
12137 TheStream:=TFileStream.Create(AFileName,fmCreate);
12138 try
12139 SaveToCSVStream(TheStream, ADelimiter, WriteTitles, VisibleColumnsOnly);
12140 finally
12141 TheStream.Free;
12142 end;
12143 end;
12144
12145 procedure Register;
12146 begin
12147 RegisterComponents('Additional',[TStringGrid,TDrawGrid]);
12148 end;
12149
12150
12151 { TGridColumnTitle }
12152
12153 procedure TGridColumnTitle.WriteCaption(Writer: TWriter);
12154 var
12155 aStr: string;
12156 PropInfo: PPropInfo;
12157 begin
12158 if not FIsDefaultCaption then aStr := FCaption
12159 else aStr := Caption;
12160 if Assigned(Writer.OnWriteStringProperty) then begin
12161 PropInfo := GetPropInfo(Self, 'Caption');
12162 Writer.OnWriteStringProperty(Writer, Self, PropInfo, aStr);
12163 end;
12164 Writer.WriteString(aStr);
12165 end;
12166
12167 procedure TGridColumnTitle.FontChanged(Sender: TObject);
12168 begin
12169 FisDefaultTitleFont := False;
12170 FColumn.ColumnChanged;
12171 end;
12172
GetAlignmentnull12173 function TGridColumnTitle.GetAlignment: TAlignment;
12174 begin
12175 if FAlignment = nil then
12176 result := GetDefaultAlignment
12177 else
12178 result := FAlignment^;
12179 end;
12180
TGridColumnTitle.GetCaptionnull12181 function TGridColumnTitle.GetCaption: TCaption;
12182 begin
12183 if (FCaption = nil) and FIsDefaultCaption then
12184 result := GetDefaultCaption
12185 else
12186 result := FCaption;
12187 end;
12188
GetColornull12189 function TGridColumnTitle.GetColor: TColor;
12190 begin
12191 if FColor = nil then
12192 result := GetDefaultColor
12193 else
12194 result := FColor^;
12195 end;
12196
12197 procedure TGridColumnTitle.FillTitleDefaultFont;
12198 var
12199 AGrid: TCustomGrid;
12200 begin
12201 AGrid := FColumn.Grid;
12202 if AGrid<>nil then
12203 FFont.Assign( AGrid.TitleFont )
12204 else
12205 FFont.Assign( FColumn.Font );
12206 FIsDefaultTitleFont := True;
12207 end;
12208
12209 procedure TGridColumnTitle.FixDesignFontsPPI(const ADesignTimePPI: Integer);
12210 var
12211 LIsDefaultTitleFont: Boolean;
12212 begin
12213 LIsDefaultTitleFont := FIsDefaultTitleFont;
12214 FColumn.Grid.DoFixDesignFontPPI(Font, ADesignTimePPI);
12215 FIsDefaultTitleFont := LIsDefaultTitleFont;
12216 end;
12217
GetFontnull12218 function TGridColumnTitle.GetFont: TFont;
12219 begin
12220 Result := FFont;
12221 end;
12222
GetLayoutnull12223 function TGridColumnTitle.GetLayout: TTextLayout;
12224 begin
12225 if FLayout = nil then
12226 result := GetDefaultLayout
12227 else
12228 result := FLayout^;
12229 end;
12230
IsAlignmentStorednull12231 function TGridColumnTitle.IsAlignmentStored: boolean;
12232 begin
12233 result := FAlignment <> nil;
12234 end;
12235
IsCaptionStorednull12236 function TGridColumnTitle.IsCaptionStored: boolean;
12237 begin
12238 result := false;
12239 end;
12240
IsColorStorednull12241 function TGridColumnTitle.IsColorStored: boolean;
12242 begin
12243 result := FColor <> nil;
12244 end;
12245
TGridColumnTitle.IsFontStorednull12246 function TGridColumnTitle.IsFontStored: boolean;
12247 begin
12248 result := not IsDefaultFont;
12249 end;
12250
IsLayoutStorednull12251 function TGridColumnTitle.IsLayoutStored: boolean;
12252 begin
12253 result := FLayout <> nil;
12254 end;
12255
12256 procedure TGridColumnTitle.ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double);
12257 var
12258 LIsDefaultTitleFont: Boolean;
12259 begin
12260 LIsDefaultTitleFont := FIsDefaultTitleFont;
12261 FColumn.Grid.DoScaleFontPPI(Font, AToPPI, AProportion);
12262 FIsDefaultTitleFont := LIsDefaultTitleFont;
12263 end;
12264
12265 procedure TGridColumnTitle.SetAlignment(const AValue: TAlignment);
12266 begin
12267 if Falignment = nil then begin
12268 if AValue = GetDefaultAlignment then
12269 exit;
12270 New(Falignment)
12271 end else if FAlignment^ = AValue then
12272 exit;
12273 FAlignment^ := AValue;
12274 FColumn.ColumnChanged;
12275 end;
12276
12277 procedure TGridColumnTitle.SetCaption(const AValue: TCaption);
12278 begin
12279 if (FCaption=nil)or(AValue<>StrPas(FCaption)) then begin
12280 if FCaption<>nil then
12281 StrDispose(FCaption);
12282 FCaption := StrNew(PChar(AValue));
12283 FIsDefaultCaption := false;
12284 FColumn.ColumnChanged;
12285 end;
12286 end;
12287
12288 procedure TGridColumnTitle.DefineProperties(Filer: TFiler);
12289 begin
12290 inherited DefineProperties(Filer);
12291 Filer.DefineProperty('Caption', nil, @WriteCaption, true);
12292 end;
12293
12294 procedure TGridColumnTitle.SetColor(const AValue: TColor);
12295 begin
12296 if FColor=nil then begin
12297 if AValue = GetDefaultColor then
12298 exit;
12299 New(FColor)
12300 end else if FColor^=AValue then
12301 exit;
12302 FColor^ := AValue;
12303 FColumn.ColumnChanged;
12304 end;
12305
12306 procedure TGridColumnTitle.SetFont(const AValue: TFont);
12307 begin
12308 if not FFont.IsEqual(AValue) then
12309 FFont.Assign(AValue);
12310 end;
12311
12312 procedure TGridColumnTitle.SetImageIndex(const AValue: TImageIndex);
12313 begin
12314 if FImageIndex = AValue then exit;
12315 FImageIndex := AValue;
12316 FColumn.ColumnChanged;
12317 end;
12318
12319 procedure TGridColumnTitle.SetImageLayout(const AValue: TButtonLayout);
12320 begin
12321 if FImageLayout = AValue then exit;
12322 FImageLayout := AValue;
12323 FColumn.ColumnChanged;
12324 end;
12325
12326 procedure TGridColumnTitle.SetLayout(const AValue: TTextLayout);
12327 begin
12328 if FLayout = nil then begin
12329 if AValue = GetDefaultLayout then
12330 exit;
12331 New(FLayout)
12332 end else if FLayout^ = AValue then
12333 exit;
12334 FLayout^ := AValue;
12335 FColumn.ColumnChanged;
12336 end;
12337
12338 procedure TGridColumnTitle.SetMultiLine(const AValue: Boolean);
12339 begin
12340 if FMultiLine = AValue then exit;
12341 FMultiLine := AValue;
12342 FColumn.ColumnChanged;
12343 end;
12344
12345 procedure TGridColumnTitle.SetPrefixOption(const AValue: TPrefixOption);
12346 begin
12347 if FPrefixOption=AValue then exit;
12348 FPrefixOption:=AValue;
12349 FColumn.ColumnChanged;
12350 end;
12351
12352 procedure TGridColumnTitle.Assign(Source: TPersistent);
12353 begin
12354 if Source is TGridColumnTitle then begin
12355 Alignment := TGridColumnTitle(Source).Alignment;
12356 Layout := TGridColumnTitle(Source).Layout;
12357 Caption := TGridColumnTitle(Source).Caption;
12358 Color := TGridColumnTitle(Source).Color;
12359 Font := TGridColumnTitle(Source).Font;
12360 ImageIndex := TGridColumnTitle(Source).ImageIndex;
12361 end else
12362 inherited Assign(Source);
12363 end;
12364
TGridColumnTitle.GetDefaultCaptionnull12365 function TGridColumnTitle.GetDefaultCaption: string;
12366 begin
12367 Result := 'Title'
12368 end;
12369
TGridColumnTitle.GetDefaultAlignmentnull12370 function TGridColumnTitle.GetDefaultAlignment: TAlignment;
12371 begin
12372 result := taLeftJustify
12373 end;
12374
TGridColumnTitle.GetDefaultColornull12375 function TGridColumnTitle.GetDefaultColor: TColor;
12376 begin
12377 if FColumn.Grid <> nil then
12378 result := FColumn.Grid.FixedColor
12379 else
12380 result := clBtnFace
12381 end;
12382
GetDefaultLayoutnull12383 function TGridColumnTitle.GetDefaultLayout: TTextLayout;
12384 begin
12385 result := tlCenter
12386 end;
12387
TGridColumnTitle.GetOwnernull12388 function TGridColumnTitle.GetOwner: TPersistent;
12389 begin
12390 Result := FColumn;
12391 end;
12392
12393 constructor TGridColumnTitle.Create(TheColumn: TGridColumn);
12394 begin
12395 inherited Create;
12396 FColumn := TheColumn;
12397 FIsDefaultTitleFont := True;
12398 FFont := TFont.Create;
12399 FillTitleDefaultFont;
12400 FFont.OnChange := @FontChanged;
12401 FImageIndex := -1;
12402 FImageLayout := blGlyphRight;
12403 FIsDefaultCaption := true;
12404 end;
12405
12406 destructor TGridColumnTitle.Destroy;
12407 begin
12408 if FFont<>nil then FFont.Free;
12409 if FAlignment<>nil then Dispose(FAlignment);
12410 if FColor<>nil then Dispose(FColor);
12411 if FCaption<>nil then StrDispose(FCaption); //DisposeStr(FCaption);
12412 if FLayout<>nil then Dispose(FLayout);
12413 inherited Destroy;
12414 end;
12415
IsDefaultnull12416 function TGridColumnTitle.IsDefault: boolean;
12417 begin
12418 Result := (FAlignment = nil) and (FColor = nil) and (FCaption = nil) and
12419 IsDefaultFont and (FLayout = nil) and
12420 (FImageIndex = 0) and (FImageLayout = blGlyphRight);
12421 end;
12422
12423 { TGridColumn }
12424
12425 procedure TGridColumn.FontChanged(Sender: TObject);
12426 begin
12427 FisDefaultFont := False;
12428 ColumnChanged;
12429 end;
12430
TGridColumn.GetAlignmentnull12431 function TGridColumn.GetAlignment: TAlignment;
12432 begin
12433 if FAlignment=nil then
12434 Result := GetDefaultAlignment
12435 else
12436 Result := FAlignment^;
12437 end;
12438
GetColornull12439 function TGridColumn.GetColor: TColor;
12440 begin
12441 if FColor=nil then
12442 result := GetDefaultColor
12443 else
12444 result := FColor^
12445 end;
12446
GetExpandednull12447 function TGridColumn.GetExpanded: Boolean;
12448 begin
12449 result := True;
12450 end;
12451
GetFontnull12452 function TGridColumn.GetFont: TFont;
12453 begin
12454 result := FFont;
12455 end;
12456
GetGridnull12457 function TGridColumn.GetGrid: TCustomGrid;
12458 begin
12459 if Collection is TGridColumns then
12460 result := (Collection as TGridColumns).Grid
12461 else
12462 result := nil;
12463 end;
12464
GetLayoutnull12465 function TGridColumn.GetLayout: TTextLayout;
12466 begin
12467 if FLayout=nil then
12468 result := GetDefaultLayout
12469 else
12470 result := FLayout^;
12471 end;
12472
GetMaxSizenull12473 function TGridColumn.GetMaxSize: Integer;
12474 begin
12475 if FMaxSize=nil then
12476 result := GetDefaultMaxSize
12477 else
12478 result := FMaxSize^;
12479 end;
12480
TGridColumn.GetMinSizenull12481 function TGridColumn.GetMinSize: Integer;
12482 begin
12483 if FMinSize=nil then
12484 result := GetDefaultMinSize
12485 else
12486 result := FMinSize^;
12487 end;
12488
TGridColumn.GetSizePrioritynull12489 function TGridColumn.GetSizePriority: Integer;
12490 begin
12491 if not Visible then
12492 result := 0
12493 else
12494 if FSizePriority=nil then
12495 result := GetDefaultSizePriority
12496 else
12497 result := FSizePriority^;
12498 end;
12499
TGridColumn.GetPickListnull12500 function TGridColumn.GetPickList: TStrings;
12501 begin
12502 Result := FPickList;
12503 end;
12504
GetReadOnlynull12505 function TGridColumn.GetReadOnly: Boolean;
12506 begin
12507 if FReadOnly=nil then
12508 result := GetDefaultReadOnly
12509 else
12510 result := FReadOnly^;
12511 end;
12512
TGridColumn.GetStoredWidthnull12513 function TGridColumn.GetStoredWidth: Integer;
12514 begin
12515 if FWidth=nil then
12516 result := -1
12517 else
12518 result := FWidth^;
12519 end;
12520
GetValueCheckednull12521 function TGridColumn.GetValueChecked: string;
12522 begin
12523 if FValueChecked = nil then
12524 Result := GetDefaultValueChecked
12525 else
12526 Result := FValueChecked;
12527 end;
12528
GetValueUncheckednull12529 function TGridColumn.GetValueUnchecked: string;
12530 begin
12531 if FValueUnChecked = nil then
12532 Result := GetDefaultValueUnChecked
12533 else
12534 Result := FValueUnChecked;
12535 end;
12536
GetVisiblenull12537 function TGridColumn.GetVisible: Boolean;
12538 begin
12539 if FVisible=nil then begin
12540 result := GetDefaultVisible;
12541 end else
12542 result := FVisible^;
12543 end;
12544
GetWidthnull12545 function TGridColumn.GetWidth: Integer;
12546 var
12547 tmpGrid: TCustomGrid;
12548 begin
12549 {$ifdef newcols}
12550 if not Visible then
12551 exit(0);
12552 {$endif}
12553 if FWidth=nil then
12554 result := GetDefaultWidth
12555 else
12556 result := FWidth^;
12557 if (result<0) then
12558 begin
12559 tmpGrid := Grid;
12560 if tmpGrid<>nil then
12561 result := tmpGrid.DefaultColWidth;
12562 end;
12563 end;
12564
IsAlignmentStorednull12565 function TGridColumn.IsAlignmentStored: boolean;
12566 begin
12567 result := FAlignment <> nil;
12568 end;
12569
IsColorStorednull12570 function TGridColumn.IsColorStored: boolean;
12571 begin
12572 result := FColor <> nil;
12573 end;
12574
TGridColumn.IsFontStorednull12575 function TGridColumn.IsFontStored: boolean;
12576 begin
12577 result := not FisDefaultFont;
12578 end;
12579
IsLayoutStorednull12580 function TGridColumn.IsLayoutStored: boolean;
12581 begin
12582 result := FLayout <> nil;
12583 end;
12584
IsMinSizeStorednull12585 function TGridColumn.IsMinSizeStored: boolean;
12586 begin
12587 result := FMinSize <> nil;
12588 end;
12589
IsMaxSizeStorednull12590 function TGridColumn.IsMaxSizeStored: boolean;
12591 begin
12592 result := FMaxSize <> nil;
12593 end;
12594
IsReadOnlyStorednull12595 function TGridColumn.IsReadOnlyStored: boolean;
12596 begin
12597 result := FReadOnly <> nil;
12598 end;
12599
TGridColumn.IsSizePriorityStorednull12600 function TGridColumn.IsSizePriorityStored: boolean;
12601 begin
12602 result := FSizePriority <> nil;
12603 end;
12604
IsValueCheckedStorednull12605 function TGridColumn.IsValueCheckedStored: boolean;
12606 begin
12607 result := FValueChecked <> nil;
12608 end;
12609
IsValueUncheckedStorednull12610 function TGridColumn.IsValueUncheckedStored: boolean;
12611 begin
12612 Result := FValueUnchecked <> nil;
12613 end;
12614
TGridColumn.IsVisibleStorednull12615 function TGridColumn.IsVisibleStored: boolean;
12616 begin
12617 result := (FVisible<>nil) and not FVisible^;
12618 end;
12619
TGridColumn.IsWidthStorednull12620 function TGridColumn.IsWidthStored: boolean;
12621 begin
12622 result := FWidth <> nil;
12623 end;
12624
12625 procedure TGridColumn.ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double);
12626 var
12627 LisDefaultFont: Boolean;
12628 begin
12629 LisDefaultFont := FisDefaultFont;
12630 Grid.DoScaleFontPPI(Font, AToPPI, AProportion);
12631 FisDefaultFont := LisDefaultFont;
12632 Title.ScaleFontsPPI(AToPPI, AProportion);
12633 end;
12634
12635 procedure TGridColumn.SetAlignment(const AValue: TAlignment);
12636 begin
12637 if FAlignment = nil then begin
12638 if AValue=GetDefaultAlignment then
12639 exit;
12640 New(FAlignment);
12641 end else if FAlignment^ = AValue then
12642 exit;
12643 FAlignment^ := AValue;
12644 ColumnChanged;
12645 end;
12646
12647 procedure TGridColumn.SetButtonStyle(const AValue: TColumnButtonStyle);
12648 begin
12649 if FButtonStyle=AValue then exit;
12650 FButtonStyle:=AValue;
12651 ColumnChanged;
12652 end;
12653
12654 procedure TGridColumn.SetColor(const AValue: TColor);
12655 begin
12656 if FColor = nil then begin
12657 if AValue=GetDefaultColor then
12658 exit;
12659 New(FColor)
12660 end else if FColor^ = AValue then
12661 exit;
12662 FColor^ := AValue;
12663 ColumnChanged;
12664 end;
12665
12666 procedure TGridColumn.SetExpanded(const AValue: Boolean);
12667 begin
12668 //todo
12669 end;
12670
12671 procedure TGridColumn.SetFont(const AValue: TFont);
12672 begin
12673 if not FFont.IsEqual(AValue) then
12674 FFont.Assign(AValue);
12675 end;
12676
12677 procedure TGridColumn.SetLayout(const AValue: TTextLayout);
12678 begin
12679 if FLayout = nil then begin
12680 if AValue=GetDefaultLayout then
12681 exit;
12682 New(FLayout)
12683 end else if FLayout^ = AValue then
12684 exit;
12685 FLayout^ := AValue;
12686 ColumnChanged;
12687 end;
12688
12689 procedure TGridColumn.SetMaxSize(const AValue: Integer);
12690 begin
12691 if FMaxSize = nil then begin
12692 if AValue = GetDefaultMaxSize then
12693 exit;
12694 New(FMaxSize)
12695 end else if FMaxSize^ = AVAlue then
12696 exit;
12697 FMaxSize^ := AValue;
12698 ColumnChanged;
12699 end;
12700
12701 procedure TGridColumn.SetMinSize(const Avalue: Integer);
12702 begin
12703 if FMinSize = nil then begin
12704 if AValue = GetDefaultMinSize then
12705 exit;
12706 New(FMinSize)
12707 end else if FMinSize^ = AVAlue then
12708 exit;
12709 FMinSize^ := AValue;
12710 ColumnChanged;
12711 end;
12712
12713 procedure TGridColumn.SetPickList(const AValue: TStrings);
12714 begin
12715 if AValue=nil then
12716 FPickList.Clear
12717 else
12718 FPickList.Assign(AValue);
12719 end;
12720
12721 procedure TGridColumn.SetReadOnly(const AValue: Boolean);
12722 begin
12723 if FReadOnly = nil then begin
12724 if AValue = GetDefaultReadOnly then
12725 exit;
12726 New(FReadOnly)
12727 end else if FReadOnly^ = AValue then
12728 exit;
12729 FReadOnly^ := Avalue;
12730 ColumnChanged;
12731 end;
12732
12733 procedure TGridColumn.SetSizePriority(const AValue: Integer);
12734 begin
12735 if FSizePriority = nil then begin
12736 if AValue = GetDefaultSizePriority then
12737 exit;
12738 New(FSizePriority)
12739 end else if FSizePriority^ = AVAlue then
12740 exit;
12741 FSizePriority^ := AValue;
12742 ColumnChanged;
12743 end;
12744
12745 procedure TGridColumn.SetTitle(const AValue: TGridColumnTitle);
12746 begin
12747 FTitle.Assign(AValue);
12748 end;
12749
12750 procedure TGridColumn.SetValueChecked(const AValue: string);
12751 begin
12752 if (FValueChecked=nil)or(CompareText(AValue, FValueChecked)<>0) then begin
12753 if FValueChecked<>nil then
12754 StrDispose(FValueChecked)
12755 else
12756 if CompareText(AValue, GetDefaultValueChecked)=0 then
12757 exit;
12758 FValueChecked := StrNew(PChar(AValue));
12759 Changed(False);
12760 end;
12761 end;
12762
12763 procedure TGridColumn.SetValueUnchecked(const AValue: string);
12764 begin
12765 if (FValueUnchecked=nil)or(CompareText(AValue, FValueUnchecked)<>0) then begin
12766 if FValueUnchecked<>nil then
12767 StrDispose(FValueUnchecked)
12768 else
12769 if CompareText(AValue, GetDefaultValueUnchecked)=0 then
12770 exit;
12771 FValueUnchecked := StrNew(PChar(AValue));
12772 Changed(False);
12773 end;
12774 end;
12775
12776 procedure TGridColumn.SetVisible(const AValue: Boolean);
12777 begin
12778 if FVisible = nil then begin
12779 if AValue=GetDefaultVisible then
12780 exit;
12781 New(FVisible)
12782 end else if FVisible^ = AValue then
12783 exit;
12784 FVisible^ := AValue;
12785 AllColumnsChange;
12786 end;
12787
12788 procedure TGridColumn.SetWidth(const AValue: Integer);
12789 begin
12790 if (AValue=0) and not Visible then
12791 exit;
12792 if AValue>=0 then begin
12793 if FWidth = nil then begin
12794 New(FWidth)
12795 end else if FWidth^ = AVAlue then
12796 exit;
12797 FWidth^ := AValue;
12798 end else begin
12799 // negative value is handed over - dispose FWidth to use DefaultWidth
12800 if FWidth <> nil then begin
12801 Dispose(FWidth);
12802 FWidth := nil;
12803 end else
12804 exit;
12805 end;
12806 FWidthChanged:=true;
12807 ColumnChanged;
12808 end;
12809
GetDefaultReadOnlynull12810 function TGridColumn.GetDefaultReadOnly: boolean;
12811 begin
12812 result := false;
12813 end;
12814
GetDefaultLayoutnull12815 function TGridColumn.GetDefaultLayout: TTextLayout;
12816 begin
12817 result := tlCenter
12818 end;
12819
GetDefaultVisiblenull12820 function TGridColumn.GetDefaultVisible: boolean;
12821 begin
12822 Result := True;
12823 end;
12824
GetDefaultValueCheckednull12825 function TGridColumn.GetDefaultValueChecked: string;
12826 begin
12827 result := '1';
12828 end;
12829
TGridColumn.GetDefaultValueUncheckednull12830 function TGridColumn.GetDefaultValueUnchecked: string;
12831 begin
12832 result := '0';
12833 end;
12834
GetDefaultWidthnull12835 function TGridColumn.GetDefaultWidth: Integer;
12836 var
12837 tmpGrid: TCustomGrid;
12838 begin
12839 tmpGrid := Grid;
12840 if tmpGrid<>nil then
12841 result := tmpGrid.DefaultColWidth
12842 else
12843 result := -1;
12844 end;
12845
TGridColumn.GetDefaultMaxSizenull12846 function TGridColumn.GetDefaultMaxSize: Integer;
12847 begin
12848 // get a better default
12849 Result := 200;
12850 end;
12851
GetDefaultMinSizenull12852 function TGridColumn.GetDefaultMinSize: Integer;
12853 begin
12854 // get a better default
12855 result := 10;
12856 end;
12857
TGridColumn.GetDefaultColornull12858 function TGridColumn.GetDefaultColor: TColor;
12859 var
12860 TmpGrid: TCustomGrid;
12861 begin
12862 TmpGrid := Grid;
12863 if TmpGrid<>nil then
12864 result := TmpGrid.Color
12865 else
12866 result := clWindow
12867 end;
12868
TGridColumn.GetDefaultSizePrioritynull12869 function TGridColumn.GetDefaultSizePriority: Integer;
12870 begin
12871 Result := 1;
12872 end;
12873
12874 procedure TGridColumn.Assign(Source: TPersistent);
12875 begin
12876 if Source is TGridColumn then begin
12877 //DebugLn('Assigning TGridColumn[',dbgs(Index),'] a TgridColumn')
12878 Collection.BeginUpdate;
12879 try
12880 Alignment := TGridColumn(Source).Alignment;
12881 ButtonStyle := TGridColumn(Source).ButtonStyle;
12882 Color := TGridColumn(Source).Color;
12883 DropDownRows := TGridColumn(Source).DropDownRows;
12884 //Expanded := TGridColumn(Source).Expanded; //todo
12885 Font := TGridColumn(Source).Font;
12886 Layout := TGridColumn(Source).Layout;
12887 MinSize := TGridColumn(Source).MinSize;
12888 MaxSize := TGridColumn(Source).MaxSize;
12889 PickList := TGridColumn(Source).PickList;
12890 ReadOnly := TGridColumn(Source).ReadOnly;
12891 SizePriority := TGridColumn(Source).SizePriority;
12892 Title := TGridColumn(Source).Title;
12893 Width := TGridCOlumn(Source).Width;
12894 Visible := TGridColumn(Source).Visible;
12895 finally
12896 Collection.EndUpdate;
12897 end;
12898 end else
12899 inherited Assign(Source);
12900 end;
12901
TGridColumn.GetDisplayNamenull12902 function TGridColumn.GetDisplayName: string;
12903 begin
12904 if Title.Caption<>'' then
12905 Result := Title.Caption
12906 else
12907 Result := 'GridColumn';
12908 end;
12909
GetDefaultAlignmentnull12910 function TGridColumn.GetDefaultAlignment: TAlignment;
12911 begin
12912 if ButtonStyle in [cbsCheckboxColumn,cbsButtonColumn] then
12913 result := taCenter
12914 else
12915 result := taLeftJustify;
12916 end;
12917
12918 procedure TGridColumn.ColumnChanged;
12919 begin
12920 Changed(False);
12921 FWidthChanged := False;
12922 end;
12923
12924 procedure TGridColumn.AllColumnsChange;
12925 begin
12926 Changed(True);
12927 FWidthChanged := False;
12928 end;
12929
CreateTitlenull12930 function TGridColumn.CreateTitle: TGridColumnTitle;
12931 begin
12932 result := TGridColumnTitle.Create(Self);
12933 end;
12934
12935 procedure TGridColumn.SetIndex(Value: Integer);
12936 var
12937 AGrid: TCustomGrid;
12938 CurCol,DstCol: Integer;
12939 begin
12940 AGrid := Grid;
12941 if (Value<>Index) and (AGrid<>nil) then begin
12942 // move grid content
12943 CurCol := Grid.GridColumnFromColumnIndex(Index);
12944 DstCol := Grid.GridColumnFromColumnIndex(Value);
12945 if (CurCol>=0) and (DstCol>=0) then begin
12946 AGrid.GridFlags:=AGrid.GridFlags + [gfColumnsLocked];
12947 AGrid.DoOPMoveColRow(true, CurCol, DstCol);
12948 AGrid.GridFlags:=AGrid.GridFlags - [gfColumnsLocked];
12949 end;
12950 end;
12951 // move column item index
12952 inherited SetIndex(Value);
12953 end;
12954
12955 constructor TGridColumn.Create(ACollection: TCollection);
12956 begin
12957 inherited Create(ACollection);
12958 FTitle := CreateTitle;
12959
12960 FIsDefaultFont := True;
12961 FFont := TFont.Create;
12962 FillDefaultFont;
12963 FFont.OnChange := @FontChanged;
12964
12965 FPickList:= TStringList.Create;
12966 FButtonStyle := cbsAuto;
12967 FDropDownRows := 7;
12968 end;
12969
12970 destructor TGridColumn.Destroy;
12971 begin
12972 if FAlignment<>nil then Dispose(FAlignment);
12973 if FColor<>nil then Dispose(FColor);
12974 if FVisible<>nil then Dispose(FVisible);
12975 if FReadOnly<>nil then Dispose(FReadOnly);
12976 if FWidth<>nil then Dispose(FWidth);
12977 if FLayout<>nil then Dispose(FLayout);
12978 if FMaxSize<>nil then Dispose(FMaxSize);
12979 if FMinSize<>nil then Dispose(FMinSize);
12980 if FSizePriority<>nil then Dispose(FSizePriority);
12981 if FValueChecked<>nil then StrDispose(FValueChecked);
12982 if FValueUnchecked<>nil then StrDispose(FValueUnchecked);
12983
12984 FreeThenNil(FPickList);
12985 FreeThenNil(FFont);
12986 FreeThenNil(FTitle);
12987 inherited Destroy;
12988 end;
12989
12990 procedure TGridColumn.FillDefaultFont;
12991 var
12992 AGrid: TCustomGrid;
12993 begin
12994 AGrid := Grid;
12995 if (AGrid<>nil) then begin
12996 FFont.Assign(AGrid.Font);
12997 FIsDefaultFont := True;
12998 end;
12999 end;
13000
13001 procedure TGridColumn.FixDesignFontsPPI(const ADesignTimePPI: Integer);
13002 var
13003 LisDefaultFont: Boolean;
13004 begin
13005 LisDefaultFont := FisDefaultFont;
13006 Grid.DoFixDesignFontPPI(Font, ADesignTimePPI);
13007 FisDefaultFont := LisDefaultFont;
13008 Title.FixDesignFontsPPI(ADesignTimePPI);
13009 end;
13010
IsDefaultnull13011 function TGridColumn.IsDefault: boolean;
13012 begin
13013 result := FTitle.IsDefault and (FAlignment=nil) and (FColor=nil)
13014 and (FVisible=nil) and (FReadOnly=nil) and (FWidth=nil) and FIsDefaultFont
13015 and (FLayout=nil) and (FMaxSize=nil) and (FMinSize=nil)
13016 and (FSizePriority=nil);
13017 end;
13018
13019 { TGridColumns }
13020
GetColumnnull13021 function TGridColumns.GetColumn(Index: Integer): TGridColumn;
13022 begin
13023 result := TGridColumn( inherited Items[Index] );
13024 end;
13025
GetEnablednull13026 function TGridColumns.GetEnabled: Boolean;
13027 begin
13028 result := VisibleCount > 0;
13029 end;
13030
13031 procedure TGridColumns.SetColumn(Index: Integer; Value: TGridColumn);
13032 begin
13033 Items[Index].Assign( Value );
13034 end;
13035
GetVisibleCountnull13036 function TGridColumns.GetVisibleCount: Integer;
13037 {$ifNdef newcols}
13038 var
13039 i: Integer;
13040 {$endif}
13041 begin
13042 {$ifdef newcols}
13043 result := Count;
13044 {$else}
13045 result := 0;
13046 for i:=0 to Count-1 do
13047 if Items[i].Visible then
13048 inc(result);
13049 {$endif}
13050 end;
13051
GetOwnernull13052 function TGridColumns.GetOwner: TPersistent;
13053 begin
13054 Result := FGrid;
13055 end;
13056
13057 procedure TGridColumns.Update(Item: TCollectionItem);
13058 begin
13059 //if (FGrid<>nil) and not (csLoading in FGrid.ComponentState) then
13060 FGrid.ColumnsChanged(TGridColumn(Item));
13061 end;
13062
13063 procedure TGridColumns.TitleFontChanged;
13064 var
13065 c: TGridColumn;
13066 i: Integer;
13067 begin
13068 for i:=0 to Count-1 do begin
13069 c := Items[i];
13070 if (c<>nil)and(c.Title.IsDefaultFont) then begin
13071 c.Title.FillTitleDefaultFont;
13072 end;
13073 end;
13074 end;
13075
13076 procedure TGridColumns.FontChanged;
13077 var
13078 c: TGridColumn;
13079 i: Integer;
13080 begin
13081 for i:=0 to Count-1 do begin
13082 c := Items[i];
13083 if (c<>nil)and(c.IsDefaultFont) then begin
13084 c.FillDefaultFont;
13085 end;
13086 end;
13087 end;
13088
13089 procedure TGridColumns.RemoveColumn(Index: Integer);
13090 begin
13091 if HasIndex(Index) then
13092 Delete(Index)
13093 else
13094 raise Exception.Create('Index out of range')
13095 end;
13096
13097 procedure TGridColumns.MoveColumn(FromIndex, ToIndex: Integer);
13098 begin
13099 if HasIndex(FromIndex) then
13100 if HasIndex(ToIndex) then
13101 Items[FromIndex].Index := ToIndex
13102 else
13103 raise Exception.Create('ToIndex out of range')
13104 else
13105 raise Exception.Create('FromIndex out of range')
13106 end;
13107
13108 procedure TGridColumns.ExchangeColumn(Index, WithIndex: Integer);
13109 begin
13110 if HasIndex(Index) then
13111 if HasIndex(WithIndex) then begin
13112 BeginUpdate;
13113 Items[WithIndex].Index := Index;
13114 Items[Index+1].Index := WithIndex;
13115 EndUpdate;
13116 end else
13117 raise Exception.Create('WithIndex out of range')
13118 else
13119 raise Exception.Create('Index out of range')
13120 end;
13121
13122 procedure TGridColumns.InsertColumn(Index: Integer);
13123 begin
13124 FGrid.BeginUpdate;
13125 Add;
13126 MoveColumn(Count-1, Index);
13127 FGrid.EndUpdate;
13128 end;
13129
13130 constructor TGridColumns.Create(AGrid: TCustomGrid;
13131 aItemClass: TCollectionItemClass);
13132 begin
13133 inherited Create( aItemClass );
13134 FGrid := AGrid;
13135 end;
13136
Addnull13137 function TGridColumns.Add: TGridColumn;
13138 begin
13139 result := TGridColumn( inherited add );
13140 end;
13141
13142 procedure TGridColumns.Clear;
13143 begin
13144 BeginUpdate;
13145 inherited Clear;
13146 EndUpdate
13147 end;
13148
TGridColumns.ColumnByTitlenull13149 function TGridColumns.ColumnByTitle(const aTitle: string): TGridColumn;
13150 var
13151 i: Integer;
13152 begin
13153 result := nil;
13154 for i:=0 to Count-1 do
13155 if SameText(Items[i].Title.Caption, aTitle) then begin
13156 result := Items[i];
13157 break;
13158 end;
13159 end;
13160
RealIndexnull13161 function TGridColumns.RealIndex(Index: Integer): Integer;
13162 {$ifNdef NewCols}
13163 var
13164 i: Integer;
13165 {$endif}
13166 begin
13167 {$ifdef NewCols}
13168 if Index>Count-1 then
13169 result := -1
13170 else
13171 result := Index;
13172 {$else}
13173 result := -1;
13174 if Index>=0 then
13175 for i:=0 to Count-1 do begin
13176 if Items[i].Visible then begin
13177 Dec(index);
13178 if Index<0 then begin
13179 result := i;
13180 exit;
13181 end;
13182 end;
13183 end;
13184 {$endif}
13185 end;
13186
IndexOfnull13187 function TGridColumns.IndexOf(Column: TGridColumn): Integer;
13188 var
13189 i: Integer;
13190 begin
13191 result := -1;
13192 for i:=0 to Count-1 do
13193 if Items[i]=Column then begin
13194 result := i;
13195 break;
13196 end;
13197 end;
13198
IsDefaultnull13199 function TGridColumns.IsDefault: boolean;
13200 var
13201 i: Integer;
13202 begin
13203 result := True;
13204 for i:=0 to Count-1 do
13205 result := Result and Items[i].IsDefault;
13206 end;
13207
TGridColumns.HasIndexnull13208 function TGridColumns.HasIndex(Index: Integer): boolean;
13209 begin
13210 result := (index>-1)and(index<count);
13211 end;
13212
VisibleIndexnull13213 function TGridColumns.VisibleIndex(Index: Integer): Integer;
13214 var
13215 i: Integer;
13216 begin
13217 result := -1;
13218 if HasIndex(Index) and Items[Index].Visible then
13219 for i:=0 to Index do
13220 if Items[i].Visible then
13221 inc(result);
13222 end;
13223
13224 { TButtonCellEditor }
13225
13226 procedure TButtonCellEditor.msg_SetGrid(var Msg: TGridMessage);
13227 begin
13228 FGrid:=Msg.Grid;
13229 Msg.Options:=EO_HOOKKEYDOWN or EO_HOOKKEYPRESS or EO_HOOKKEYUP;
13230 end;
13231
13232 procedure TButtonCellEditor.msg_SetBounds(var Msg: TGridMessage);
13233 var
13234 r: TRect;
13235 begin
13236 r := Msg.CellRect;
13237 FGrid.AdjustInnerCellRect(r);
13238 if r.Right-r.Left>DEFBUTTONWIDTH then
13239 r.Left:=r.Right-DEFBUTTONWIDTH;
13240 SetBounds(r.Left, r.Top, r.Right-r.Left, r.Bottom-r.Top);
13241 end;
13242
13243 procedure TButtonCellEditor.msg_SetPos(var Msg: TGridMessage);
13244 begin
13245 FCol := Msg.Col;
13246 FRow := Msg.Row;
13247 end;
13248
13249 procedure TButtonCellEditor.msg_Ready(var Msg: TGridMessage);
13250 begin
13251 Width := DEFBUTTONWIDTH;
13252 end;
13253
13254 procedure TButtonCellEditor.msg_GetGrid(var Msg: TGridMessage);
13255 begin
13256 Msg.Grid := FGrid;
13257 Msg.Options:= EO_IMPLEMENTED;
13258 end;
13259
13260 { TPickListCellEditor }
13261 procedure TPickListCellEditor.WndProc(var TheMessage: TLMessage);
13262 begin
13263 {$IfDef GridTraceMsg}
13264 TransMsg('PicklistEditor: ', TheMessage);
13265 {$Endif}
13266 if TheMessage.msg=LM_KILLFOCUS then begin
13267 if HWND(TheMessage.WParam) = HWND(Handle) then begin
13268 // lost the focus but it returns to ourselves
13269 // eat the message.
13270 TheMessage.Result := 0;
13271 exit;
13272 end;
13273 end;
13274 inherited WndProc(TheMessage);
13275 end;
13276
13277 procedure TPickListCellEditor.KeyDown(var Key: Word; Shift: TShiftState);
AllSelectednull13278 function AllSelected: boolean;
13279 begin
13280 result := (SelLength>0) and (SelLength=Length(Text));
13281 end;
AtStartnull13282 function AtStart: Boolean;
13283 begin
13284 Result:= (SelStart=0);
13285 end;
AtEndnull13286 function AtEnd: Boolean;
13287 begin
13288 result := ((SelStart+1)>Length(Text)) or AllSelected;
13289 end;
13290 procedure doEditorKeyDown;
13291 begin
13292 if FGrid<>nil then
13293 FGrid.EditorkeyDown(Self, key, shift);
13294 end;
13295 procedure doGridKeyDown;
13296 begin
13297 if FGrid<>nil then
13298 FGrid.KeyDown(Key, shift);
13299 end;
GetFastEntrynull13300 function GetFastEntry: boolean;
13301 begin
13302 if FGrid<>nil then
13303 Result := FGrid.FastEditing
13304 else
13305 Result := False;
13306 end;
13307 procedure CheckEditingKey;
13308 begin
13309 // if editor is not readonly, start editing
13310 // else not interested
13311 if (FGrid=nil) or FGrid.EditorIsReadOnly then
13312 Key := 0;
13313 end;
13314 var
13315 IntSel: boolean;
13316 begin
13317 {$IfDef dbgGrid}
13318 DebugLn('TPickListCellEditor.KeyDown INIT: Key=',Dbgs(Key));
13319 {$Endif}
13320 inherited KeyDown(Key,Shift);
13321 case Key of
13322
13323 VK_F2:
13324 if AllSelected then begin
13325 SelLength := 0;
13326 SelStart := Length(Text);
13327 end;
13328
13329 VK_RETURN:
13330 if DroppedDown then begin
13331 CheckEditingKey;
13332 DroppedDown := False;
13333 if Key<>0 then begin
13334 doEditorKeyDown;
13335 Key:=0;
13336 end;
13337 end else
13338 doEditorKeyDown;
13339
13340 VK_DELETE:
13341 CheckEditingKey;
13342
13343 VK_UP, VK_DOWN:
13344 if not DroppedDown then
13345 doGridKeyDown;
13346
13347 VK_LEFT, VK_RIGHT:
13348 if GetFastEntry then begin
13349 IntSel:=
13350 ((Key=VK_LEFT) and not AtStart) or
13351 ((Key=VK_RIGHT) and not AtEnd);
13352 if not IntSel then begin
13353 doGridKeyDown;
13354 end;
13355 end;
13356
13357 VK_END, VK_HOME:
13358 ;
13359 VK_ESCAPE:
13360 begin
13361 doGridKeyDown;
13362 FGrid.EditorHide;
13363 end;
13364 else
13365 doEditorKeyDown;
13366 end;
13367 {$IfDef dbgGrid}
13368 DebugLn('TPickListCellEditor.KeyDown END: Key=',Dbgs(Key));
13369 {$Endif}
13370 end;
13371
13372 procedure TPickListCellEditor.EditingDone;
13373 begin
13374 {$ifdef dbgGrid}DebugLn('TPickListCellEditor.EditingDone INIT');{$ENDIF}
13375 inherited EditingDone;
13376 if FGrid<>nil then
13377 FGrid.EditingDone;
13378 {$ifdef dbgGrid}DebugLn('TPickListCellEditor.EditingDone END');{$ENDIF}
13379 end;
13380
13381 procedure TPickListCellEditor.DropDown;
13382 begin
13383 {$ifDef dbgGrid} DebugLn('TPickListCellEditor.DropDown INIT'); {$Endif}
13384 inherited DropDown;
13385 {$ifDef dbgGrid} DebugLn('TPickListCellEditor.DropDown END'); {$Endif}
13386 end;
13387
13388 procedure TPickListCellEditor.CloseUp;
13389 begin
13390 {$ifDef dbgGrid} DebugLn('TPickListCellEditor.CloseUp INIT'); {$Endif}
13391 inherited CloseUp;
13392 {$ifDef dbgGrid} DebugLn('TPickListCellEditor.CloseUp END'); {$Endif}
13393 end;
13394
13395 procedure TPickListCellEditor.Select;
13396 begin
13397 if FGrid<>nil then begin
13398 FGrid.EditorTextChanged(FCol, FRow, Text);
13399 FGrid.PickListItemSelected(Self);
13400 end;
13401 inherited Select;
13402 end;
13403
13404 procedure TPickListCellEditor.Change;
13405 begin
13406 if FGrid<>nil then
13407 FGrid.EditorTextChanged(FCol, FRow, Text);
13408 inherited Change;
13409 end;
13410
13411 procedure TPickListCellEditor.msg_GetValue(var Msg: TGridMessage);
13412 begin
13413 Msg.Col := FCol;
13414 Msg.Row := FRow;
13415 Msg.Value:=Text;
13416 end;
13417
13418 procedure TPickListCellEditor.msg_SetGrid(var Msg: TGridMessage);
13419 begin
13420 FGrid:=Msg.Grid;
13421 Msg.Options:=EO_AUTOSIZE or EO_SELECTALL or EO_HOOKKEYPRESS or EO_HOOKKEYUP;
13422 end;
13423
13424 procedure TPickListCellEditor.msg_SetValue(var Msg: TGridMessage);
13425 begin
13426 Text := Msg.Value;
13427 SelStart := Length(Text);
13428 end;
13429
13430 procedure TPickListCellEditor.msg_SetPos(var Msg: TGridMessage);
13431 begin
13432 FCol := Msg.Col;
13433 FRow := Msg.Row;
13434 end;
13435
13436 procedure TPickListCellEditor.msg_GetGrid(var Msg: TGridMessage);
13437 begin
13438 Msg.Grid := FGrid;
13439 Msg.Options:= EO_IMPLEMENTED;
13440 end;
13441
13442 { TCompositeCellEditor }
13443
13444 procedure TCompositeCellEditor.DispatchMsg(msg: TGridMessage);
13445 var
13446 i: Integer;
13447 begin
13448 for i:=0 to Length(FEditors)-1 do
13449 if FEditors[i].Editor<>nil then
13450 Feditors[i].Editor.Dispatch(msg);
13451 end;
13452
GetMaxLengthnull13453 function TCompositeCellEditor.GetMaxLength: Integer;
13454 var
13455 AEditor: TWinControl;
13456 begin
13457 result := 0;
13458 AEditor := GetActiveControl;
13459 if AEditor is TCustomEdit then
13460 result := TCustomEdit(AEditor).MaxLength;
13461 end;
13462
13463 procedure TCompositeCellEditor.SetMaxLength(AValue: Integer);
13464 var
13465 AEditor: TWinControl;
13466 begin
13467 AEditor := GetActiveControl;
13468 if AEditor is TCustomEdit then
13469 TCustomEdit(AEditor).MaxLength := AValue;
13470 end;
13471
TCompositeCellEditor.GetActiveControlnull13472 function TCompositeCellEditor.GetActiveControl: TWinControl;
13473 var
13474 i: Integer;
13475 begin
13476 result := nil;
13477 for i:=0 to Length(Feditors)-1 do
13478 if (FEditors[i].Editor<>nil) and
13479 (FEditors[i].ActiveControl) then begin
13480 Result := FEditors[i].Editor;
13481 break;
13482 end;
13483 end;
13484
13485 procedure TCompositeCellEditor.msg_GetValue(var Msg: TGridMessage);
13486 var
13487 i: Integer;
13488 DefaultValue: string;
13489 LocalMsg: TGridMessage;
13490 begin
13491 Msg.Col := FCol;
13492 Msg.Row := FRow;
13493
13494 DefaultValue := Msg.Value;
13495 for i:=0 to Length(FEditors)-1 do begin
13496
13497 if FEditors[i].Editor=nil then
13498 continue;
13499
13500 LocalMsg := Msg;
13501 Feditors[i].Editor.Dispatch(LocalMsg);
13502 if CompareText(DEfaultValue, LocalMsg.Value)<>0 then begin
13503 // on multiple editors, simply return the first one has
13504 // a different value than default value
13505 Msg := LocalMsg;
13506 break;
13507 end;
13508
13509 end;
13510 end;
13511
13512 procedure TCompositeCellEditor.msg_SetGrid(var Msg: TGridMessage);
13513 var
13514 LocalMsg,ResMsg: TGridMessage;
13515 i: Integer;
13516 begin
13517 FGrid:=Msg.Grid;
13518 ResMsg := Msg;
13519 for i:=0 to Length(FEditors)-1 do begin
13520 if FEditors[i].Editor=nil then
13521 continue;
13522
13523 LocalMsg := Msg;
13524 Feditors[i].Editor.Dispatch(LocalMsg);
13525
13526 if LocalMsg.Options and EO_SELECTALL <> 0 then
13527 ResMsg.Options := ResMsg.Options or EO_SELECTALL;
13528 if LocalMsg.Options and EO_HOOKKEYDOWN <> 0 then
13529 ResMsg.Options := ResMsg.Options or EO_HOOKKEYDOWN;
13530 if LocalMsg.Options and EO_HOOKKEYPRESS <> 0 then
13531 ResMsg.Options := ResMsg.Options or EO_HOOKKEYPRESS;
13532 if LocalMsg.Options and EO_HOOKKEYUP <> 0 then
13533 ResMsg.Options := ResMsg.Options or EO_HOOKKEYUP;
13534
13535 end;
13536 Msg := ResMsg;
13537 end;
13538
13539 procedure TCompositeCellEditor.msg_SetValue(var Msg: TGridMessage);
13540 begin
13541 DispatchMsg(msg);
13542 end;
13543
13544 procedure TCompositeCellEditor.msg_SetBounds(var Msg: TGridMessage);
13545 var
13546 r: TRect;
13547 begin
13548 r := Msg.CellRect;
13549 FGrid.AdjustInnerCellRect(r);
13550 SetBounds(r.Left, r.Top, r.Right-r.Left, r.Bottom-r.Top);
13551 end;
13552
13553 procedure TCompositeCellEditor.msg_SetMask(var Msg: TGridMessage);
13554 begin
13555 DispatchMsg(Msg);
13556 end;
13557
13558 procedure TCompositeCellEditor.msg_SelectAll(var Msg: TGridMessage);
13559 begin
13560 DispatchMsg(Msg);
13561 end;
13562
13563 procedure TCompositeCellEditor.CMControlChange(var Message: TLMEssage);
13564 begin
13565 if (Message.WParam<>0) and (not Boolean(Message.LParam)) then
13566 TControl(Message.WParam).Align:=alNone;
13567 end;
13568
13569 procedure TCompositeCellEditor.msg_SetPos(var Msg: TGridMessage);
13570 begin
13571 FCol := Msg.Col;
13572 FRow := Msg.Row;
13573 DispatchMsg(Msg);
13574 end;
13575
13576 procedure TCompositeCellEditor.msg_GetGrid(var Msg: TGridMessage);
13577 begin
13578 Msg.Grid := FGrid;
13579 Msg.Options:= EO_IMPLEMENTED;
13580 end;
13581
13582 procedure TCompositeCellEditor.VisibleChanging;
13583 var
13584 i: Integer;
13585 Msg: TGridMessage;
13586 begin
13587 inherited VisibleChanging;
13588
13589 if Visible then begin
13590 // hidding: hide all editors
13591 for i:=0 to Length(Feditors)-1 do
13592 if FEditors[i].Editor<>nil then
13593 FEDitors[i].Editor.Visible:= not Visible;
13594 end else begin
13595 Msg.LclMsg.msg:=GM_READY;
13596 // showing: show all editors
13597 for i:=0 to Length(Feditors)-1 do begin
13598 if FEditors[i].Editor=nil then
13599 continue;
13600 FEditors[i].Editor.Parent := Self;
13601 FEditors[i].Editor.Visible:= True;
13602 FEditors[i].Editor.Align:=FEditors[i].Align;
13603 // notify now that it's now shown
13604 FEditors[i].Editor.Dispatch(Msg);
13605 end;
13606 end;
13607 end;
13608
13609 procedure TCompositeCellEditor.SetFocus;
13610 var
13611 ActCtrl: TWinControl;
13612 begin
13613 if Visible then begin
13614 ActCtrl := GetActiveControl;
13615 if ActCtrl<>nil then begin
13616 ActCtrl.Visible:=true;
13617 ActCtrl.SetFocus;
13618 exit;
13619 end;
13620 end;
13621 inherited SetFocus;
13622 end;
13623
Focusednull13624 function TCompositeCellEditor.Focused: Boolean;
13625 var
13626 i: Integer;
13627 begin
13628 Result:=inherited Focused;
13629 if not result then
13630 for i:=0 to Length(Feditors)-1 do
13631 if (FEditors[i].Editor<>nil) and (FEditors[i].Editor.Focused) then begin
13632 result := true;
13633 break;
13634 end;
13635 end;
13636
13637 procedure TCompositeCellEditor.WndProc(var TheMessage: TLMessage);
13638 begin
13639 with TheMessage do
13640 if msg=LM_CHAR then begin
13641 Result := SendChar(Char(WParam));
13642 if Result=1 then
13643 exit;
13644 end;
13645 inherited WndProc(TheMessage);
13646 end;
13647
13648
DoUTF8KeyPressnull13649 function TCompositeCellEditor.DoUTF8KeyPress(var UTF8Key: TUTF8Char): boolean;
13650 begin
13651 Result:=inherited DoUTF8KeyPress(UTF8Key);
13652 if not Result and (Length(UTF8Key)>1) then begin
13653 if SendChar(UTF8Key)=1 then begin
13654 UTF8Key := '';
13655 Result := true;
13656 end;
13657 end;
13658 end;
13659
SendCharnull13660 function TCompositeCellEditor.SendChar(AChar: TUTF8Char): Integer;
13661 var
13662 ActCtrl: TWinControl;
13663 begin
13664 Result := 0;
13665 ActCtrl := GetActiveControl;
13666 if (ActCtrl<>nil) and ActCtrl.HandleAllocated then begin
13667 TWSCustomGridClass(FGrid.WidgetSetClass).SendCharToEditor(ActCtrl, AChar);
13668 Result:=1;
13669 end;
13670 end;
13671
13672 destructor TCompositeCellEditor.Destroy;
13673 begin
13674 SetLength(FEditors, 0);
13675 inherited destroy;
13676 end;
13677
13678 procedure TCompositeCellEditor.AddEditor(aEditor: TWinControl; aAlign: TAlign;
13679 ActiveCtrl: boolean);
13680 var
13681 i: Integer;
13682 begin
13683 i := Length(FEditors);
13684 SetLength(FEditors, i+1);
13685 FEditors[i].Editor := aEditor;
13686 FEditors[i].Align := aAlign;
13687 FEditors[i].ActiveControl:=ActiveCtrl;
13688 end;
13689
13690 { TStringGrid }
13691
13692 class procedure TStringGrid.WSRegisterClass;
13693 const
13694 Done: Boolean = False;
13695 begin
13696 if Done then
13697 Exit;
13698 RegisterPropertyToSkip(Self, 'VisibleRowCount',
13699 'Property streamed in by older compiler', '');
13700 RegisterPropertyToSkip(Self, 'VisibleColCount',
13701 'Property streamed in by older compiler', '');
13702 inherited WSRegisterClass;
13703 Done := True;
13704 end;
13705
13706 end.
13707