5、用VB6写的仿QQ列表控件

这类控件毕竟有商业用途的，不好开源，望谅解。参考我发布的其他控件，自己模仿着写一个吧。

不过我这个控件基本上已经提供了所有常用接口，比网上其他人提供的要大方的太多太多了。

下面公开测试程序，里面有相关接口的使用。

由于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 "张勇", "[e-mail]", "本人很厉害！", 0    MyList1.AddItem "张三", "[e-mail]", "本人很嚣张！", 0    MyList1.AddItem "李1", "[e-mail]", "本人很疯狂！", 1    MyList1.AddItem "李2", "[e-mail]", "本人很疯狂！", 1    MyList1.AddItem "李3", "[e-mail]", "本人很疯狂！", 1    MyList1.AddItem "李4", "[e-mail]", "本人很疯狂！", 1    MyList1.AddItem "王1", "[e-mail]", "本人很害怕！", 2    MyList1.AddItem "王二", "[e-mail]", "本人很害怕！", 2    MyList1.AddItem "麻五", "[e-mail]", "本人很害羞！", 2    MyList1.AddItem "麻1", "[e-mail]", "本人很害羞！", 2    MyList1.AddItem "麻2", "[e-mail]", "本人很害羞！", 3    MyList1.AddItem "麻3", "[e-mail]", "本人很害羞！", 3    MyList1.AddItem "麻4", "[e-mail]", "本人很害羞！", 3    MyList1.AddItem "麻5", "[e-mail]", "本人很害羞！", 3    MyList1.AddItem "麻6", "[e-mail]", "本人很害羞！", 3        End SubPrivate Sub Form_Resize()    MyList1.Width = Me.ScaleWidth    MyList1.Height = Me.ScaleHeightEnd SubPrivate Sub Form_Unload(Cancel As Integer)    SetWindowLong Me.hWnd, GWL_WNDPROC, 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 wParam 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