Author: Tomas Rutkauskas
Is there anybody who knows how to subclass the existing TDrawGrid so that all the
cells act as buttons? I would like the OnDrawCell to return the inner rectangle of
the button look and set the colors of the bevel so that they look like a button.
Answer:
1 unit ButtonDrawGrid;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids;
7
8 type
9 TPBButtonDrawGrid = class(TDrawGrid)
10 private
11 FCellDown: TGridCoord;
12 protected
13 { Protected declarations }
14 procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
15 override;
16 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
17 override;
18 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
19 override;
20 procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
21 function SelectCell(ACol, ARow: Longint): Boolean; override;
22 public
23 constructor Create(aOwner: TComponent); override;
24 end;
25
26 procedure register;
27
28 implementation
29
30 procedure register;
31 begin
32 RegisterComponents('PBGoodies', [TPBButtonDrawGrid]);
33 end;
34
35 { TButtonDrawGrid }
36
37 constructor TPBButtonDrawGrid.Create(aOwner: TComponent);
38 begin
39 inherited;
40 FCellDown.X := -1;
41 FCellDown.Y := -1;
42 end;
43
44 procedure TPBButtonDrawGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
45 AState: TGridDrawState);
46 var
47 r: TRect;
48 style: DWORD;
49 begin
50 r := ARect;
51 if not (gdFixed in aState) then
52 begin
53 Canvas.Brush.Color := clBtnFace;
54 Canvas.Font.Color := clBtnText;
55 style := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
56 if (FCellDown.X = aCol) and (FCellDown.Y = aRow) then
57 style := style or DFCS_PUSHED;
58 DrawFrameControl(Canvas.Handle, r, DFC_BUTTON, style);
59 end;
60 inherited DrawCell(ACol, aRow, r, aState);
61 end;
62
63 procedure TPBButtonDrawGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
64 Y: Integer);
65 var
66 cell: TGridCoord;
67 begin
68 if (Button = mbLeft) and ((Shift - [ssLeft]) = []) then
69 begin
70 MousetoCell(X, Y, cell.X, cell.Y);
71 if (cell.X >= FixedCols) and (cell.Y >= FixedRows) then
72 begin
73 FCellDown := cell;
74 InvalidateCell(cell.X, cell.Y);
75 end;
76 end;
77 inherited;
78 end;
79
80 procedure TPBButtonDrawGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
81 var
82 cell: TGridCoord;
83 begin
84 if Shift = [ssLeft] then
85 begin
86 MousetoCell(X, Y, cell.X, cell.Y);
87 if not CompareMem(@cell, @FCellDown, Sizeof(cell)) then
88 begin
89 if (FCellDown.X >= 0) and (FCellDown.Y >= 0) then
90 InvalidateCell(FCellDown.X, FCellDown.Y);
91 FCellDown := cell;
92 InvalidateCell(cell.X, cell.Y);
93 end;
94 end;
95 inherited;
96 end;
97
98 procedure TPBButtonDrawGrid.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y:
99 Integer);
100 begin
101 if (Button = mbLeft) and (Shift = []) then
102 begin
103 InvalidateCell(FCellDown.X, FCellDown.Y);
104 FCellDown.X := -1;
105 FCellDown.Y := -1;
106 end;
107 inherited;
108 end;
109
110 function TPBButtonDrawGrid.SelectCell(ACol, ARow: Integer): Boolean;
111 begin
112 result := false;
113 end;
114
115 end.
|
