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