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 "张勇","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

上面的代码不想写的可以直接去下载，地址如下（只给真正需要的人，要分的哦，别，咱抗属性100%）：

http://download.csdn.net/detail/icbyboy/4964369

原文地址：https://www.jb51.cc/vb/259258.html

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

相关推荐