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
|
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, StdCtrls;
type
TSortOrder = (soNone, soUp, soDown);
TForm1 = class(TForm)
StringGrid1: TStringGrid;
procedure StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
FSortedCol: Integer;
FSortOrder: TSortOrder;
procedure SetSortedCol(const Value: Integer);
procedure SetSortOrder(const Value: TSortOrder);
public
{ Public declarations }
procedure Sort;
property SortOrder: TSortOrder read FSortOrder write SetSortOrder;
property SortedCol: Integer read FSortedCol write SetSortedCol;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
// On définit un type de fonction de comparaison qui sera utilisée
// par la fonction de tri
TCellCompare = function (const AStringGrid: TStringGrid;
const SortOrder: TSortOrder;
const Column, Index1, Index2: Integer): Integer;
{ Notre fonction de comparaison pour une cellule }
function CellCompare(const AStringGrid: TStringGrid;
const SortOrder: TSortOrder;
const Column, Index1, Index2: Integer): Integer;
begin
// Si vous voulez ne pas tenir compte de la casse, utilisez AnsiCompareText
// au lieu de AnsiCompareStr
with AStringGrid do
case SortOrder of
soUp: result:= AnsiCompareStr(Cells[Column, Index1], Cells[Column, Index2]);
soDown: result:= AnsiCompareStr(Cells[Column, Index2], Cells[Column, Index1]);
else
result:= 0;
end;
end;
{ La fonction de tri proprement dite : un tri rapide (Quick Sort) }
procedure QuickSort(const AStringGrid: TStringGrid;
const SortOrder: TSortOrder;
const Column: Integer; L, R: Integer; SCompare: TCellCompare);
{ Il nous faut une fonction pour échanger les lignes }
procedure ExchangeItems(Index1, Index2: Integer);
var
s: string;
begin
// On utilise la propriété Rows qui nous retourne la ligne entière
s:= AStringGrid.Rows[Index1].Text;
AStringGrid.Rows[Index1].Text:= AStringGrid.Rows[Index2].Text;
AStringGrid.Rows[Index2].Text:= s;
end;
var
I, J, P: Integer;
begin
repeat
I := L;
J := R;
P := (L + R) shr 1;
repeat
while SCompare(AStringGrid, SortOrder, Column, I, P) < 0 do Inc(I);
while SCompare(AStringGrid, SortOrder, Column, J, P) > 0 do Dec(J);
if I <= J then
begin
ExchangeItems(I, J);
if P = I then
P := J
else if P = J then
P := I;
Inc(I);
Dec(J);
end;
until I > J;
if L < J then QuickSort(AStringGrid, SortOrder, Column, L, J, SCompare);
L := I;
until I >= R;
end;
{ TForm1 }
procedure TForm1.SetSortedCol(const Value: Integer);
begin
if Value <> FSortedCol then
begin
FSortedCol := Value;
Sort;
end;
end;
procedure TForm1.SetSortOrder(const Value: TSortOrder);
begin
if Value <> FSortOrder then
begin
FSortOrder := Value;
Sort;
end;
end;
procedure TForm1.Sort;
begin
Screen.Cursor:= crHourGlass;
try
// Appel de la fonction de tri avec la grille, le type de tri, l'indice de
// la colonne à trier, les indices de premier et dernier élément et la
// fonction de comparaison
QuickSort(StringGrid1, FSortOrder, FSortedCol,
1, StringGrid1.RowCount - 1, CellCompare);
finally
Screen.Cursor:= crDefault;
end;
end;
{ L'événement OnMouseUp de la grille nous permet de détecter un clic dans
un entête de colonne. }
procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
{ Une fonction qui nous sert à déterminer le type de tri en fonction
du type de tri actuel. }
function InvertSort(ASortOrder: TSortOrder): TSortOrder;
begin
case ASortOrder of
soUp: result:= soDown;
soDown: result:= soUp;
else
result:= soUp;
end;
end;
var
gridCoord: TGridCoord;
begin
with Sender as TStringGrid do
begin
// On récupère la cellule dans laquelle le click a eu lieu
gridCoord:= MouseCoord(X, Y);
// On teste si c'est bien un entête de colonne éditable
if (gridCoord.Y < StringGrid1.FixedCols) and
(gridCoord.X >= StringGrid1.FixedRows) then
begin
// Si on a cliqué sur une colonne déja triée on inverse le type de tri
if gridCoord.X = FSortedCol then
FSortOrder:= InvertSort(FSortOrder)
else
// Sinon, on tri par ordre ascendant
begin
FSortedCol:= gridCoord.X;
FSortOrder:= soUp;
end;
// L'appel à la méthode de tri
Sort;
end;
end;
end;
end. |
