Author: Tomas Rutkauskas
Does anyone know how to make a cell (that has text in it) look like a button with
the text written on it?
Answer:
The following example fakes a column of buttons in column 3 of the grid. The
buttons are "clickable". Events of the grid handled are OnMouseDown, OnMOuseUp,
OnDrawCell, OnSelectCell.
1 unit Unit1;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 ComCtrls, StdCtrls, Grids;
8
9 type
10 TForm1 = class(TForm)
11 StatusBar: TStatusBar;
12 Button1: TButton;
13 Label1: TLabel;
14 StringGrid1: TStringGrid;
15 procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
16 State: TGridDrawState);
17 procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
18 Shift: TShiftState; X, Y: Integer);
19 procedure StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
20 Shift: TShiftState; X, Y: Integer);
21 procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var
22 CanSelect: Boolean);
23 procedure FormCreate(Sender: TObject);
24 private
25 { Private declarations }
26 FButtonDown: Boolean;
27 FDownRow: Integer;
28 public
29 { Public declarations }
30 end;
31
32 var
33 Form1: TForm1;
34
35 implementation
36
37 {$R *.DFM}
38
39 const
40 ButtonCol = 3;
41 type
42 TGridCracker = class(TStringGrid);
43 {gives access to protected methods of grid}
44
45 procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
46 Rect: TRect; State: TGridDrawState);
47 var
48 grid: TStringGrid;
49 begin
50 grid := Sender as TStringGrid;
51 if (aCol = ButtonCol) and (aRow >= grid.FixedRows) then
52 begin
53 {draw a button in Rect}
54 DrawFrameControl(grid.Canvas.handle, Rect, DFC_BUTTON, DFCS_BUTTONPUSH or
55 DFCS_ADJUSTRECT or DFCS_PUSHED * Ord(FButtonDown and (Arow = FDOwnrow)));
56 grid.Canvas.Brush.Style := bsClear;
57 grid.Canvas.Font.Color := clBlack;
58 grid.Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 2, grid.Cells[aCol, aRow]);
59 grid.Canvas.Brush := grid.Brush;
60 end;
61 end;
62
63 procedure TForm1.StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
64 Shift: TShiftState; X, Y: Integer);
65 var
66 r: TPoint;
67 grid: TGridCracker;
68 begin
69 if (Button = mbLeft) and ((Shift - [ssLeft]) = []) then
70 begin
71 grid := TGridCracker(Sender as TStringGrid);
72 grid.MouseToCell(X, Y, r.x, r.y);
73 if (r.x = ButtonCol) and (r.y >= grid.FixedRows) then
74 begin
75 FDownRow := r.Y;
76 FButtonDown := true;
77 grid.InvalidateCell(r.x, r.y);
78 grid.MouseCapture := true;
79 grid.Options := grid.Options - [goRangeSelect];
80 end;
81 end;
82 end;
83
84 procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
85 Shift: TShiftState; X, Y: Integer);
86 var
87 grid: TGridCracker;
88 begin
89 if FButtonDown then
90 begin
91 grid := TGridCracker(Sender as TStringGrid);
92 grid.MouseCapture := false;
93 FButtonDown := False;
94 grid.InvalidateCell(ButtonCol, FDownRow);
95 grid.Options := grid.Options + [goRangeSelect];
96 { ... might do some click action here}
97 end;
98 end;
99
100 procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
101 var CanSelect: Boolean);
102 begin
103 CanSelect := aCol <> ButtonCol;
104 end;
105
106 procedure TForm1.FormCreate(Sender: TObject);
107 var
108 i: Integer;
109 begin
110 for i := 1 to StringGrid1.rowcount - 1 do
111 StringGrid1.cells[ButtonCol, i] := format('Button %d', [i]);
112 end;
113
114 end.
|
