分享
 
 
 

Listview控件 -- 改良版,带箭头自动排序

王朝delphi·作者佚名  2006-01-09
窄屏简体版  字體: |||超大  

{

似乎很多人都需要这个。

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.

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有