Subversion Repositories userdetect2

Rev

Rev 68 | Rev 77 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed

  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
  99.   inherited;
  100.   if (Msg.NMHdr^.code = HDN_ENDTRACK) and (FSortedColumn > -1) then
  101.   begin
  102.     ShowArrowOfListViewColumn;
  103.   end;
  104. end;
  105.  
  106. procedure TVTSListView.ColClick(Column: TListColumn);
  107. begin
  108.   if not Assigned(OnCompare) then Exit;
  109.   SortType := stNone;
  110.   if Column.Index <> FSortedColumn then
  111.   begin
  112.     FSortedColumn := Column.Index;
  113.     FDescending := False;
  114.   end
  115.   else
  116.   begin
  117.     FDescending := not FDescending;
  118.   end;
  119.   ShowArrowOfListViewColumn;
  120.   SortType := stText;
  121.   inherited;
  122. end;
  123.  
  124. procedure Register;
  125. begin
  126.   RegisterComponents('ViaThinkSoft', [TVTSListView]);
  127. end;
  128.  
  129. end.
  130.