1 {*************************************************************************************
2   This file is part of Transmission Remote GUI.
3   Copyright (c) 2008-2019 by Yury Sidorov and Transmission Remote GUI working group.
4 
5   Transmission Remote GUI is free software; you can redistribute it and/or modify
6   it under the terms of the GNU General Public License as published by
7   the Free Software Foundation; either version 2 of the License, or
8   (at your option) any later version.
9 
10   Transmission Remote GUI is distributed in the hope that it will be useful,
11   but WITHOUT ANY WARRANTY; without even the implied warranty of
12   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13   GNU General Public License for more details.
14 
15   You should have received a copy of the GNU General Public License
16   along with Transmission Remote GUI; if not, write to the Free Software
17   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
18 *************************************************************************************}
19 
20 unit VarGrid;
21 
22 {$mode objfpc}{$H+}
23 
24 interface
25 
26 uses
27   Classes, SysUtils, Grids, VarList, Graphics, Controls, LMessages, Forms, StdCtrls, LCLType, ExtCtrls,LazUTF8, LCLVersion;
28 
29 type
30   TVarGrid = class;
31 
32   TCellOption = (coDrawCheckBox, coDrawTreeButton);
33   TCellOptions = set of TCellOption;
34 
35   TCellAttributes = record
36     Text: string;
37     ImageIndex: integer;
38     Indent: integer;
39     Options: TCellOptions;
40     State: TCheckBoxState;
41     Expanded: boolean;
42   end;
43 
44   TOnCellAttributes = procedure (Sender: TVarGrid; ACol, ARow, ADataCol: integer; AState: TGridDrawState; var CellAttribs: TCellAttributes) of object;
45   TOnDrawCellEvent = procedure (Sender: TVarGrid; ACol, ARow, ADataCol: integer; AState: TGridDrawState; const R: TRect; var ADefaultDrawing: boolean) of object;
46   TOnSortColumnEvent = procedure (Sender: TVarGrid; var ASortCol: integer) of object;
47   TCellNotifyEvent = procedure (Sender: TVarGrid; ACol, ARow, ADataCol: integer) of object;
48   TOnQuickSearch = procedure (Sender: TVarGrid; var SearchText: string; var ARow: integer) of object;
49 
50   { TVarGridStringEditor }
51 
52   TVarGridStringEditor = class(TStringCellEditor)
53   protected
54     procedure msg_SetGrid(var Msg: TGridMessage); message GM_SETGRID;
55     procedure msg_SetBounds(var Msg: TGridMessage); message GM_SETBOUNDS;
56   end;
57 
58   { TVarGrid }
59 
60   TVarGrid = class(TCustomDrawGrid)
61   private
62     FFirstVisibleColumn: integer;
63     FHideSelection: boolean;
64     FImages: TImageList;
65     FItems: TVarList;
66     FItemsChanging: boolean;
67     FColumnsMap: array of integer;
68     FMultiSelect: boolean;
69     FOnAfterSort: TNotifyEvent;
70     FOnCellAttributes: TOnCellAttributes;
71     FOnCheckBoxClick: TCellNotifyEvent;
72     FOnDrawCell: TOnDrawCellEvent;
73     FOnEditorHide: TNotifyEvent;
74     FOnEditorShow: TNotifyEvent;
75     FOnQuickSearch: TOnQuickSearch;
76     FOnTreeButtonClick: TCellNotifyEvent;
77     FSelCount: integer;
78     FAnchor: integer;
79     FSortColumn: integer;
80     FOnSortColumn: TOnSortColumnEvent;
81     FRow: integer;
82     FHintCell: TPoint;
83     FCurSearch: string;
84     FSearchTimer: TTimer;
85     FOldOpt: TGridOptions;
86     FNoDblClick: boolean;
87     FStrEditor: TVarGridStringEditor;
88 
GetRownull89     function GetRow: integer;
GetRowSelectednull90     function GetRowSelected(RowIndex: integer): boolean;
GetRowVisiblenull91     function GetRowVisible(RowIndex: integer): boolean;
GetSortOrdernull92     function GetSortOrder: TSortOrder;
93     procedure ItemsChanged(Sender: TObject);
94     procedure SetHideSelection(const AValue: boolean);
95     procedure SetRow(const AValue: integer);
96     procedure SetRowSelected(RowIndex: integer; const AValue: boolean);
97     procedure SetRowVisible(RowIndex: integer; const AValue: boolean);
98     procedure SetSortColumn(const AValue: integer);
99     procedure SetSortOrder(const AValue: TSortOrder);
100     procedure UpdateColumnsMap;
101     procedure UpdateSelCount;
102     procedure SelectRange(OldRow, NewRow: integer);
103     procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
CellNeedsCheckboxBitmapsnull104     function CellNeedsCheckboxBitmaps(const aCol,aRow: Integer): boolean;
105     procedure DrawCellCheckboxBitmaps(const aCol,aRow: Integer; const aRect: TRect);
FindRownull106     function FindRow(const SearchStr: string; StartRow: integer): integer;
107     procedure DoSearchTimer(Sender: TObject);
108 
109   protected
110     procedure SizeChanged(OldColCount, OldRowCount: Integer); override;
111     procedure DrawCell(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState); override;
112     procedure ColRowMoved(IsColumn: Boolean; FromIndex,ToIndex: Integer); override;
113     procedure PrepareCanvas(aCol,aRow: Integer; aState:TGridDrawState); override;
114     procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
115     procedure MouseMove(Shift: TShiftState; X,Y: Integer);override;
116     procedure KeyDown(var Key : Word; Shift : TShiftState); override;
117     procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override;
118     procedure DoOnCellAttributes(ACol, ARow, ADataCol: integer; AState: TGridDrawState; var CellAttribs: TCellAttributes);
119     procedure HeaderClick(IsColumn: Boolean; index: Integer); override;
120     procedure AutoAdjustColumn(aCol: Integer); override;
121     procedure VisualChange; override;
122     procedure DrawColumnText(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState); override;
123     procedure DblClick; override;
124     procedure Click; override;
125     procedure GetCheckBoxState(const aCol, aRow:Integer; var aState:TCheckboxState); override;
126     procedure SetCheckboxState(const aCol, aRow:Integer; const aState: TCheckboxState); override;
127     procedure SetupCell(ACol, ARow: integer; AState: TGridDrawState; out CellAttribs: TCellAttributes);
128     procedure DoOnCheckBoxClick(ACol, ARow: integer);
129     procedure DoOnTreeButtonClick(ACol, ARow: integer);
DoMouseWheelDownnull130     function  DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
DoMouseWheelUpnull131     function  DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
DoMouseWheelnull132     function  DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
133     procedure DrawRow(aRow: Integer); override;
GetCellsnull134     function  GetCells(ACol, ARow: Integer): string; override;
GetEditTextnull135     function  GetEditText(ACol, ARow: Longint): string; override;
136     procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
137     procedure DoEditorShow; override;
138     procedure DoEditorHide; override;
139 
140   public
141     constructor Create(AOwner: TComponent); override;
142     destructor Destroy; override;
EditorByStylenull143     function EditorByStyle(Style: TColumnButtonStyle): TWinControl; override;
144     procedure RemoveSelection;
145     procedure SelectAll;
146     procedure Sort; reintroduce;
ColToDataColnull147     function ColToDataCol(ACol: integer): integer;
DataColToColnull148     function DataColToCol(ADataCol: integer): integer;
149     procedure EnsureSelectionVisible;
150     procedure EnsureRowVisible(ARow: integer);
151     procedure BeginUpdate; reintroduce;
152     procedure EndUpdate(aRefresh: boolean = true); reintroduce;
153     procedure EditCell(ACol, ARow: integer);
154 
155     property Items: TVarList read FItems;
156     property RowSelected[RowIndex: integer]: boolean read GetRowSelected write SetRowSelected;
157     property RowVisible[RowIndex: integer]: boolean read GetRowVisible write SetRowVisible;
158     property SelCount: integer read FSelCount;
159     property Row: integer read GetRow write SetRow;
160     property FirstVisibleColumn: integer read FFirstVisibleColumn;
161   published
162     property Align;
163     property AlternateColor;
164     property Anchors;
165     property BorderSpacing;
166     property BorderStyle;
167     property Color;
168     property Columns;
169     property Constraints;
170     property DragCursor;
171     property DragKind;
172     property DragMode;
173     property Enabled;
174     property FixedCols;
175     property FixedRows;
176     property Font;
177     property GridLineWidth;
178     property Options;
179     property ParentColor default false;
180     property ParentFont;
181     property ParentShowHint default false;
182     property PopupMenu;
183     property RowCount;
184     property ScrollBars;
185     property ShowHint default True;
186     property TabOrder;
187     property TabStop;
188     property TitleFont;
189     property TitleImageList;
190     property TitleStyle default tsNative;
191     property Visible;
192 
193     property OnClick;
194     property OnDblClick;
195     property OnEnter;
196     property OnExit;
197     property OnHeaderClick;
198     property OnHeaderSized;
199     property OnKeyDown;
200     property OnKeyPress;
201     property OnKeyUp;
202     property OnMouseDown;
203     property OnMouseMove;
204     property OnMouseUp;
205     property OnMouseWheelDown;
206     property OnMouseWheelUp;
207     property OnContextPopup;
208     property OnDragDrop;
209     property OnDragOver;
210     property OnEndDock;
211     property OnEndDrag;
212     property OnStartDock;
213     property OnStartDrag;
214     property OnUTF8KeyPress;
215     property OnResize;
216     property OnGetEditText;
217     property OnSetEditText;
218 
219     property Images: TImageList read FImages write FImages;
220     property MultiSelect: boolean read FMultiSelect write FMultiSelect default False;
221     property SortColumn: integer read FSortColumn write SetSortColumn default -1;
222     property SortOrder: TSortOrder read GetSortOrder write SetSortOrder default soAscending;
223     property HideSelection: boolean read FHideSelection write SetHideSelection default False;
224 
225     property OnCellAttributes: TOnCellAttributes read FOnCellAttributes write FOnCellAttributes;
226     property OnDrawCell: TOnDrawCellEvent read FOnDrawCell write FOnDrawCell;
227     property OnSortColumn: TOnSortColumnEvent read FOnSortColumn write FOnSortColumn;
228     property OnAfterSort: TNotifyEvent read FOnAfterSort write FOnAfterSort;
229     property OnCheckBoxClick: TCellNotifyEvent read FOnCheckBoxClick write FOnCheckBoxClick;
230     property OnTreeButtonClick: TCellNotifyEvent read FOnTreeButtonClick write FOnTreeButtonClick;
231     property OnQuickSearch: TOnQuickSearch read FOnQuickSearch write FOnQuickSearch;
232     property OnEditorShow: TNotifyEvent read FOnEditorShow write FOnEditorShow;
233     property OnEditorHide: TNotifyEvent read FOnEditorHide write FOnEditorHide;
234   end;
235 
236 procedure Register;
237 
238 implementation
239 
240 uses Variants, Math, GraphType, lclintf, Themes, types, lclproc
241     {$ifdef LCLcarbon} , carbonproc {$endif LCLcarbon};
242 
243 const
244   roSelected = 1;
245   roCurRow   = 2;
246 
247 procedure Register;
248 begin
249   RegisterComponents('TransGUI', [TVarGrid]);
250 end;
251 
252 { TVarGridStringEditor }
253 
254 procedure TVarGridStringEditor.msg_SetGrid(var Msg: TGridMessage);
255 begin
256   inherited;
257   Msg.Options:=Msg.Options and not EO_AUTOSIZE;
258 end;
259 
260 procedure TVarGridStringEditor.msg_SetBounds(var Msg: TGridMessage);
261 var
262   ca: TCellAttributes;
263 begin
264   with Msg do begin
265     TVarGrid(Grid).SetupCell(Col, Row, [], ca);
266     with CellRect do begin
267       Inc(Left, ca.Indent);
268       if coDrawTreeButton in ca.Options then
269         Inc(Left, Bottom - Top);
270       if coDrawCheckBox in ca.Options then
271         Inc(Left, Bottom - Top);
272       if (ca.ImageIndex <> -1) and Assigned(TVarGrid(Grid).Images) then
273         Inc(Left, TVarGrid(Grid).Images.Width + 2);
274       Dec(Left, 3);
275       Dec(Top, 1);
276       SetBounds(Left, Top, Right-Left, Bottom-Top);
277     end;
278   end;
279 end;
280 
281 { TVarGrid }
282 
283 procedure TVarGrid.ItemsChanged(Sender: TObject);
284 var
285   i, OldRows, OldCols: integer;
286   pt: TPoint;
287 begin
288   FItemsChanging:=True;
289   try
290     Perform(CM_MouseLeave, 0, 0);  // Hack to call ResetHotCell to workaround a bug
291     OldRows:=RowCount;
292     OldCols:=Columns.Count;
293     i:=FItems.RowCnt + FixedRows;
294     if (FRow = -1) and (inherited Row >= i) and (i > FixedRows) then
295       inherited Row:=i - 1;
296     RowCount:=i;
297     if FRow <> -1 then begin
298       Row:=FRow;
299       FRow:=-1;
300     end;
301     UpdateSelCount;
302     while Columns.Count > FItems.ColCnt do
303       Columns.Delete(Columns.Count - 1);
304     if Columns.Count <> FItems.ColCnt then begin
305       Columns.BeginUpdate;
306       try
307         for i:=Columns.Count to FItems.ColCnt - 1 do
308           Columns.Add;
309       finally
310         Columns.EndUpdate;
311       end;
312     end;
313     if (OldRows <> RowCount) or (OldCols <> Columns.Count) then begin
314       if Parent <> nil then
315         HandleNeeded;
316       ResetSizes;
317     end
318     else
319       Invalidate;
320     pt:=ScreenToClient(Mouse.CursorPos);
321     if PtInRect(ClientRect, pt) then
322       MouseMove([], pt.x, pt.y);
323   finally
324     FItemsChanging:=False;
325   end;
326 end;
327 
328 procedure TVarGrid.SetHideSelection(const AValue: boolean);
329 begin
330   if FHideSelection=AValue then exit;
331   FHideSelection:=AValue;
332   Invalidate;
333 end;
334 
335 procedure TVarGrid.SetRow(const AValue: integer);
336 var
337   i, r: integer;
338 begin
339   if FItems.IsUpdating then
340     FRow:=AValue
341   else begin
342     r:=AValue + FixedRows;
343     if r <> inherited Row then begin
344       i:=LeftCol;
345       inherited Row:=r;
346       LeftCol:=i;
347     end;
348   end;
349 end;
350 
GetRowSelectednull351 function TVarGrid.GetRowSelected(RowIndex: integer): boolean;
352 begin
353   Result:=LongBool(FItems.RowOptions[RowIndex] and roSelected);
354 end;
355 
TVarGrid.GetRowVisiblenull356 function TVarGrid.GetRowVisible(RowIndex: integer): boolean;
357 begin
358   Result:=RowHeights[RowIndex + FixedRows] > 0;
359 end;
360 
GetSortOrdernull361 function TVarGrid.GetSortOrder: TSortOrder;
362 begin
363   Result:=inherited SortOrder;
364 end;
365 
GetRownull366 function TVarGrid.GetRow: integer;
367 begin
368   if FItems.IsUpdating and (FRow <> -1) then
369     Result:=FRow
370   else begin
371     Result:=inherited Row - FixedRows;
372   end;
373 end;
374 
375 procedure TVarGrid.SetRowSelected(RowIndex: integer; const AValue: boolean);
376 var
377   i, j: integer;
378 begin
379   i:=FItems.RowOptions[RowIndex];
380   if AValue then begin
381     j:=i or roSelected;
382     if j <> i then
383       Inc(FSelCount);
384   end
385   else begin
386     j:=i and not roSelected;
387     if j <> i then
388       Dec(FSelCount);
389   end;
390   FItems.RowOptions[RowIndex]:=j;
391   InvalidateRow(RowIndex + FixedRows);
392   if FSelCount <= 1 then
393     InvalidateRow(inherited Row);
394 end;
395 
396 procedure TVarGrid.SetRowVisible(RowIndex: integer; const AValue: boolean);
397 begin
398   if AValue then
399     RowHeights[RowIndex + FixedRows]:=DefaultRowHeight
400   else
401     RowHeights[RowIndex + FixedRows]:=0;
402 end;
403 
404 procedure TVarGrid.SetSortColumn(const AValue: integer);
405 begin
406   if FSortColumn=AValue then exit;
407   FSortColumn:=AValue;
408   if FSortColumn >= 0 then
409     Options:=Options + [goHeaderPushedLook, goHeaderHotTracking]
410   else
411     Options:=Options - [goHeaderPushedLook, goHeaderHotTracking];
412   Sort;
413 end;
414 
415 procedure TVarGrid.SetSortOrder(const AValue: TSortOrder);
416 begin
417   if SortOrder = AValue then exit;
418   inherited SortOrder:=AValue;
419   Sort;
420 end;
421 
422 procedure TVarGrid.UpdateColumnsMap;
423 var
424   i, j: integer;
425 begin
426   FFirstVisibleColumn:=-1;
427   SetLength(FColumnsMap, Columns.Count);
428   j:=0;
429   for i:=0 to Columns.Count - 1 do
430     with Columns[i] do begin
431       if (FFirstVisibleColumn < 0) and Visible then
432         FFirstVisibleColumn:=i;
433       FColumnsMap[j]:=ID - 1;
434       Inc(j);
435     end;
436   SetLength(FColumnsMap, j);
437 end;
438 
439 procedure TVarGrid.UpdateSelCount;
440 var
441   i: integer;
442 begin
443   FSelCount:=0;
444   for i:=0 to FItems.Count - 1 do
445     if RowSelected[i] then
446       Inc(FSelCount);
447 end;
448 
449 procedure TVarGrid.SelectRange(OldRow, NewRow: integer);
450 var
451   dir: integer;
452   sel: boolean;
453 begin
454   if OldRow = NewRow then
455     exit;
456   if FAnchor = -1 then
457     FAnchor:=OldRow;
458   dir:=Sign(NewRow - OldRow);
459   if Sign(FAnchor - OldRow) <> Sign(FAnchor - NewRow) then
460     while OldRow <> FAnchor do begin
461       RowSelected[OldRow]:=False;
462       Inc(OldRow, dir);
463     end;
464   sel:=Abs(FAnchor - OldRow) < Abs(FAnchor - NewRow);
465   while OldRow <> NewRow do begin
466     RowSelected[OldRow]:=sel;
467     Inc(OldRow, dir);
468   end;
469   RowSelected[NewRow]:=True;
470 end;
471 
472 procedure TVarGrid.CMHintShow(var Message: TCMHintShow);
473 var
474   ca: TCellAttributes;
475   pt: TPoint;
476   wd: integer;
477   R: TRect;
478 begin
479   with Message.HintInfo^ do begin
480     pt:=MouseToCell(CursorPos);
481     if (pt.x >= FixedCols) and (pt.y >= 0) then begin
482       R:=CellRect(pt.x, pt.y);
483       if PtInRect(R, CursorPos) then begin
484         SetupCell(pt.x, pt.y, [], ca);
485         if ca.Text <> '' then begin
486           wd:=Canvas.TextWidth(ca.Text);
487           Inc(R.Left, ca.Indent);
488           if coDrawTreeButton in ca.Options then
489             Inc(R.Left, R.Bottom - R.Top);
490           if coDrawCheckBox in ca.Options then
491             Inc(R.Left, R.Bottom - R.Top);
492           if (ca.ImageIndex <> -1) and Assigned(FImages) then
493             Inc(R.Left, FImages.Width + 2);
494           if (R.Right <= R.Left) or (R.Right - R.Left < wd + 5) then begin
495             HintStr:=ca.Text;
496             R.Top:=(R.Top + R.Bottom - Canvas.TextHeight(ca.Text)) div 2 - 4;
497             Dec(R.Left);
498             HintPos:=ClientToScreen(R.TopLeft);
499           end;
500           FHintCell:=pt;
501         end
502         else
503           Message.Result:=1;
504       end
505       else
506         Message.Result:=1;
507     end;
508   end;
509 end;
510 
TVarGrid.CellNeedsCheckboxBitmapsnull511 function TVarGrid.CellNeedsCheckboxBitmaps(const aCol, aRow: Integer): boolean;
512 var
513   C: TGridColumn;
514 begin
515   Result := false;
516   if (aRow>=FixedRows) and Columns.Enabled then begin
517     C := ColumnFromGridColumn(aCol);
518     result := (C<>nil) and (C.ButtonStyle=cbsCheckboxColumn)
519   end;
520 end;
521 
522 procedure TVarGrid.DrawCellCheckboxBitmaps(const aCol, aRow: Integer; const aRect: TRect);
523 var
524   AState: TCheckboxState;
525 begin
526   AState := cbUnchecked;
527   GetCheckBoxState(aCol, aRow, aState);
528   DrawGridCheckboxBitmaps(aCol, aRow, aRect, aState);
529 end;
530 
TVarGrid.FindRownull531 function TVarGrid.FindRow(const SearchStr: string; StartRow: integer): integer;
532 var
533   i, c: integer;
534   s, ss: string;
535   v: variant;
536 begin
537   Result:=-1;
538   if Columns.Count = 0 then
539     exit;
540   c:=SortColumn;
541   if (c < 0) or (c >= Items.ColCnt) then
542     c:=0;
543   ss:= LazUTF8.UTF8UpperCase(SearchStr);
544   for i:=StartRow to Items.Count - 1 do begin
545     v:=Items[c, i];
546     if VarIsNull(v) or VarIsEmpty(v) then
547       s:= ''
548     else
549       s:= LazUTF8.UTF8UpperCase(UTF8Encode(widestring(v)));
550     if Copy(s, 1, Length(ss)) = ss then begin
551       Result:=i;
552       break;
553     end;
554   end;
555 end;
556 
557 procedure TVarGrid.DoSearchTimer(Sender: TObject);
558 begin
559   FSearchTimer.Enabled:=False;
560   FCurSearch:='';
561 end;
562 
563 procedure TVarGrid.SizeChanged(OldColCount, OldRowCount: Integer);
564 begin
565   if not FItemsChanging and (FItems <> nil) then begin
566     FItems.ColCnt:=Columns.Count;
567     FItems.RowCnt:=RowCount - FixedRows;
568     UpdateColumnsMap;
569   end;
570   inherited;
571 end;
572 
573 procedure TVarGrid.DrawCell(aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState);
574 var
575   ca: TCellAttributes;
576 //  ts: TTextStyle;
577   dd, IsHeader: boolean;
578   R, RR: TRect;
579   det: TThemedElementDetails;
580   sz: TSize;
581   i: integer;
582 begin
583   RR:=aRect;
584   IsHeader:=(gdFixed in aState) and (aRow=0) and (aCol>=FirstGridColumn);
585   if not IsHeader and MultiSelect and (FSelCount > 0) then
586     if (aRow >= FixedRows) and (aCol >= FixedCols) and RowSelected[aRow - FixedRows] then
587       Include(aState, gdSelected)
588     else
589       Exclude(aState, gdSelected);
590 
591   PrepareCanvas(aCol, aRow, aState);
592   if DefaultDrawing then
593     SetupCell(aCol, aRow, aState, ca);
594   if not IsHeader or (TitleStyle<>tsNative) then
595     Canvas.FillRect(aRect);
596 
597   if not IsHeader then begin
598     dd:=True;
599     if Assigned(FOnDrawCell) then begin
600       R:=CellRect(aCol, aRow);
601       if goVertLine in Options then
602         Dec(R.Right, 1);
603       if goHorzLine in Options then
604         Dec(R.Bottom, 1);
605       FOnDrawCell(Self, aCol, aRow - FixedRows, ColToDataCol(aCol), aState, R, dd);
606     end;
607 
608     if DefaultDrawing and dd then begin
609       if CellNeedsCheckboxBitmaps(aCol,aRow) then
610         DrawCellCheckboxBitmaps(aCol,aRow,aRect)
611       else begin
612         Inc(aRect.Left, ca.Indent);
613         if coDrawTreeButton in ca.Options then begin
614           R:=aRect;
615           R.Right:=R.Left + (R.Bottom - R.Top);
616           aRect.Left:=R.Right;
617           if ThemeServices.ThemesEnabled then begin
618             if ca.Expanded then
619               det:=ThemeServices.GetElementDetails(ttGlyphOpened)
620             else
621               det:=ThemeServices.GetElementDetails(ttGlyphClosed);
622             sz:=ThemeServices.GetDetailSize(det);
623             with R do begin
624               Left:=(Left + Right - sz.cx) div 2;
625               Top:=(Top + Bottom - sz.cy) div 2;
626               R:=Bounds(Left, Top, sz.cx, sz.cy);
627             end;
628             ThemeServices.DrawElement(Canvas.Handle, det, R, nil);
629           end
630           else
631             with Canvas do begin
632               i:=(R.Bottom - R.Top) div 4;
633               InflateRect(R, -i, -i);
634               if (R.Right - R.Left) and 1 = 0 then
635                 Dec(R.Right);
636               if (R.Bottom - R.Top) and 1 = 0 then
637                 Dec(R.Bottom);
638               Pen.Color:=clWindowText;
639               Rectangle(R);
640               InflateRect(R, -1, -1);
641               Brush.Color:=clWindow;
642               FillRect(R);
643               InflateRect(R, -1, -1);
644               i:=(R.Top + R.Bottom) div 2;
645               MoveTo(R.Left, i);
646               LineTo(R.Right, i);
647               if not ca.Expanded then begin
648                 i:=(R.Left + R.Right) div 2;
649                 MoveTo(i, R.Top);
650                 LineTo(i, R.Bottom);
651               end;
652             end;
653         end;
654         if coDrawCheckBox in ca.Options then begin
655           R:=aRect;
656           R.Right:=R.Left + (R.Bottom - R.Top);
657           aRect.Left:=R.Right;
658           DrawGridCheckboxBitmaps(aCol, aRow, R, ca.State);
659         end;
660         if (ca.ImageIndex <> -1) and Assigned(FImages) then begin
661           FImages.Draw(Canvas, aRect.Left + 2, (aRect.Bottom + aRect.Top - FImages.Height) div 2, ca.ImageIndex, gdeNormal);
662           Inc(aRect.Left, FImages.Width + 2);
663         end;
664         if ca.Text <> '' then begin
665 {
666           if Canvas.TextStyle.Alignment <> taLeftJustify then
667             if (aRect.Right <= aRect.Left) or (aRect.Right - aRect.Left < Canvas.TextWidth(ca.Text) + 9) then begin
668               ts:=Canvas.TextStyle;
669               ts.Alignment:=taLeftJustify;
670               Canvas.TextStyle:=ts;
671             end;
672           DrawCellText(aCol, aRow, aRect, aState, ca.Text);
673 }
674           with aRect do begin
675             Inc(Top, 2);
676             Inc(Left, constCellPadding);
677             Dec(Right, constCellPadding);
678             if Right<Left then
679               Right:=Left;
680             if Left>Right then
681               Left:=Right;
682             if Bottom<Top then
683               Bottom:=Top;
684             if Top>Bottom then
685               Top:=Bottom;
686 
687             if (Left <> Right) and (Top <> Bottom) then begin
688               if Canvas.TextStyle.Alignment <> taLeftJustify then begin
689                 i:=Canvas.TextWidth(ca.Text);
690                 if i < Right - Left then
691                   case Canvas.TextStyle.Alignment of
692                     taRightJustify:
693                       Left:=Right - i;
694                     taCenter:
695                       Left:=(Left + Right - i) div 2;
696                   end;
697               end;
698               ExtUTF8Out(Canvas.Handle, Left, Top, ETO_OPAQUE or ETO_CLIPPED, @aRect, PChar(ca.Text), Length(ca.Text), nil);
699             end;
700           end;
701 
702         end;
703       end;
704     end;
705   end;
706   if gdFixed in aState then
707     DefaultDrawCell(aCol, aRow, RR, aState)
708   else
709     DrawCellGrid(aCol, aRow, RR, aState);
710 end;
711 
712 procedure TVarGrid.ColRowMoved(IsColumn: Boolean; FromIndex, ToIndex: Integer);
713 begin
714   inherited ColRowMoved(IsColumn, FromIndex, ToIndex);
715   UpdateColumnsMap;
716 end;
717 
718 procedure TVarGrid.PrepareCanvas(aCol, aRow: Integer; aState: TGridDrawState);
719 var
720   F: TCustomForm;
721 begin
722   if FHideSelection and (FSelCount = 0) then begin
723     F:=GetParentForm(Self);
724     if (F <> nil) and (F.ActiveControl <> Self) then
725       aState:=aState - [gdSelected];
726   end;
727   inherited PrepareCanvas(aCol, aRow, aState);
728   with Canvas do
729     if (Font.Color = clWindow) and (Brush.Color = clHighlight) then begin
730       Font.Color:=clHighlightText;
731 {$ifdef LCLgtk2}
732       Brush.Color:=ColorToRGB(Brush.Color); // Workaround for LCL bug
733 {$endif LCLgtk2}
734   end;
735 end;
736 
737 procedure TVarGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
738 var
739   pt: TPoint;
740   IsCtrl, CheckBoxClicked: boolean;
741   ca: TCellAttributes;
742   R, RR: TRect;
743 begin
744 {$ifdef LCLcarbon}
745   IsCtrl:=ssMeta in GetCarbonShiftState;
746 {$else}
747   IsCtrl:=ssCtrl in Shift;
748 {$endif LCLcarbon}
749   CheckBoxClicked:=False;
750   pt:=MouseToCell(Point(X,Y));
751   if ssLeft in Shift then begin
752     SetupCell(pt.x, pt.y, [], ca);
753     RR:=CellRect(pt.x, pt.y);
754     Inc(RR.Left, ca.Indent);
755     if (RR.Left <= RR.Right) and (coDrawTreeButton in ca.Options) then begin
756       R:=RR;
757       R.Right:=R.Left + (R.Bottom - R.Top);
758       if R.Right > RR.Right then
759         R.Right:=RR.Right;
760       if PtInRect(R, Point(X,Y)) then begin
761         DoOnTreeButtonClick(pt.x, pt.y);
762         InvalidateCell(pt.x, pt.y);
763         if Assigned(OnDblClick) and (ssDouble in Shift) then
764           FNoDblClick:=True;
765       end;
766       Inc(RR.Left, RR.Bottom - RR.Top);
767     end;
768     if (RR.Left <= RR.Right) and (coDrawCheckBox in ca.Options) then begin
769       R:=RR;
770       R.Right:=R.Left + (R.Bottom - R.Top);
771       if R.Right > RR.Right then
772         R.Right:=RR.Right;
773       if PtInRect(R, Point(X,Y)) then begin
774         DoOnCheckBoxClick(pt.x, pt.y);
775         InvalidateCell(pt.x, pt.y);
776         CheckBoxClicked:=True;
777         if Assigned(OnDblClick) and (ssDouble in Shift) then
778           FNoDblClick:=True;
779       end;
780     end;
781   end;
782   if (ssRight in Shift) {$ifdef darwin} or (Shift*[ssLeft, ssCtrl] = [ssLeft, ssCtrl]) {$endif} then begin
783     SetFocus;
784     if (pt.x >= FixedCols) and (pt.y >= FixedRows) then begin
785       if MultiSelect and (SelCount > 0) and not RowSelected[pt.y - FixedRows] then
786         RemoveSelection;
787       Row:=pt.y - FixedRows;
788     end;
789   end
790   else
791     if MultiSelect and (ssLeft in Shift) and (pt.x >= FixedCols) and (pt.y >= FixedRows) then begin
792       if IsCtrl then begin
793         if SelCount = 0 then
794           RowSelected[Row]:=True;
795         RowSelected[pt.y - FixedRows]:=not RowSelected[pt.y - FixedRows];
796         FAnchor:=-1;
797       end
798       else
799         if ssShift in Shift then
800           SelectRange(Row, pt.y - FixedRows)
801         else begin
802           if (SelCount > 0) and not CheckBoxClicked then
803             RemoveSelection;
804           FAnchor:=-1;
805         end;
806     end;
807   inherited MouseDown(Button, Shift, X, Y);
808 end;
809 
810 procedure TVarGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
811 var
812   pt: TPoint;
813 begin
814   NullStrictConvert := False;
815   inherited MouseMove(Shift, X, Y);
816   pt:=MouseToCell(Point(x, y));
817   if (FHintCell.x <> -1) and ((FHintCell.x <> pt.x) or (FHintCell.y <> pt.y)) then begin
818     Application.CancelHint;
819     FHintCell.x:=-1;
820   end;
821 end;
822 
823 procedure TVarGrid.KeyDown(var Key: Word; Shift: TShiftState);
824 var
825   r, k: integer;
826   ca: TCellAttributes;
827 begin
828   if EditorMode then begin
829     if Key = VK_ESCAPE then begin
830       EditorHide;
831       SetFocus;
832     end;
833     exit;
834   end;
835 
836   r:=Row;
837   k:=Key;
838 
839   if (Shift = []) and ( (k = VK_SPACE) or (k = VK_LEFT) or (k = VK_RIGHT) or (k = VK_ADD) or (k = VK_SUBTRACT) ) then begin
840     SetupCell(FixedCols, inherited Row, [], ca);
841     case k of
842       VK_SPACE:
843         if coDrawCheckBox in ca.Options then begin
844           DoOnCheckBoxClick(FixedCols, inherited Row);
845           Key:=0;
846           exit;
847         end;
848       VK_LEFT, VK_SUBTRACT:
849         if (coDrawTreeButton in ca.Options) and ca.Expanded then begin
850           DoOnTreeButtonClick(FixedCols, inherited Row);
851           Key:=0;
852           exit;
853         end;
854       VK_RIGHT, VK_ADD:
855         if (coDrawTreeButton in ca.Options) and not ca.Expanded then begin
856           DoOnTreeButtonClick(FixedCols, inherited Row);
857           Key:=0;
858           exit;
859         end;
860     end;
861   end;
862 
863   inherited KeyDown(Key, Shift);
864 
865   if MultiSelect then begin
866     if ssCtrl in Shift then begin
867       if k = VK_SPACE then
868         RowSelected[Row]:=not RowSelected[Row];
869       FAnchor:=-1;
870     end
871     else
872       if ssShift in Shift then begin
873         SelectRange(r, Row);
874       end
875       else
876         if k in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_HOME, VK_END, VK_NEXT, VK_PRIOR] then begin
877           if SelCount > 0 then
878             RemoveSelection;
879           FAnchor:=-1;
880         end;
881   end;
882   if (Key = VK_RETURN) and (Shift = []) and Assigned(OnDblClick) then
883     OnDblClick(Self);
884 end;
885 
886 procedure TVarGrid.UTF8KeyPress(var UTF8Key: TUTF8Char);
887 var
888   i, r: integer;
889 begin
890   inherited UTF8KeyPress(UTF8Key);
891   if UTF8Key = #0 then
892     exit;
893   FSearchTimer.Enabled:=False;
894   FSearchTimer.Enabled:=True;
895   if FCurSearch = '' then
896     i:=0
897   else
898     i:=Row;
899   FCurSearch:=FCurSearch + UTF8Key;
900   if Assigned(FOnQuickSearch) then begin
901     r:=i;
902     FOnQuickSearch(Self, FCurSearch, r);
903     if r <> i then
904       Row:=r;
905   end
906   else begin
907     i:=FindRow(FCurSearch, i);
908     if i >= 0 then
909       Row:=i;
910   end;
911 end;
912 
913 procedure TVarGrid.DoOnCellAttributes(ACol, ARow, ADataCol: integer; AState: TGridDrawState; var CellAttribs: TCellAttributes);
914 begin
915   if Assigned(FOnCellAttributes) then
916     FOnCellAttributes(Self, ACol, ARow, ADataCol, AState, CellAttribs);
917 end;
918 
919 procedure TVarGrid.HeaderClick(IsColumn: Boolean; index: Integer);
920 var
921   i: integer;
922 begin
923   inherited HeaderClick(IsColumn, index);
924   if IsColumn and (FSortColumn >= 0) then begin
925     fGridState:=gsNormal;
926     i:=ColToDataCol(index);
927     if FSortColumn = i then begin
928       if SortOrder = soAscending then
929         SortOrder:=soDescending
930       else
931         SortOrder:=soAscending;
932     end
933     else begin
934       SortOrder:=soAscending;
935       SortColumn:=i;
936     end;
937   end;
938 end;
939 
940 procedure TVarGrid.AutoAdjustColumn(aCol: Integer);
941 var
942   i, j, wd, h, fr: integer;
943   ca: TCellAttributes;
944 begin
945   wd:=4;
946   fr:=FixedRows;
947   for i:=0 to FItems.Count - 1 do begin
948     h:=RowHeights[i + fr];
949     if h > 0 then begin
950       SetupCell(aCol, i + fr, [], ca);
951       j:=Canvas.TextWidth(ca.Text) + 6;
952       Inc(j, ca.Indent);
953       if coDrawTreeButton in ca.Options then
954         Inc(j, h);
955       if coDrawCheckBox in ca.Options then
956         Inc(j, h);
957       if (ca.ImageIndex <> -1) and Assigned(FImages) then
958         Inc(j, FImages.Width + 2);
959       if j > wd then
960         wd:=j;
961     end;
962   end;
963   ColumnFromGridColumn(aCol).Width:=wd;
964 end;
965 
966 procedure TVarGrid.VisualChange;
967 begin
968   inherited VisualChange;
969   if HandleAllocated then
970     DefaultRowHeight:=Canvas.TextHeight('Xy') + 5;
971   UpdateColumnsMap;
972 end;
973 
974 procedure TVarGrid.DrawColumnText(aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState);
975 var
976   R: TRect;
977   i: integer;
978 begin
979   if (gdFixed in aState) and (aRow=0) and (aCol>=FirstGridColumn) then begin
980     R:=aRect;
981     if FSortColumn = ColToDataCol(aCol) then begin
982       R.Right:=R.Left + R.Bottom - R.Top;
983       InflateRect(R, -5, -5);
984       OffsetRect(R, -3, 0);
985       Dec(R.Bottom, 2);
986       aRect.Left:=R.Right + 2;
987     end;
988     inherited DrawColumnText(aCol, aRow, aRect, aState);
989     if FSortColumn = ColToDataCol(aCol) then
990       with Canvas do begin
991         Pen.Color:=clGrayText;
992         i:=(R.Left + R.Right ) div 2;
993         if SortOrder = soAscending then begin
994           MoveTo(i + (i - R.Left) - 1, R.Bottom - 1);
995           LineTo(i, R.Top - 1);
996           MoveTo(i, R.Top);
997           LineTo(i - (R.Right - i) + 1, R.Bottom);
998           LineTo(R.Right, R.Bottom);
999         end
1000         else begin
1001           MoveTo(i + (i - R.Left) - 1, R.Top + 1);
1002           LineTo(i, R.Bottom + 1);
1003           MoveTo(i, R.Bottom);
1004           LineTo(i - (R.Right - i) + 1, R.Top);
1005           LineTo(R.Right, R.Top);
1006         end;
1007       end;
1008   end;
1009 end;
1010 
1011 
1012 procedure TVarGrid.DblClick;
1013 var
1014   pt: TPoint;
1015 begin
1016   if FNoDblClick then begin
1017     FNoDblClick:=False;
1018     exit;
1019   end;
1020   pt:=MouseToCell(ScreenToClient(Mouse.CursorPos));
1021   if (pt.y < FixedRows) and (pt.y = 0) and (Cursor <> crHSplit) then
1022     exit;
1023   inherited DblClick;
1024 end;
1025 
1026 procedure TVarGrid.Click;
1027 begin
1028   if Assigned(OnClick) then
1029     OnClick(Self);
1030 end;
1031 
1032 procedure TVarGrid.GetCheckBoxState(const aCol, aRow: Integer; var aState: TCheckboxState);
1033 var
1034   s: string;
1035 begin
1036   if (aCol >= FixedCols) and (aRow >= FixedRows) then begin
1037     s:=Items[ColToDataCol(aCol), aRow - FixedRows];
1038     with Columns[GridColumnFromColumnIndex(aCol)] do
1039       if s = ValueChecked then
1040         aState:=cbChecked
1041       else
1042         if s = ValueUnchecked then
1043           aState:=cbUnchecked
1044         else
1045           aState:=cbGrayed;
1046   end;
1047   inherited GetCheckBoxState(aCol, aRow, aState);
1048 end;
1049 
1050 procedure TVarGrid.SetCheckboxState(const aCol, aRow: Integer; const aState: TCheckboxState);
1051 var
1052   s: string;
1053 begin
1054   if (aCol >= FixedCols) and (aRow >= FixedRows) then begin
1055     with Columns[GridColumnFromColumnIndex(aCol)] do
1056       case aState of
1057         cbUnchecked:
1058           s:=ValueUnchecked;
1059         cbChecked:
1060           s:=ValueChecked;
1061         else
1062           s:='?';
1063       end;
1064     Items[ColToDataCol(aCol), aRow - FixedRows]:=s;
1065   end;
1066   inherited SetCheckboxState(aCol, aRow, aState);
1067 end;
1068 
1069 procedure TVarGrid.SetupCell(ACol, ARow: integer; AState: TGridDrawState; out CellAttribs: TCellAttributes);
1070 var
1071   v: variant;
1072   dc: integer;
1073 begin
1074   if (ACol < 0) or (ARow < 0) then
1075     exit;
1076   CellAttribs.ImageIndex:=-1;
1077   CellAttribs.Indent:=0;
1078   CellAttribs.Options:=[];
1079   CellAttribs.State:=cbUnchecked;
1080   CellAttribs.Expanded:=True;
1081   if ACol >= FixedCols then begin
1082     dc:=ColToDataCol(ACol);
1083     if ARow >= FixedRows then begin
1084       v:=Items[dc, ARow - FixedRows];
1085       if not VarIsNull(v) and not VarIsEmpty(v) then
1086         CellAttribs.Text:=UTF8Encode(WideString(v))
1087       else
1088         CellAttribs.Text:='';
1089     end
1090     else
1091       CellAttribs.Text:=ColumnFromGridColumn(ACol).Title.Caption;
1092   end
1093   else
1094     dc:=-1;
1095   DoOnCellAttributes(ACol - FixedCols, ARow - FixedRows, dc, AState, CellAttribs);
1096 end;
1097 
1098 procedure TVarGrid.DoOnCheckBoxClick(ACol, ARow: integer);
1099 var
1100   i, dc, c: integer;
1101   ca: TCellAttributes;
1102   st: TCheckBoxState;
1103 begin
1104   if Assigned(FOnCheckBoxClick) then begin
1105     dc:=ColToDataCol(ACol);
1106     c:=ACol - FixedCols;
1107     FOnCheckBoxClick(Self, c, ARow - FixedRows, dc);
1108     if (SelCount > 0) and RowSelected[ARow - FixedRows] then begin
1109       SetupCell(ACol, ARow, [], ca);
1110       st:=ca.State;
1111       for i:=0 to Items.Count - 1 do
1112         if RowSelected[i] then begin
1113           SetupCell(ACol, i + FixedRows, [], ca);
1114           if (coDrawCheckBox in ca.Options) and (ca.State <> st) then
1115             FOnCheckBoxClick(Self, c, i, dc);
1116         end;
1117     end;
1118   end;
1119 end;
1120 
1121 procedure TVarGrid.DoOnTreeButtonClick(ACol, ARow: integer);
1122 begin
1123   if Assigned(FOnTreeButtonClick) then
1124     FOnTreeButtonClick(Self, ACol - FixedCols, ARow - FixedRows, ColToDataCol(ACol));
1125 end;
1126 
DoMouseWheelDownnull1127 function TVarGrid.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
1128 begin
1129   Result := False;
1130   if Assigned(OnMouseWheelDown) then
1131     OnMouseWheelDown(Self, Shift, MousePos, Result);
1132 end;
1133 
TVarGrid.DoMouseWheelUpnull1134 function TVarGrid.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;
1135 begin
1136   Result := False;
1137   if Assigned(OnMouseWheelUp) then
1138     OnMouseWheelUp(Self, Shift, MousePos, Result);
1139 end;
1140 
DoMouseWheelnull1141 function TVarGrid.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean;
1142 begin
1143   Result:=inherited DoMouseWheel(Shift, WheelDelta, MousePos);
1144   if not Result then begin
1145     if Mouse.WheelScrollLines = -1 then
1146   {$IF LCL_FULLVERSION < 1080000}
1147       GridMouseWheel(Shift, -WheelDelta*VisibleRowCount div 120)
1148     else
1149       GridMouseWheel(Shift, -WheelDelta*Mouse.WheelScrollLines div 120);
1150   {$ENDIF}
1151   {$IF LCL_FULLVERSION >= 1080000}
1152       GridMouseWheel(Shift, WheelDelta*VisibleRowCount div 120)
1153     else
1154       GridMouseWheel(Shift, -WheelDelta div 120);
1155   {$ENDIF}
1156       Result := True;
1157   end;
1158 end;
1159 
1160 constructor TVarGrid.Create(AOwner: TComponent);
1161 begin
1162   FRow:=-1;
1163   FHintCell.x:=-1;
1164   inherited Create(AOwner);
1165   FixedRows:=1;
1166   FixedCols:=0;
1167   Options:=[goRowSelect, goThumbTracking, goVertLine, goHorzLine, goColSizing, goColMoving, goDblClickAutoSize, goFixedHorzLine, goFixedVertLine];
1168   MouseWheelOption:=mwGrid;
1169   FItems:=TVarList.Create(1, 0);
1170   FItems.OnDataChanged:=@ItemsChanged;
1171   ItemsChanged(nil);
1172   TitleStyle:=tsNative;
1173   FAnchor:=-1;
1174   FSortColumn:=-1;
1175   ShowHint:=True;
1176   SetLength(FColumnsMap, 1);
1177   FColumnsMap[0]:=0;
1178   FSearchTimer:=TTimer.Create(Self);
1179   with FSearchTimer do begin
1180     Enabled:=False;
1181     Interval:=1500;
1182     OnTimer:=@DoSearchTimer;
1183   end;
1184   FastEditing:=False;
1185   EditorBorderStyle:=bsSingle;
1186 end;
1187 
1188 destructor TVarGrid.Destroy;
1189 begin
1190   inherited Destroy;
1191   FItems.Free;
1192 end;
1193 
EditorByStylenull1194 function TVarGrid.EditorByStyle(Style: TColumnButtonStyle): TWinControl;
1195 begin
1196   if Style = cbsAuto then begin
1197     if FStrEditor = nil then begin
1198       FStrEditor:=TVarGridStringEditor.Create(Self);
1199       FStrEditor.Name :='VGStringEditor';
1200       FStrEditor.Text:='';
1201       FStrEditor.Visible:=False;
1202       FStrEditor.Align:=alNone;
1203       FStrEditor.BorderStyle:=bsSingle;
1204     end;
1205     Result:=FStrEditor;
1206   end
1207   else
1208     Result:=inherited EditorByStyle(Style);
1209 end;
1210 
1211 procedure TVarGrid.RemoveSelection;
1212 var
1213   i: integer;
1214 begin
1215   for i:=0 to FItems.Count - 1 do
1216     RowSelected[i]:=False;
1217   FSelCount:=0;
1218 end;
1219 
1220 procedure TVarGrid.SelectAll;
1221 var
1222   i: integer;
1223 begin
1224   for i:=0 to FItems.Count - 1 do
1225     RowSelected[i]:=True;
1226 end;
1227 
1228 procedure TVarGrid.Sort;
1229 var
1230   i, c: integer;
1231 begin
1232   if (FSortColumn >= 0) and (FItems.Count > 0) then begin
1233     c:=FSortColumn;
1234     if Assigned(FOnSortColumn) then
1235       FOnSortColumn(Self, c);
1236     if not FItems.IsUpdating and (Row >= 0) and (Row < FItems.Count) then
1237       FItems.RowOptions[Row]:=FItems.RowOptions[Row] or roCurRow;
1238     FItems.Sort(c, SortOrder = soDescending);
1239     if not FItems.IsUpdating then begin
1240       if Assigned(FOnAfterSort) then
1241         FOnAfterSort(Self);
1242       for i:=0 to FItems.Count - 1 do
1243         if LongBool(FItems.RowOptions[i] and roCurRow) then begin
1244           FItems.RowOptions[i]:=FItems.RowOptions[i] and not roCurRow;
1245           Row:=i;
1246           break;
1247         end;
1248       Invalidate;
1249     end;
1250   end;
1251 end;
1252 
TVarGrid.ColToDataColnull1253 function TVarGrid.ColToDataCol(ACol: integer): integer;
1254 begin
1255   if (ACol >= FixedCols) and (ACol <= High(FColumnsMap)) then
1256     Result:=FColumnsMap[ACol]
1257   else
1258     Result:=-1;
1259 end;
1260 
DataColToColnull1261 function TVarGrid.DataColToCol(ADataCol: integer): integer;
1262 var
1263   i: integer;
1264 begin
1265   for i:=FixedCols to High(FColumnsMap) do
1266     if FColumnsMap[i] = ADataCol then begin
1267       Result:=i;
1268       exit;
1269     end;
1270   Result:=-1;
1271 end;
1272 
1273 procedure TVarGrid.EnsureSelectionVisible;
1274 var
1275   i: integer;
1276 begin
1277   if FSelCount > 0 then
1278     for i:=0 to FItems.Count - 1 do
1279       if RowSelected[i] then begin
1280         Row:=i;
1281         break;
1282       end;
1283   EnsureRowVisible(Row);
1284 end;
1285 
1286 procedure TVarGrid.EnsureRowVisible(ARow: integer);
1287 begin
1288   ARow:=ARow + FixedRows;
1289   if ARow < TopRow then
1290     TopRow:=ARow
1291   else
1292     if ARow > GCache.FullVisibleGrid.Bottom then
1293       TopRow:=ARow - (GCache.FullVisibleGrid.Bottom - GCache.FullVisibleGrid.Top);
1294 end;
1295 
1296 procedure TVarGrid.BeginUpdate;
1297 begin
1298   inherited BeginUpdate;
1299   Items.BeginUpdate;
1300 end;
1301 
1302 procedure TVarGrid.EndUpdate(aRefresh: boolean);
1303 begin
1304   inherited EndUpdate(aRefresh);
1305   Items.EndUpdate;
1306 end;
1307 
1308 procedure TVarGrid.EditCell(ACol, ARow: integer);
1309 begin
1310   SetFocus;
1311   FOldOpt:=Options;
1312   Options:=Options + [goEditing];
1313   EditorShowInCell(DataColToCol(ACol), ARow + FixedRows);
1314 end;
1315 
1316 procedure TVarGrid.DrawRow(aRow: Integer);
1317 var
1318   Gds: TGridDrawState;
1319   aCol: Integer;
1320   Rs: Boolean;
1321   R: TRect;
1322   ClipArea: Trect;
1323 {$ifdef LCLgtk2}
1324   Rgn: HRGN;
1325 {$endif LCLgtk2}
1326 
1327   procedure DoDrawCell;
1328   begin
1329     with GCache do begin
1330       if (aCol=HotCell.x) and (aRow=HotCell.y) and not ((PushedCell.X<>-1) and (PushedCell.Y<>-1)) then begin
1331         Include(gds, gdHot);
1332         HotCellPainted:=True;
1333       end;
1334       if ClickCellPushed and (aCol=PushedCell.x) and (aRow=PushedCell.y) then begin
1335         Include(gds, gdPushed);
1336       end;
1337     end;
1338 {$ifdef LCLgtk2}
1339     Rgn := CreateRectRgn(R.Left, R.Top, R.Right, R.Bottom);
1340     SelectClipRgn(Canvas.Handle, Rgn);
1341     DeleteObject(Rgn);
1342 {$endif LCLgtk2}
1343     DrawCell(aCol, aRow, R, gds);
1344   end;
1345 
HorizontalIntersectnull1346   function HorizontalIntersect(const aRect,bRect: TRect): boolean;
1347   begin
1348     result := (aRect.Left < bRect.Right) and (aRect.Right > bRect.Left);
1349   end;
1350 
1351 begin
1352   Rs := false;
1353   // Upper and Lower bounds for this row
1354   R.Left:=0;
1355   ColRowToOffSet(False, True, aRow, R.Top, R.Bottom);
1356   if R.Bottom <= R.Top then
1357     exit;
1358   // is this row within the ClipRect?
1359   ClipArea := Canvas.ClipRect;
1360   if (R.Top >= ClipArea.Bottom) or (R.Bottom < ClipArea.Top) then
1361     exit;
1362   // Draw columns in this row
1363   with GCache.VisibleGrid do begin
1364     for aCol:=left to Right do begin
1365       ColRowToOffset(True, True, aCol, R.Left, R.Right);
1366       if (R.Right <= R.Left) or not HorizontalIntersect(R, ClipArea) then
1367         continue;
1368       gds := [];
1369       Rs := (goRowSelect in Options);
1370       if ARow<FixedRows then
1371         include(gds, gdFixed)
1372       else begin
1373         if (aCol=Col)and(aRow=inherited Row) then
1374           gds := gds + [gdFocused, gdSelected]
1375         else
1376         if IsCellSelected[aCol, aRow] then
1377           include(gds, gdSelected);
1378       end;
1379 
1380       DoDrawCell;
1381     end;
1382 
1383     // Draw Fixed Columns
1384     For aCol:=0 to FixedCols-1 do begin
1385       gds:=[gdFixed];
1386       ColRowToOffset(True, True, aCol, R.Left, R.Right);
1387       // is this column within the ClipRect?
1388       if (R.Right > R.Left) and HorizontalIntersect(R, ClipArea) then
1389         DoDrawCell;
1390     end;
1391 
1392 {$ifdef LCLgtk2}
1393     with ClipArea do
1394       Rgn := CreateRectRgn(Left, Top, Right, Bottom);
1395     SelectClipRgn(Canvas.Handle, Rgn);
1396     DeleteObject(Rgn);
1397 {$endif LCLgtk2}
1398 
1399     // Draw the focus Rect
1400     if FocusRectVisible and (ARow=inherited Row) and
1401       ((Rs and (ARow>=Top) and (ARow<=Bottom)) or IsCellVisible(Col,ARow))
1402     then begin
1403       if EditorMode then begin
1404       //if EditorAlwaysShown and (FEditor<>nil) and FEditor.Visible then begin
1405         //DebugLn('No Draw Focus Rect');
1406       end else begin
1407         ColRowToOffset(True, True, Col, R.Left, R.Right);
1408         // is this column within the ClipRect?
1409         if HorizontalIntersect(R, ClipArea) then
1410           DrawFocusRect(Col,inherited Row, R);
1411       end;
1412     end;
1413   end;
1414 end;
1415 
GetCellsnull1416 function TVarGrid.GetCells(ACol, ARow: Integer): string;
1417 var
1418   dc: integer;
1419   v: variant;
1420 begin
1421   Result:='';
1422   dc:=ColToDataCol(ACol);
1423   if ARow >= FixedRows then begin
1424     v:=Items[dc, ARow - FixedRows];
1425     if not VarIsNull(v) and not VarIsEmpty(v) then
1426       Result:=UTF8Encode(WideString(v));
1427   end;
1428 end;
1429 
TVarGrid.GetEditTextnull1430 function TVarGrid.GetEditText(ACol, ARow: Longint): string;
1431 begin
1432   Result:=GetCells(ACol, ARow);
1433   if Assigned(OnGetEditText) then
1434     OnGetEditText(self, aCol - FixedCols, aRow - FixedRows, Result);
1435 end;
1436 
1437 procedure TVarGrid.SetEditText(ACol, ARow: Longint; const Value: string);
1438 var
1439   dc: integer;
1440 begin
1441   if not (gfEditingDone in GridFlags) then
1442     exit;
1443   if Assigned(OnSetEditText) then
1444     OnSetEditText(Self, aCol - FixedCols, aRow - FixedRows, Value)
1445   else begin
1446     dc:=ColToDataCol(ACol);
1447     if ARow >= FixedRows then
1448       Items[dc, ARow - FixedRows]:=UTF8Decode(Value);
1449   end;
1450 end;
1451 
1452 procedure TVarGrid.DoEditorShow;
1453 begin
1454   inherited DoEditorShow;
1455   if Assigned(OnEditorShow) then
1456     OnEditorShow(Self);
1457 end;
1458 
1459 procedure TVarGrid.DoEditorHide;
1460 begin
1461   try
1462     inherited DoEditorHide;
1463   finally
1464     Options:=FOldOpt;
1465   end;
1466   if Assigned(OnEditorHide) then
1467     OnEditorHide(Self);
1468 end;
1469 
1470 end.
1471 
1472