1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
|
unit mcgrid;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Grids;
type
TDrawCellTextEvent = procedure (Sender: TObject; ACol, ARow: Integer;
ARect: TRect; AState: TGridDrawState; AText: String;
var Handled: Boolean) of object;
TMergeCellsEvent = procedure (Sender: TObject; ACol, ARow: Integer;
var ALeft, ATop, ARight, ABottom: Integer) of object;
{ TMCStringGrid: MC = "merged cells" }
TMCStringGrid = class(TStringGrid)
private
FMergeLock: Integer;
FOnMergeCells: TMergeCellsEvent;
FOnDrawCellText: TDrawCellTextEvent;
protected
procedure CalcCellExtent(ACol, ARow: Integer; var ARect: TRect); override;
procedure DoEditorShow; override;
procedure DrawCell(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState); override;
procedure DrawCellText(ACol, ARow: Integer; ARect: TRect;
AState: TGridDrawState; AText: String); override;
function GetCells(ACol, ARow: Integer): String; override;
function GetEditText(ACol, ARow: Integer): String; override;
function IsMerged(ACol, ARow: Integer): Boolean; overload;
function IsMerged(ACol, ARow: Integer;
out ALeft, ATop, ARight, ABottom: Integer): Boolean; overload;
procedure MoveSelection; override;
procedure PrepareCanvas(aCol, aRow: Integer; AState: TGridDrawState); override;
procedure SetEditText(ACol, ARow: LongInt; const Value: String); override;
function MoveNextSelectable(Relative: Boolean; DCol, DRow: Integer): Boolean; override;
published
property OnDrawCelLText: TDrawCellTextEvent read FOnDrawCellText write FOnDrawCellText;
property OnMergeCells: TMergeCellsEvent read FOnMergeCells write FOnMergeCells;
end;
implementation
{ Calculates the size of the merged block }
procedure TMCStringGrid.CalcCellExtent(ACol, ARow: Integer; var ARect: TRect);
var
L, T, R, B, dummy: Integer;
begin
if IsMerged(ACol, ARow, L, T, R, B) then begin
ColRowToOffset(true, true, L, ARect.Left, dummy);
ColRowToOffset(true, true, R, dummy, ARect.Right);
ColRowToOffset(false, true, T, ARect.Top, dummy);
ColRowToOffset(false, true, B, dummy, ARect.Bottom);
end else
// Call the inherited procedure to handle non-merged cells
inherited;
end;
{ Make sure that the cell editor of a merged block is the same size as the
merged block }
procedure TMCStringGrid.DoEditorShow;
var
R: TRect;
begin
inherited;
if (goColSpanning in Options) and Assigned(Editor) then begin
R := CellRect(Col, Row);
CalcCellExtent(Col, Row, R);
Editor.SetBounds(R.Left, R.Top, R.Right-R.Left-1, R.Bottom-R.Top-1);
end;
end;
procedure TMCStringGrid.DrawCell(aCol, aRow: Integer; aRect: TRect;
aState: TGridDrawState);
var
L, T, R, B: Integer;
begin
if IsMerged(aCol, aRow, L, T, R, B) and ((aCol<>L) or (aRow<>T)) then
// nothing to draw
else
inherited DrawCell(aCol, aRow, aRect, aState);
end;
{ Draws the cell text. Allows to hook in an external painting routine which
will replace the built-in painting routine if it sets "Handled" to true. }
procedure TMCStringGrid.DrawCellText(ACol, ARow: Integer; ARect: TRect;
AState: TGridDrawState; AText: String);
var
handled: Boolean;
begin
handled := false;
if Assigned(FOnDrawCellText) then
FOnDrawCellText(Self, ACol, ARow, ARect, AState, AText, handled);
if not handled then
inherited;
end;
{ Returns the string to be displayed in the specified cell. In case of a merged
block only the text assigned to the top-left cell of the block is used. }
function TMCStringGrid.GetCells(ACol, ARow: Integer): String;
var
L, T, R, B: Integer;
begin
if (FMergeLock = 0) and IsMerged(ACol, ARow, L, T, R, B) then
Result := inherited GetCells(L, T)
else
Result := inherited GetCells(ACol, ARow);
end;
{ Make sure to use only the topleft cell of a merged block for editing }
function TMCStringGrid.GetEditText(ACol, ARow: Integer): String;
begin
Result := GetCells(ACol, ARow);
if Assigned(OnGetEditText) then OnGetEditText(self, ACol, ARow, Result);
end;
{ Check whether the specified cell belongs to a merged block}
function TMCStringGrid.IsMerged(ACol, ARow: Integer): Boolean;
var
L, T, R, B: Integer;
begin
Result := IsMerged(ACol, ARow, L, T, R, B);
end;
{ Checks whether the specified cell belongs to a merged block and returns the
cell coordinate of the block extent }
function TMCStringGrid.IsMerged(ACol,ARow: Integer;
out ALeft, ATop, ARight, ABottom: Integer): Boolean;
var
tmp: Integer;
begin
Result := false;
if not (goColSpanning in Options) then exit;
if not Assigned(FOnMergeCells) then exit;
inc(FMergeLock);
ALeft := ACol;
ARight := ACol;
ATop := ARow;
ABottom := ARow;
FOnMergeCells(Self, ACol, ARow, ALeft, ATop, ARight, ABottom);
if ALeft > ARight then begin
tmp := ALeft;
ALeft := ARight;
ARight := tmp;
end;
if ATop > ABottom then begin
tmp := ATop;
ATop := ABottom;
ABottom := tmp;
end;
Result := (ALeft <> ARight) or (ATop <> ABottom);
dec(FMergeLock);
end;
{ Repaints the entire grid after the selection is moved because normally only
the selected cell would be painted, and this would result in an imcompletely
painted merged block }
procedure TMCStringGrid.MoveSelection;
begin
if SelectActive then
InvalidateGrid;
inherited;
end;
{ Makes sure that all cells of the merged block are drawn as selected/focused,
not just the active cell }
procedure TMCStringGrid.PrepareCanvas(aCol, aRow: Integer;
AState: TGridDrawState);
var
L, T, R, B: Integer;
begin
if IsMerged(ACol, ARow, L, T, R, B) and
(Col >= L) and (Col <= R) and (Row >= T) and (Row <= B) and
not ((ACol = Col) and (ARow = Row))
then
AState := AState + [gdSelected, gdFocused];
inherited;
end;
{ Writes the edited text back into the grid. Makes sure that, in case of a
merged block, the edited text is assigned to the top/left cell }
procedure TMCStringGrid.SetEditText(ACol, ARow: LongInt; const Value: String);
var
L, T, R, B: Integer;
begin
if IsMerged(ACol, ARow, L,T,R,B) then
inherited SetEditText(L, T, Value)
else
inherited SetEditText(ACol, ARow, Value);
end;
function TMCStringGrid.MoveNextSelectable(Relative: Boolean; DCol, DRow: Integer
): Boolean;
var
L, T, R, B: Integer;
begin
if Relative and IsMerged(Col, Row, L, T, R, B) then begin
// we are only interested on relative movement (basically by keyboard)
if DCol>0 then DCol := R - Col + 1 else
if DCol<0 then DCol := L - Col - 1 else
if DRow>0 then DRow := B - Row + 1 else
if DRow<0 then DRow := T - Row - 1;
end;
Result := inherited MoveNextSelectable(Relative, DCol, DRow);
end;
end.
|
