这类控件毕竟有商业用途的,不好开源,望谅解。参考我发布的其他控件,自己模仿着写一个吧。
不过我这个控件基本上已经提供了所有常用接口,比网上其他人提供的要大方的太多太多了。
下面公开测试程序,里面有相关接口的使用。
由于VB6对鼠标滚轮的支持不好,测试程序里使用了外挂式的方法用于支持鼠标滚轮。
建一个标准工程,部件中加载我的控件myList.ocx,窗体代码如下:
Private Sub Form_Load() prevWndProc = getwindowlong(Me.hWnd,GWL_WNDPROC) SetwindowLong Me.hWnd,GWL_WNDPROC,AddressOf WndProc MyList1.AddNode "好友" MyList1.AddNode "同事" MyList1.AddNode "陌生人" MyList1.AddNode "VB编程" MyList1.AddItem "张勇","asd1@163.com","本人很厉害!",0 MyList1.AddItem "张三","asd2@163.com","本人很嚣张!",0 MyList1.AddItem "李1","asd3@163.com","本人很疯狂!",1 MyList1.AddItem "李2","asd4@163.com",1 MyList1.AddItem "李3","asd5@163.com",1 MyList1.AddItem "李4","asd6@163.com",1 MyList1.AddItem "王1","asd7@163.com","本人很害怕!",2 MyList1.AddItem "王二","asd8@163.com",2 MyList1.AddItem "麻五","asd9@163.com","本人很害羞!",2 MyList1.AddItem "麻1","asd10@163.com",2 MyList1.AddItem "麻2","asd11@163.com",3 MyList1.AddItem "麻3","asd12@163.com",3 MyList1.AddItem "麻4","asd13@163.com",3 MyList1.AddItem "麻5","asd14@163.com",3 MyList1.AddItem "麻6","asd15@163.com",3 End SubPrivate Sub Form_Resize() MyList1.WIDth = Me.ScaleWIDth MyList1.Height = Me.ScaleHeightEnd SubPrivate Sub Form_Unload(Cancel As Integer) SetwindowLong Me.hWnd,prevWndProcEnd SubPrivate Sub MyList1_Click(ItemClass As Integer,Index As Integer) If ItemClass = 0 Then Call MyList1.Clickthe_Title(Index) End If End SubPrivate Sub MyList1_DblClick(Index As Integer,uTitle As String) MsgBox "双击了Item(" & Index & ")其名称为:" & uTitleEnd SubPrivate Sub MyList1_MouseDown(button As Integer,ItemClass As Integer,tIndex As Integer) MsgBox "右键,类别" & ItemClass & " 索引" & tIndexEnd SubPrivate Sub MyList1_MouseMove(ItemClass As Integer,tIndex As Integer) Call MyList1.MouseMv(ItemClass,tIndex)End Sub
由上面的代码可以看出,鼠标左键单击、双击、右键、鼠标移动等接口都已提供,够大方吧
另外请注意,头像使用内置图像,编号为0-36,或者是37吧。。。,就是myList.additem的最后一个参数
添加一个模块(用于控制鼠标滚轮),代码如下:
Option ExplicitPublic Const GWL_WNDPROC = -4Public Const WM_MOUSEWHEEL = &H20APublic prevWndProc As LongPublic Declare Function SetwindowLong lib "user32" Alias "SetwindowLongA" (ByVal hWnd As Long,ByVal nIndex As Long,ByVal DWNewLong As Long) As LongPublic Declare Function getwindowlong lib "user32" Alias "getwindowlongA" (ByVal hWnd As Long,ByVal nIndex As Long) As LongPublic Declare Function CallWindowProc lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long,ByVal hWnd As Long,ByVal Msg As Long,ByVal wParam As Long,ByVal lParam As Long) As LongPublic Function WndProc(ByVal hWnd As Long,ByVal uMsg As Long,ByVal lParam As Long) As Long If uMsg = WM_MOUSEWHEEL Then With Form1.MyList1 If wParam < 0 Then .VScrollWheel 100 Else .VScrollWheel -100 End If End With Else WndProc = CallWindowProc(prevWndProc,hWnd,uMsg,wParam,lParam) End IfEnd Function
上面的代码不想写的可以直接去下载,地址如下(只给真正需要的人,要分的哦,别,咱抗属性100%):
http://download.csdn.net/detail/icbyboy/4964369
总结以上是内存溢出为你收集整理的5、用VB6写的仿QQ列表控件全部内容,希望文章能够帮你解决5、用VB6写的仿QQ列表控件所遇到的程序开发问题。
如果觉得内存溢出网站内容还不错,欢迎将内存溢出网站推荐给程序员好友。
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)