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