Author: Tomas Rutkauskas
I would like to control Justification in a string grid. Column 0 LeftJustified,
column 1 Centered, column 3 Right Justified, etc.. I would also like to control the
foreground and background color of the Fixed row.
Answer:
1 unit PBExStringgrid;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids;
7
8 const
9 GM_ACTIVATECELL = WM_USER + 123;
10
11 type
12 TGMActivateCell = record
13 msg: Cardinal;
14 aCol, aRow: Integer;
15 result: Integer;
16 end;
17
18 TPBExStringgrid = class;
19 TExitCellEvent = procedure(Sender: TPBExStringgrid; aCol, aRow: Integer;
20 const edittext: string) of object;
21 TGetCellAlignmentEvent = procedure(Sender: TPBExStringgrid; aCol, aRow: Integer;
22 State: TGridDrawState; var cellAlignment: TAlignment) of object;
23 TCaptionClickEvent = procedure(sender: TPBExStringgrid; aCol, aRow: Integer) of
24 object;
25
26 TPBExStringgrid = class(Tstringgrid)
27 private
28 FExitCell: TExitCellEvent;
29 FAlignment: TAlignment;
30 FSetCanvasProperties: TDrawCellEvent;
31 FGetCellAlignment: TGetCellAlignmentEvent;
32 FCaptionClick: TCaptionClickEvent;
33 FCellOnMouseDown: TGridCoord;
34
35 procedure GMActivateCell(var msg: TGMActivateCell); message GM_ACTIVATECELL;
36 procedure SetAlignment(const Value: TAlignment);
37 protected
38 function CreateEditor: TInplaceEdit; override;
39 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
40 override;
41 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
42 override;
43 procedure ExitCell(const edittext: string; aCol, aRow: Integer); virtual;
44 procedure SetCanvasProperties(ACol, ARow: Longint; Rect: TRect;
45 State: TGridDrawState); virtual;
46 procedure DrawCell(ACol, ARow: Longint; Rect: TRect; State: TGridDrawState);
47 override;
48 procedure CaptionClick(aCol, aRow: LongInt); dynamic;
49 public
50 function GetCellAlignment(Acol, aRow: Longint; State: TGridDrawState):
51 TAlignment;
52 virtual;
53 procedure DefaultDrawCell(ACol, ARow: Longint; Rect: TRect; State:
54 TGridDrawState); virtual;
55 procedure ActivateCell(aCol, aRow: Integer);
56 procedure InvalidateCell(aCol, aRow: Integer);
57 procedure InvalidateCol(aCol: Integer);
58 procedure InvalidateRow(aRow: Integer);
59 property InplaceEditor;
60 published
61 property OnExitCell: TExitCellEvent read FExitCell write FExitCell;
62 property Alignment: TAlignment read FAlignment write SetAlignment;
63 property OnSetCanvasProperties: TDrawCellEvent read FSetCanvasProperties
64 write FSetCanvasProperties;
65 property OnGetCellAlignment: TGetCellAlignmentEvent read FGetCellAlignment
66 write FGetCellAlignment;
67 property OnCaptionClick: TCaptionClickEvent read FCaptionClick write
68 FCaptionClick;
69 end;
70
71 procedure register;
72
73 implementation
74
75 procedure register;
76 begin
77 RegisterComponents('PBGoodies', [TPBExStringgrid]);
78 end;
79
80 type
81 TExInplaceEdit = class(TInplaceEdit)
82 private
83 FLastCol, FLastRow: Integer;
84 procedure WMKillFocus(var msg: TMessage); message WM_KILLFOCUS;
85 procedure WMSetFocus(var msg: TMessage); message WM_SETFOCUS;
86 public
87 procedure CreateParams(var params: TCreateParams); override;
88 end;
89
90 { TPBExStringgrid }
91
92 procedure TPBExStringgrid.ActivateCell(aCol, aRow: Integer);
93 begin
94 PostMessage(handle, GM_ACTIVATECELL, aCol, aRow);
95 end;
96
97 procedure TPBExStringgrid.CaptionClick(aCol, aRow: LongInt);
98 begin
99 if Assigned(FCaptionClick) then
100 FCaptionClick(self, aCol, aRow);
101 end;
102
103 function TPBExStringgrid.CreateEditor: TInplaceEdit;
104 begin
105 result := TExInplaceEdit.Create(self);
106 end;
107
108 procedure TPBExStringgrid.DefaultDrawCell(ACol, ARow: Integer; Rect: TRect;
109 State: TGridDrawState);
110 const
111 flags: array[TAlignment] of DWORD = (DT_LEFT, DT_RIGHT, DT_CENTER);
112 var
113 S: string;
114 begin
115 Canvas.FillRect(Rect);
116 S := Cells[aCol, aRow];
117 if Length(S) > 0 then
118 begin
119 InflateRect(rect, -2, -2);
120 DrawText(Canvas.Handle, PChar(S), Length(S), rect, DT_SINGLELINE or DT_NOPREFIX
121 or
122 DT_VCENTER or flags[GetCellAlignment(acol, arow, state)]);
123 end;
124 end;
125
126 procedure TPBExStringgrid.DrawCell(ACol, ARow: Integer; Rect: TRect; State:
127 TGridDrawState);
128 begin
129 if Assigned(OnDrawCell) then
130 inherited
131 else
132 begin
133 SetCanvasProperties(aCol, aRow, rect, State);
134 DefaultDrawCell(aCol, aRow, rect, State);
135 Canvas.Font := Font;
136 Canvas.Brush := Brush;
137 end;
138 end;
139
140 procedure TPBExStringgrid.ExitCell(const edittext: string; aCol, aRow: Integer);
141 begin
142 if Assigned(FExitCell) then
143 FExitCell(self, aCol, aRow, edittext);
144 end;
145
146 function TPBExStringgrid.GetCellAlignment(Acol, aRow: Integer;
147 State: TGridDrawState): TAlignment;
148 begin
149 Result := FAlignment;
150 if Assigned(FGetCellAlignment) then
151 FGetCellAlignment(self, acol, arow, state, result);
152 end;
153
154 procedure TPBExStringgrid.GMActivateCell(var msg: TGMActivateCell);
155 begin
156 Col := msg.aCol;
157 Row := msg.aRow;
158 EditorMode := true;
159 InplaceEditor.SelectAll;
160 end;
161
162 procedure TPBExStringgrid.InvalidateCell(aCol, aRow: Integer);
163 begin
164 inherited InvalidateCell(aCol, aRow);
165 end;
166
167 procedure TPBExStringgrid.InvalidateCol(aCol: Integer);
168 begin
169 inherited InvalidateCol(aCol);
170 end;
171
172 procedure TPBExStringgrid.InvalidateRow(aRow: Integer);
173 begin
174 inherited InvalidateRow(aRow);
175 end;
176
177 procedure TPBExStringgrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:
178 Integer);
179 begin
180 inherited;
181 if Button = mbLeft then
182 MouseToCell(X, Y, FCellOnMouseDown.X, FCellOnMouseDown.Y)
183 else
184 FCellOnMouseDown := TGridCoord(Point(-1, -1));
185 end;
186
187 procedure TPBExStringgrid.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y:
188 Integer);
189 var
190 cell: TGridCoord;
191 begin
192 if Button = mbLeft then
193 MouseToCell(X, Y, Cell.X, Cell.Y);
194 if CompareMem(@Cell, @FCellOnMouseDown, Sizeof(cell)) and
195 ((Cell.X < FixedCols) or (Cell.Y < FixedRows)) then
196 CaptionClick(Cell.X, Cell.Y);
197 FCellOnMouseDown := TGridCoord(Point(-1, -1));
198 inherited;
199 end;
200
201 procedure TPBExStringgrid.SetAlignment(const Value: TAlignment);
202 begin
203 if FAlignment <> Value then
204 begin
205 FAlignment := Value;
206 Invalidate;
207 if Assigned(InplaceEditor) then
208 TExInplaceEdit(InplaceEditor).RecreateWnd;
209 end;
210 end;
211
212 procedure TPBExStringgrid.SetCanvasProperties(ACol, ARow: Integer;
213 Rect: TRect; State: TGridDrawState);
214 begin
215 if Assigned(FSetCanvasProperties) then
216 FSetCanvasProperties(self, aCol, aRow, Rect, State);
217 end;
218
219 { TExInplaceEdit }
220
221 procedure TExInplaceEdit.CreateParams(var params: TCreateParams);
222 const
223 flags: array[TAlignment] of DWORD = (ES_LEFT, ES_RIGHT, ES_CENTER);
224 begin
225 inherited;
226 params.Style := params.Style or flags[TPBExStringgrid(grid).Alignment];
227 end;
228
229 procedure TExInplaceEdit.WMKillFocus(var msg: TMessage);
230 begin
231 TPBExStringgrid(Grid).ExitCell(Text, FLastCol, FLastRow);
232 inherited;
233 end;
234
235 procedure TExInplaceEdit.WMSetFocus(var msg: TMessage);
236 begin
237 FLastCol := TPBExStringgrid(Grid).Col;
238 FLastRow := TPBExStringgrid(Grid).Row;
239 inherited;
240 end;
241
242 end.
|
