Author: Tomas Rutkauskas
Is there any way to sort columns in a TListView by date or time when a user clicks
on the header of the column?
Answer:
Solve 1:
LV1 is a TListView with vsReport.
1
2 function CustomDateSortProc(Item1, Item2: TListItem; ParamSort: integer): integer;
3 stdcall;
4 begin
5 result := 0;
6 if StrToDateTime(item1.SubItems[0]) > StrToDateTime(item2.SubItems[0]) then
7 Result := 1
8 else if StrToDateTime(item1.SubItems[0]) < StrToDateTime(item2.SubItems[0]) then
9 Result := -1;
10 end;
11
12 function CustomNameSortProc(Item1, Item2: TListItem; ParamSort: integer): integer;
13 stdcall;
14 begin
15 Result := CompareText(Item1.Caption, Item2.Caption);
16 end;
17
18 procedure TForm1.GetFilesClick(Sender: TObject);
19 var
20 sr: TSearchRec;
21 Item: TListItem;
22 begin
23 if FindFirst('e:\*.*', faAnyFile, sr) = 0 then
24 repeat
25 if (sr.Attr and faDirectory) <> sr.Attr then
26 begin
27 item := LV1.items.add;
28 item.Caption := sr.name;
29 Item.SubItems.Add(DateTimeToStr(filedatetodatetime(sr.time)));
30 end;
31 until
32 FindNext(sr) <> 0;
33 FindClose(sr);
34 end;
35
36 procedure TForm1.LV1ColumnClick(Sender: TObject; Column: TListColumn);
37 begin
38 if column = LV1.columns[0] then
39 LV1.CustomSort(@CustomNameSortProc, 0)
40 else
41 LV1.CustomSort(@CustomDateSortProc, 0)
42 end;
Solve 2:
Open a new Delphi application project. Drop a listview (ListView1) onto the default
form. Paste in the attached code. Hook up the FormCreate and ListView1ColumnClick
event handlers.
The custom sort procedure (and the callback) save the day. There are some limits
and drawbacks to this approach though. Since the listview is inherently unaware of
data types, you have to bolt that onto the outside. This extra thrashing can
represent a performance hit if you're doing something funky in the callback. This
example uses up the TListView.Tag, TListColumn.Tag and TListItem.Data properties.
This might clash with a scheme in place, or may sicken you because of its
bold-faced greed. This system only allows for single-column sorts. This can easily
be extended, though, by a reinterpretation of TListView.Tag into sort column_s_. No
graphics in the column headers.
43 unit Unit1;
44
45 interface
46
47 uses
48 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
49 ComCtrls;
50
51 type
52 TForm1 = class(TForm)
53 ListView1: TListView;
54 procedure FormCreate(Sender: TObject);
55 procedure ListView1ColumnClick(Sender: TObject; Column: TListColumn);
56 private
57 public
58 end;
59
60 var
61 Form1: TForm1;
62
63 implementation
64
65 {$R *.DFM}
66
67 function UnformatText(const Text: string; const VarType: Integer): Variant;
68 begin
69 {This is an ambitious function, in simple form. The standard text to type
70 variable conversion is fairly weak, so this function is a good place to
71 canonize that thinking.}
72 if Length(Text) = 0 then
73 Result := Null
74 else
75 begin
76 case VarType of
77 varBoolean:
78 if CompareText(Text, 'True') = 0 then
79 Result := True
80 else if CompareText(Text, 'False') = 0 then
81 Result := False
82 else if CompareText(Text, 'Yes') = 0 then
83 Result := True
84 else if CompareText(Text, 'No') = 0 then
85 Result := False
86 else
87 begin
88 Result := Null;
89 end;
90 else
91 {use the default handler}
92 Result := VarAsType(Text, VarType);
93 end;
94 end;
95 end;
96
97 function LVItemValue(const Item: TListItem; const Col, VarType: Integer): Variant;
98 begin
99 {get the indicated "cell's" text, return an empty string if either index is out
100 of range}
101 if Item = nil then
102 Result := Null
103 else if Col < 0 then
104 Result := Null
105 else if Col > Item.SubItems.Count then
106 Result := Null
107 else if Col = 0 then
108 Result := UnformatText(Item.Caption, VarType)
109 else
110 begin
111 Result := UnformatText(Item.SubItems[Col - 1], VarType);
112 end;
113 end;
114
115 function LVSort(lParam1, lParam2: Integer; lParamSort: Integer): Integer; stdcall;
116 const
117 NULL_COMPARE = -1; {-1 floats nulls to top, +1, to bottom}
118 var
119 oLV: TListView;
120 iSortCol: Integer;
121 bSortAsc: Boolean;
122 iSortVarType: Integer;
123 vData1: Variant;
124 vData2: Variant;
125 begin
126 try
127 {resolve the reference to the listview being sorted}
128 oLV := TListView(lParamSort);
129 {is "no sort" being requested?}
130 if oLV.Tag = 0 then
131 begin
132 {not a very economic use of the data property...}
133 Result := Integer(TListItem(lParam1).Data) - Integer(TListItem(lParam2).Data);
134 exit;
135 end;
136 iSortCol := Abs(oLV.Tag) - 1;
137 bSortAsc := oLV.Tag >= 0;
138 {determine the data type}
139 if iSortCol < 0 then
140 iSortVarType := varString
141 else if iSortCol >= oLV.Columns.Count then
142 iSortVarType := varString
143 else
144 begin
145 iSortVarType := oLV.Columns[iSortCol].Tag;
146 end;
147 {get the data of interest}
148 vData1 := LVItemValue(TListItem(lParam1), iSortCol, iSortVarType);
149 vData2 := LVItemValue(TListItem(lParam2), iSortCol, iSortVarType);
150 {do some "null" handling that supercedes typed comparisons}
151 if VarIsNull(vData1) and VarIsNull(vData2) then
152 Result := 0 {they're both null}
153 else if VarIsNull(vData1) then
154 Result := NULL_COMPARE
155 else if VarIsNull(vData2) then
156 Result := -NULL_COMPARE
157 else if vData1 > vData2 then
158 Result := 1
159 else if vData1 < vData2 then
160 Result := -1
161 else
162 begin
163 Result := 0;
164 end;
165 if not bSortAsc then
166 Result := -Result;
167 except
168 Result := 0;
169 end;
170 end;
171
172 procedure TForm1.FormCreate(Sender: TObject);
173
174 function RandomNull(const Text: string): string;
175 begin
176 if Random(8) < 1 then
177 Result := ''
178 else
179 begin
180 Result := Text;
181 end;
182 end;
183
184 var
185 oCol: TListColumn;
186 oItem: TListItem;
187 iItem: Integer;
188 begin
189 Randomize;
190 {set listview properties}
191 with ListView1 do
192 begin
193 Items.Clear;
194 Columns.Clear;
195 Align := alClient;
196 ReadOnly := True;
197 SortType := stNone;
198 Tag := 0;
199 ViewStyle := vsReport;
200 end;
201 {default columns of different types}
202 oCol := ListView1.Columns.Add;
203 oCol.Caption := 'varDate';
204 oCol.Tag := varDate;
205 oCol.Width := 100;
206 oCol := ListView1.Columns.Add;
207 oCol.Caption := 'varBoolean';
208 oCol.Tag := varBoolean;
209 oCol.Width := 100;
210 oCol := ListView1.Columns.Add;
211 oCol.Caption := 'varInteger';
212 oCol.Tag := varInteger;
213 oCol.Width := 100;
214 oCol := ListView1.Columns.Add;
215 oCol.Caption := 'varCurrency';
216 oCol.Tag := varCurrency;
217 oCol.Width := 100;
218 oCol := ListView1.Columns.Add;
219 oCol.Caption := 'varString';
220 oCol.Tag := varString;
221 oCol.Width := 100;
222 {add items to the listview}
223 for iItem := 0 to 100 + Random(100) do
224 begin
225 {data property stores "original index" info}
226 oItem := ListView1.Items.Add;
227 oItem.Data := Pointer(iItem); {using this more like a Tag property}
228 {plug in some fake data}
229 oItem.Caption := RandomNull(FormatDateTime('dd-mmm-yyyy', Now() -
230 Random(1000)));
231 if Random(2) < 1 then
232 oItem.SubItems.Add(RandomNull('Yes'))
233 else
234 begin
235 oItem.SubItems.Add(RandomNull('No'));
236 end;
237 oItem.SubItems.Add(RandomNull(FloatToStr(0.01 * Random(100000))));
238 oItem.SubItems.Add(RandomNull(IntToStr(Random(10000))));
239 oItem.SubItems.Add(RandomNull(Char(65 + Random(26)) + Char(65 + Random(26)) +
240 Char(65 + Random(26)) + Char(65 + Random(26)) + Char(65 + Random(26))));
241 end;
242 end;
243
244 procedure TForm1.ListView1ColumnClick(Sender: TObject; Column: TListColumn);
245 begin
246 {sort the sort column and order into the listview's tag}
247 if ListView1.Tag = Column.Index + 1 then
248 ListView1.Tag := -ListView1.Tag {desc sort}
249 else if ListView1.Tag = -(Column.Index + 1) then
250 ListView1.Tag := 0 {no sort}
251 else
252 begin
253 ListView1.Tag := Column.Index + 1; {asc sort}
254 end;
255 {pass the listview such that it will be sent to the sort procedure}
256 ListView1.CustomSort(LVSort, Integer(ListView1));
257 end;
258
259 end.
|
