这类控件毕竟有商业用途的,不好开源,望谅解。参考我发布的其他控件,自己模仿着写一个吧。
不过我这个控件基本上已经提供了所有常用接口,比网上其他人提供的要大方的太多太多了。
下面公开测试程序,里面有相关接口的使用。
由于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 Sub Private Sub Form_Resize() MyList1.Width = Me.ScaleWidth MyList1.Height = Me.ScaleHeight End Sub Private Sub Form_Unload(Cancel As Integer) SetWindowLong Me.hWnd,prevWndProc End Sub Private Sub MyList1_Click(ItemClass As Integer,Index As Integer) If ItemClass = 0 Then Call MyList1.Clickthe_Title(Index) End If End Sub Private Sub MyList1_DblClick(Index As Integer,uTitle As String) MsgBox "双击了Item(" & Index & ")其名称为:" & uTitle End Sub Private Sub MyList1_MouseDown(Button As Integer,ItemClass As Integer,tIndex As Integer) MsgBox "右键,类别" & ItemClass & " 索引" & tIndex End Sub Private Sub MyList1_MouseMove(ItemClass As Integer,tIndex As Integer) Call MyList1.MouseMv(ItemClass,tIndex) End Sub
由上面的代码可以看出,鼠标左键单击、双击、右键、鼠标移动等接口都已提供,够大方吧
另外请注意,头像使用内置图像,编号为0-36,或者是37吧。。。,就是mylist.additem的最后一个参数
Option Explicit Public Const GWL_WNDPROC = -4 Public Const WM_MOUSEWHEEL = &H20A Public prevWndProc As Long Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long,ByVal nIndex As Long,ByVal dwNewLong As Long) As Long Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long,ByVal nIndex As Long) As Long Public 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 Long Public 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 If End Function原文链接:https://www.f2er.com/vb/259258.html