{
似乎很多人都需要这个。
Delphi自带的listview无法在排序时自动加上箭头。
如果设置Column[I].ImageIndex = a,箭头会出现在文字左边,
需要修改ComCtrls.pas才能使图片出现在右边。
并且TListItem的Caption项会自动加上图标,
没有图标则留出一个空白,非常难看。
这个修改过的控件解决了这些问题。
这个控件需要从资源文件中装载两个箭头图片,你需要自己制作。
或者下载SJListview,里面有SJListview.res资源文件。
}
{*******************************************************}
{ }
{ ComponentName : SJListView }
{ Version : 2.2a }
{ Author : SJ(小笨苯) }
{ E_Mail : taibenle@163.com }
{ Last Modified : 2002-5-15 }
{ History : }
{ 修改 : 2004-12-25 afan }
{ }
{*******************************************************}
unit SJListView;
interface
uses
Windows, Messages, SysUtils, Classes, ComCtrls, Commctrl, WinSock;
type
TListView2 = class(TListView)
private
{ Private declarations }
ArrowUp : HBitMap;
ArrowDown : HBitMap;
CurColumn: integer;
vHandle: HWND;
procedure SetHeaderBitmap(Col: integer);//画Header
protected
{ Protected declarations }
//procedure WndProc(var Msg : TMessage); override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
procedure CreateWnd; override;
destructor Destroy; override;
published
{ Published declarations }
end;
type
TMainListview = class(TListview2)
protected
procedure WndProc(var Msg: TMessage); override;
end;
type
TMyListview = class(TListview2)
protected
procedure WndProc(var Msg: TMessage); override;
end;
procedure Register;
implementation
{R SJListView.res}
{ 通用排序函数 }
Function CustomSortProc( Item1, Item2 : TListItem; lParam : LongInt
: Integer; stdcall;begin
Result:=0;
if (Item1=nil)or(Item2=nil)then
exit;
if lParam = 0 then
result := CompareText(Item1.Caption,Item2.Caption
else if lparam > 0 then
result := CompareText(Item1.SubItems[Lparam-1],Item2.SubItems[Lparam-1]);
Result:= Result * Item1.ListView.Column[lParam].Tag ;
end;
//验证合法ip地址
function ValidateIP(const ip:string):boolean;
var
i,dotnum: byte;
begin
Result:=false;
if ip = '' then
exit;
dotnum:= 0;
for I:=1 to Length(ip) do
if ip[I] = '.' then
inc(dotnum);
if dotnum <> 3 then
exit;
if (ip='255.255.255.255')or(inet_Addr(pchar(ip))<>Inaddr_none) then
result:=true
else
result:=false;
end;
function CustomSortProcMain( Item1, Item2 : TListItem; lParam : LongInt
: Integer; stdcall;var
ip1,ip2:cardinal;
s1,s2:String;
begin
Result:=0;
if (Item1=nil)or(Item2=nil)then
exit;
if lParam = 0 then
result := CompareText(Item1.Caption,Item2.Caption
else if lparam =2 then begin
s1:=Item1.SubItems[1];
s2:=Item2.SubItems[1];
if ValidateIP(s1) and ValidateIP(s2) then begin
ip1:=htonl(inet_addr(pchar(s1)));
ip2:=htonl(inet_addr(pchar(s2)));
if ip1 > Ip2 then
Result:= 1 else
if ip1 = ip2 then
result:=0 else
result:=-1;
end
else
result:= CompareText(s1,s2);
end
else
result := CompareText(Item1.SubItems[Lparam-1],Item2.SubItems[Lparam-1]) ;
Result:= Result * Item1.ListView.Column[lParam].Tag ;
end;
constructor TListview2.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ArrowUp := LoadImage(hInstance, 'ArrowUp', IMAGE_BITMAP, 0, 0, LR_LOADMAP3DCOLORS);
ArrowDown := LoadImage(hInstance, 'ArrowDown', IMAGE_BITMAP, 0, 0, LR_LOADMAP3DCOLORS);
//SetHeaderBitmap;
end;
procedure TListview2.CreateWnd;
begin
inherited CreateWnd;
if HandleAllocated then HandleNeeded;
vHandle := ListView_GetHeader(Handle);
end;
destructor TListview2.Destroy;
begin
DeleteObject(ArrowUp);
DeleteObject(ArrowDown);
inherited Destroy;
end;
procedure TListview2.SetHeaderBitmap(Col: integer);
var
HdItem : THdItem;
begin
FillChar(HdItem, SizeOf(HdItem), #0);
HdItem.Mask := HDI_FORMAT;
Header_GetItem(vHandle, Col, HdItem);
HdItem.Mask := HDI_BITMAP or HDI_FORMAT;
if Column[Col].Tag = -1 then begin { 反向 }
HdItem.fmt := HdItem.fmt or HDF_BITMAP or HDF_BITMAP_ON_RIGHT;
HdItem.hbm := LoadImage(hInstance, 'ArrowDown', IMAGE_BITMAP, 0, 0, LR_LOADMAP3DCOLORS);
end
else if Column[Col].Tag = 1 then begin { 正向 }
HdItem.fmt := HdItem.fmt or HDF_BITMAP or HDF_BITMAP_ON_RIGHT;
HdItem.hbm := LoadImage(hInstance, 'ArrowUp', IMAGE_BITMAP, 0, 0, LR_LOADMAP3DCOLORS);
end
else if Column[Col].Tag = 0 then begin{ 消除箭头 }
HdItem.fmt := HdItem.fmt and not (HDF_BITMAP or HDF_BITMAP_ON_RIGHT);
HdItem.hbm := 0;
end;
Header_SetItem(vHandle, Col, HdItem);
end;
(*
procedure TListview2.WndProc(var Msg : TMessage);
var
pHD : PHDNotify;
i: integer;
begin
inherited WndProc(Msg);
if Msg.Msg = WM_NOTIFY then //如果截获的消息是WM_NOTIFY
begin
pHD := PHDNotify(Msg.LParam);
HwndFrom:= pHD.Hdr.hwndFrom ;
if (hwndFrom = vHandle) and (vHandle <> 0) then begin
wmCode:= 0;
Case pHD.HDr.code of
{ 如果是点击Header }
HDN_ITEMCLICK,HDN_ITEMCLICKW:
begin
CurColumn := Columns.Items[pHD.item].Index;
wmCode:= pHD.Hdr.code ;
{ 做标记,正向或反向排序 }
for i:= 0 to Columns.Count - 1 do begin
if I = CurColumn then begin
if Column[I].Tag = 0 then
Column[I].Tag := 1
else
Column[I].Tag := -1 * Column[I].Tag ;
SetHeaderBitmap(I);
end
else begin
if Column[I].Tag <> 0 then begin
Column[I].Tag := 0;
SetHeaderBitmap(I);
end;
end;
end; {of FOR}
{ 排序 }
//CustomSort(@CustomSortProc, CurColumn);
end;
{ 拖动改变宽度时,ColumnItem <> 原来排序的列 }
HDN_ENDTRACK,HDN_ENDTRACKW:
Begin
CurColumn:= Columns.Items[pHD.item].Index;
if Columns[CurColumn].Tag <> 0 then
SetHeaderBitmap(CurColumn);
end;
end;
end;
end;
end;
*)
Procedure TMyListview.WndProc(var Msg: TMessage);
var
pHD : PHDNotify;
i: integer;
begin
inherited WndProc(Msg);
if Msg.Msg = WM_NOTIFY then //如果截获的消息是WM_NOTIFY
begin
pHD := PHDNotify(Msg.LParam);
if (pHD.Hdr.hwndFrom = vHandle) and (vHandle <> 0) then begin
Case pHD.HDr.code of
{ 如果是点击Header }
HDN_ITEMCLICK,HDN_ITEMCLICKW:
begin
CurColumn := Columns.Items[pHD.item].Index;
{ 做标记,正向或反向排序 }
for i:= 0 to Columns.Count - 1 do begin
if I = CurColumn then begin
if Column[I].Tag = 0 then
Column[I].Tag := 1
else
Column[I].Tag := -1 * Column[I].Tag ;
SetHeaderBitmap(I);
end
else begin
if Column[I].Tag <> 0 then begin
Column[I].Tag := 0;
SetHeaderBitmap(I);
end;
end;
end; {of FOR}
{ 排序 }
CustomSort(@CustomSortProc, CurColumn);
end;
{ 拖动改变宽度时,ColumnItem <> 原来排序的列 }
HDN_ENDTRACK,HDN_ENDTRACKW:
Begin
CurColumn:= Columns.Items[pHD.item].Index;
if Columns[CurColumn].Tag <> 0 then
SetHeaderBitmap(CurColumn);
end;
end;
end;
end;
end;
procedure TMainListview.WndProc(var Msg: TMessage);
var
pHD : PHDNotify;
i: integer;
begin
inherited WndProc(Msg);
if Msg.Msg = WM_NOTIFY then //如果截获的消息是WM_NOTIFY
begin
pHD := PHDNotify(Msg.LParam);
if (pHD.Hdr.hwndFrom = vHandle) and (vHandle <> 0) then begin
Case pHD.HDr.code of
{ 如果是点击Header }
HDN_ITEMCLICK,HDN_ITEMCLICKW:
begin
CurColumn := Columns.Items[pHD.item].Index;
{ 做标记,正向或反向排序 }
for i:= 0 to Columns.Count - 1 do begin
if I = CurColumn then begin
if Column[I].Tag = 0 then
Column[I].Tag := 1
else
Column[I].Tag := -1 * Column[I].Tag ;
SetHeaderBitmap(I);
end
else begin
if Column[I].Tag <> 0 then begin
Column[I].Tag := 0;
SetHeaderBitmap(I);
end;
end;
end; {of FOR}
{ 排序 }
CustomSort(@CustomSortProcMain, CurColumn);
end;
{ 拖动改变宽度时,ColumnItem <> 原来排序的列 }
HDN_ENDTRACK,HDN_ENDTRACKW:
Begin
CurColumn:= Columns.Items[pHD.item].Index;
if Columns[CurColumn].Tag <> 0 then
SetHeaderBitmap(CurColumn);
end;
end;
end;
end;
end;
procedure Register;
begin
RegisterComponents('Win32', [TMainListView, TMyListview]);
end;
end.