/lcl/grids.pas

http://github.com/graemeg/lazarus · Pascal · 12651 lines · 10766 code · 1288 blank · 597 comment · 1541 complexity · 26831e3252026f6bcd2e096723c75a7b MD5 · raw file

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