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 := '<';
11105 '>': s1 := '>';
11106 '"': s1 := '"';
11107 '&': s1 := '&';
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