Subversion Repositories userdetect2

Rev

Rev 81 | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
68 daniel-mar 1 
unit VTSListView;
2 
 
3 
interface
4 
 
5 
// This ListView adds support for sorting arrows
6 
 
7 
// Recommended usage for the OnCompare event:
8 
(*
9 
procedure TForm1.ListViewCompare(Sender: TObject; Item1,
10 
  Item2: TListItem; Data: Integer; var Compare: Integer);
11 
var
12 
  ListView: TVTSListView;
13 
begin
14 
  ListView := Sender as TVTSListView;
15 
  if ListView.CurSortedColumn = 0 then
16 
  begin
17 
    Compare := CompareText(Item1.Caption, Item2.Caption);
18 
  end
19 
  else
20 
  begin
21 
    Compare := CompareText(Item1.SubItems[ListView.CurSortedColumn-1],
22 
                           Item2.SubItems[ListView.CurSortedColumn-1]);
23 
  end;
24 
  if ListView.CurSortedDesc then Compare := -Compare;
25 
end;
26 
*)
27 
 
28 
uses
29 
  Windows, Messages, SysUtils, Classes, Controls, ComCtrls, CommCtrl;
30 
 
31 
type
32 
  TVTSListView = class(TListView)
33 
  private
34 
    FDescending: Boolean;
35 
    FSortedColumn: Integer;
36 
    procedure WMNotifyMessage(var msg: TWMNotify); message WM_NOTIFY;
37 
  protected
38 
    procedure ShowArrowOfListViewColumn;
39 
    procedure ColClick(Column: TListColumn); override;
40 
  public
41 
    constructor Create(AOwner: TComponent); override;
42 
  published
43 
    property CurSortedColumn: integer read FSortedColumn;
44 
    property CurSortedDesc: boolean read FDescending;
45 
  end;
46 
 
47 
procedure Register;
48 
 
49 
implementation
50 
 
51 
// The arrows require a XP Manifest
52 
 
53 
{$IF not Declared(HDF_SORTUP)}
54 
const
55 
  { For Windows >= XP }
56 
  {$EXTERNALSYM HDF_SORTUP}
57 
  HDF_SORTUP              = $0400;
58 
  {$EXTERNALSYM HDF_SORTDOWN}
59 
  HDF_SORTDOWN            = $0200;
60 
{$IFEND}
61 
 
62 
{ TVTSListView }
63 
 
64 
constructor TVTSListView.Create(AOwner: TComponent);
65 
begin
66 
  inherited;
67 
  FSortedColumn := -1;
68 
end;
69 
 
70 
procedure TVTSListView.ShowArrowOfListViewColumn;
71 
var
72 
  Header: HWND;
73 
  Item: THDItem;
74 
  i: integer;
75 
begin
76 
  Header := ListView_GetHeader(Handle);
77 
  ZeroMemory(@Item, SizeOf(Item));
78 
  Item.Mask := HDI_FORMAT;
79 
 
80 
  // Remove arrows
81 
  for i := 0 to Columns.Count-1 do
82 
  begin
83 
    Header_GetItem(Header, i, Item);
84 
    Item.fmt := Item.fmt and not (HDF_SORTUP or HDF_SORTDOWN);
85 
    Header_SetItem(Header, i, Item);
86 
  end;
87 
 
88 
  // Add arrow
89 
  Header_GetItem(Header, FSortedColumn, Item);
90 
  if FDescending then
91 
    Item.fmt := Item.fmt or HDF_SORTDOWN
92 
  else
93 
    Item.fmt := Item.fmt or HDF_SORTUP;
94 
  Header_SetItem(Header, FSortedColumn, Item);
95 
end;
96 
 
97 
procedure TVTSListView.WMNotifyMessage(var msg: TWMNotify);
98 
begin
77 daniel-mar 99 
  try
100 
    inherited;
101 
  except
102 
    // Workaround for Delphi 6, which raises an EAccessViolation in
103 
    // CallWindowProc at TWinControl.DefaultHandler, when the code executed
104 
    // on Windows Server 2008.
105 
  end;
68 daniel-mar 106 
  if (Msg.NMHdr^.code = HDN_ENDTRACK) and (FSortedColumn > -1) then
107 
  begin
108 
    ShowArrowOfListViewColumn;
109 
  end;
110 
end;
111 
 
112 
procedure TVTSListView.ColClick(Column: TListColumn);
113 
begin
114 
  if not Assigned(OnCompare) then Exit;
115 
  SortType := stNone;
116 
  if Column.Index <> FSortedColumn then
117 
  begin
118 
    FSortedColumn := Column.Index;
119 
    FDescending := False;
120 
  end
121 
  else
122 
  begin
123 
    FDescending := not FDescending;
124 
  end;
125 
  ShowArrowOfListViewColumn;
126 
  SortType := stText;
127 
  inherited;
128 
end;
129 
 
130 
procedure Register;
131 
begin
132 
  RegisterComponents('ViaThinkSoft', [TVTSListView]);
133 
end;
134 
 
135 
end.