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
| unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids;
type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
procedure FormCreate(Sender: TObject);
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
procedure StringGrid1TopLeftChanged(Sender: TObject);
private const
IdCol = 1; // Colonne de référence
private
CurId :string; // Référence actuelle
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
// Remplissage quelconque pour test
var Id := 1;
for var i := 1 to StringGrid1.RowCount -1 do
begin
StringGrid1.Cells[IdCol, i] := Id.ToString;
if i mod 3 = 0 then
inc(Id);
end;
end;
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
//--------------------------------------------------------------------------------------------------
procedure DrawLine(aCanvas :TCanvas; X1, Y1, X2, Y2 :integer);
begin
aCanvas.MoveTo(X1, Y1);
aCanvas.LineTo(X2, Y2);
end;
//--------------------------------------------------------------------------------------------------
procedure SelectPenStyle(aCanvas :TCanvas; aVisible, aReal :integer);
begin
if aVisible < aReal
then aCanvas.Pen.Style := psDot
else aCanvas.Pen.Style := psSolid;
end;
begin
with StringGrid1 do
begin
var Id := Cells[IdCol, aRow];
Canvas.Brush.Color := clWhite;
Canvas.Pen.Color := clRed;
Canvas.Pen.Style := psSolid;
Canvas.FillRect(Rect);
var s := Cells[aCol, aRow];
Canvas.TextRect(Rect, s, [tfCenter, TfVerticalCenter, tfSingleLine]);
// Groupe sélectionné ?
if (aRow >= FixedRows) and (aCol >= FixedCols) and (Id = CurId) then
begin
// Dessine toujours le rectangle complet même si les cellules sont tronquées
var R := TRect.Intersect(ClientRect, Rect);
// Ligne à gauche (1ère colonne visible non figée)
if aCol = LeftCol then
DrawLine(Canvas, R.Left, R.Top, R.Left, R.Bottom);
// Ligne en haut (1ère ligne visible non figée)
if (aRow = TopRow) or (Cells[IdCol, aRow-1] <> Id) then
DrawLine(Canvas, R.Left, R.Top, R.Right, R.Top);
// Ligne à droite (La colonne peut être partiellement visible)
if (aCol = ColCount -1) or (R.Right = ClientWidth) then
begin
SelectPenStyle(Canvas, R.Right, Rect.Right);
DrawLine(Canvas, R.Right-1, R.Top, R.Right-1, R.Bottom);
end;
// Ligne en bas (La ligne peut être partiellement visible)
if (aRow = RowCount -1) or (Cells[IdCol, aRow+1] <> Id) or (R.Bottom = ClientHeight) then
begin
SelectPenStyle(Canvas, R.Bottom, Rect.Bottom);
DrawLine(Canvas, R.Left, R.Bottom-1, R.Right, R.Bottom-1);
end;
end;
end;
end;
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
begin
CurId := StringGrid1.Cells[IdCol, aRow];
StringGrid1.Invalidate;
end;
procedure TForm1.StringGrid1TopLeftChanged(Sender: TObject);
begin
StringGrid1.Invalidate;
end;
end. |
