VB 重写checkbox类，实现多选

关于checkbox的多选，效果图如下

在这里插入代码片

Imports System.ComponentModel
Imports System.Data
Imports System.Linq
Imports System.Reflection
Imports Newtonsoft.Json.Linq

Public Class ComboBoxEx
Inherits ComboBox
Private lst As New TreeView()
Private _text As String
'当text改变时，触发重写事件
Public Overrides Property Text As String
Get
Return _text
End Get
Set
_text = Value
WndProc(Message.Create(Me.Handle, &HF, 0, 0))
End Set
End Property

Public Sub New()
    Me.DrawMode = DrawMode.OwnerDrawFixed
    '只有设置这个属性为OwnerDrawFixed才可能让重画起作用
    AddHandler lst.KeyUp, AddressOf lst_KeyUp  '按下
    AddHandler lst.MouseUp, AddressOf lst_MouseUp  '勾选
    AddHandler lst.Leave, AddressOf lst_MouseLeave '离开选择项的时候，自动隐藏
    AddHandler Me.MouseLeave, AddressOf lst_MouseLeave '离开选择项的时候，自动隐藏
    AddHandler Me.Leave, AddressOf Me_Leave '离开选择项的时候，自动隐藏
    'C#的写法
    'lst.KeyUp += New KeyEventHandler(AddressOf lst_KeyUp)
    'lst.MouseUp += New MouseEventHandler(AddressOf lst_MouseUp)
    'lst.Leave += New EventHandler(AddressOf lst_Leave)
    lst.CheckBoxes = True
    lst.ShowLines = False
    lst.ShowPlusMinus = False
    lst.ShowRootLines = False
    Me.DropDownHeight = 1
End Sub

#Region “自定义逻辑方法”
'按下键盘时
Private Sub lst_KeyUp(sender As Object, e As KeyEventArgs)
Me.OnKeyUp(e)
End Sub

'记录第一个选择框的状态
Private fristCheck As Boolean = False




'鼠标点击时
Private Sub lst_MouseUp(sender As Object, e As MouseEventArgs)
    Try
        Me.Text = ""
        If lst.Nodes(0).Checked = fristCheck Then
            For i As Integer = 1 To lst.Nodes.Count - 1
                If lst.Nodes(i).Checked Then
                    If Me.Text <> "" Then
                        Me.Text += ","
                    End If
                    Me.Text += lst.Nodes(i).Tag.ToString()
                End If
            Next
        Else
            If lst.Nodes(0).Checked = True Then
                For i As Integer = 1 To lst.Nodes.Count - 1
                    lst.Nodes(i).Checked = True
                    If Me.Text <> "" Then
                        Me.Text += ","
                    End If
                    Me.Text += lst.Nodes(i).Tag.ToString()
                Next
            Else
                For i As Integer = 1 To lst.Nodes.Count - 1
                    lst.Nodes(i).Checked = False
                    Me.Text = ""
                Next
            End If
            fristCheck = lst.Nodes(0).Checked
        End If
    Catch
        Me.Text = ""
    End Try
End Sub
'鼠标离开lst时
Private Sub lst_MouseLeave(sender As Object, e As EventArgs)
    lst.Hide()
    Me.DroppedDown = False
    'WndProc(Message.Create(Me.Handle, &HF, 0, 0))
End Sub

Private Sub Me_Leave(sender As Object, e As EventArgs)
    If Me.Focused Or lst.Focused Then
        Return
    End If
    lst.Hide()
    Me.DroppedDown = False
    WndProc(Message.Create(Me.Handle, &HF, 0, 0))
End Sub

#End Region

Public Sub TreeViewHide()
    lst.Hide()
    Me.DroppedDown = False
End Sub
Public Sub TreeViewShow()
    lst.Show()
    Me.DroppedDown = True
End Sub

#Region “Property”

<Description("选定项的值"), Category("Data")>
Public ReadOnly Property SelectedItems() As List(Of TreeNode)
    Get
        Dim lsttn As New List(Of TreeNode)()
        For Each tn As TreeNode In lst.Nodes
            If tn.Checked Then
                lsttn.Add(tn)
            End If
        Next
        Return lsttn
    End Get
End Property

''' <summary>
''' 数据源
''' </summary>
<Description("数据源"), Category("Data")>
Public Overloads Property DataSource() As Object
    Get
        Return m_DataSource
    End Get
    Set
        m_DataSource = Value
    End Set
End Property
Private m_DataSource As Object
''' <summary>
''' 显示字段
''' </summary>
<Description("显示字段"), Category("Data")>
Public Property DisplayMember() As String
    Get
        Return m_DisplayMember
    End Get
    Set
        m_DisplayMember = Value
    End Set
End Property
Private m_DisplayMember As String
''' <summary>
''' 值字段
''' </summary>
<Description("值字段"), Category("Data")>
Public Property ValueFiled() As String
    Get
        Return m_ValueFiled
    End Get
    Set
        m_ValueFiled = Value
    End Set
End Property
Private m_ValueFiled As String

#End Region

Public Sub DataBind()
    Me.BeginUpdate()
    If DataSource IsNot Nothing Then
        If TypeOf DataSource Is IDataReader Then
            Dim dataTable As New DataTable()
            dataTable.Load(TryCast(DataSource, IDataReader))

            DataBindToDataTable(dataTable)
        ElseIf TypeOf DataSource Is DataView OrElse TypeOf DataSource Is DataSet OrElse TypeOf DataSource Is DataTable Then
            Dim dataTable As DataTable = Nothing

            If TypeOf DataSource Is DataView Then
                dataTable = DirectCast(DataSource, DataView).ToTable()
            ElseIf TypeOf DataSource Is DataSet Then
                dataTable = DirectCast(DataSource, DataSet).Tables(0)
            Else
                dataTable = DirectCast(DataSource, DataTable)
            End If

            DataBindToDataTable(dataTable)
        ElseIf TypeOf DataSource Is IEnumerable Then
            DataBindToEnumerable(DirectCast(DataSource, IEnumerable))
        Else
            Throw New Exception("DataSource doesn't support data type: " + DataSource.[GetType]().ToString())
        End If
    Else
        lst.Nodes.Clear()
    End If

    lst.ItemHeight = Me.ItemHeight
    lst.BorderStyle = BorderStyle.FixedSingle
    lst.Size = New Size(Me.DropDownWidth, Me.ItemHeight * (Me.MaxDropDownItems - 1) - CInt(Me.ItemHeight) / 2)
    lst.Location = New Point(Me.Left, Me.Top + Me.ItemHeight + 6)
    Me.Parent.Controls.Add(lst)
    lst.Hide()
    Me.EndUpdate()
End Sub


Private Sub DataBindToDataTable(dt As DataTable)
    lst.Nodes.Clear()
    Dim tnz As New TreeNode()
    tnz.Text = "全选/全不选"
    tnz.Tag = "全选/全不选"
    tnz.Checked = False
    lst.Nodes.Add(tnz)
    For Each dr As DataRow In dt.Rows
        Dim tn As New TreeNode()
        If Not String.IsNullOrEmpty(DisplayMember) AndAlso Not String.IsNullOrEmpty(ValueFiled) Then
            tn.Text = dr(DisplayMember).ToString()
            tn.Tag = dr(ValueFiled).ToString()
        ElseIf String.IsNullOrEmpty(ValueFiled) Then
            tn.Text = dr(DisplayMember).ToString()
            tn.Tag = dr(DisplayMember).ToString()
        ElseIf String.IsNullOrEmpty(DisplayMember) Then
            tn.Text = dr(ValueFiled).ToString()
            tn.Tag = dr(ValueFiled).ToString()
        Else
            Throw New Exception("ValueFiled和DisplayFiled至少保证有一项有值")
        End If
        tn.Checked = False
        lst.Nodes.Add(tn)
    Next
End Sub

''' <summary>
''' 绑定到可枚举类型
''' </summary>
''' <param name="enumerable">可枚举类型</param>
Private Sub DataBindToEnumerable(enumerable As IEnumerable)
    Dim enumerator As IEnumerator = enumerable.GetEnumerator()
    While enumerator.MoveNext()
        Dim currentObject As Object = enumerator.Current
        lst.Nodes.Add(CreateListItem(currentObject))
    End While
End Sub



Private Function CreateListItem(obj As [Object]) As TreeNode
    Dim item As New TreeNode()

    If TypeOf obj Is String Then
        item.Text = obj.ToString()
        item.Tag = obj.ToString()
    Else
        If DisplayMember <> "" Then
            item.Text = GetPropertyValue(obj, DisplayMember)
        Else
            item.Text = obj.ToString()
        End If

        If ValueFiled <> "" Then
            item.Tag = GetPropertyValue(obj, ValueFiled)
        Else
            item.Tag = obj.ToString()
        End If
    End If
    Return item
End Function


Private Function GetPropertyValue(obj As Object, propertyName As String) As String
    Dim result As Object = Nothing
    result = ObjectUtil.GetPropertyValue(obj, propertyName)
    Return If(result Is Nothing, [String].Empty, result.ToString())
End Function

#Region “override”

Protected Overrides Sub OnKeyUp(e As KeyEventArgs)
    MyBase.OnKeyDown(e)
    'Dim Pressed As Boolean = (e.Control And (e.KeyData = Keys.Space))
    If e.KeyData = Keys.Space Then
        Me.Text = ""
        For i As Integer = 0 To lst.Nodes.Count - 1
            If lst.Nodes(i).Checked = True Then
                If Me.Text <> "" Then
                    Me.Text += ","
                End If
                Me.Text += lst.Nodes(i).Tag
            End If
        Next
    End If
End Sub

Protected Overrides Sub OnMouseDown(e As MouseEventArgs)
    lst.Font = Me.Font
    'Me.DroppedDown = False
End Sub

Protected Overrides Sub OnMouseUp(e As MouseEventArgs)
    'Me.DroppedDown = False
    'Me.Focus()
End Sub

Protected Overrides Sub OnDropDown(e As EventArgs)
    If lst.Visible Then
        lst.Hide()
        Return
    End If
    Dim strValue As String = Me.Text
    If Not String.IsNullOrEmpty(strValue) Then
        Dim lstvalues As List(Of String) = strValue.Split(","c).ToList()
        For Each tn As TreeNode In lst.Nodes
            If tn.Checked AndAlso Not lstvalues.Contains(tn.Tag.ToString()) AndAlso Not String.IsNullOrEmpty(tn.Tag.ToString().Trim()) Then
                tn.Checked = False
            ElseIf Not tn.Checked AndAlso lstvalues.Contains(tn.Tag.ToString()) AndAlso Not String.IsNullOrEmpty(tn.Tag.ToString().Trim()) Then
                tn.Checked = True
            End If
        Next
        lst.Nodes(0).Checked = fristCheck
    End If
    lst.BringToFront()
    lst.Show()
End Sub


''' <summary>
''' 这是调用了window内部的方法，可以理解为C++里面的 include<windos.h> ,但这里只包含了 windos.h 里面的两个方法 GetWindowDC 和 ReleaseDC
''' </summary>
''' <param name="hWnd"></param>
''' <returns></returns>
<System.Runtime.InteropServices.DllImport("user32.dll ")>
Private Shared Function GetWindowDC(hWnd As IntPtr) As IntPtr
End Function
<System.Runtime.InteropServices.DllImport("user32.dll ")>
Private Shared Function ReleaseDC(hWnd As IntPtr, hDC As IntPtr) As Integer
End Function

''' <summary>
''' 重绘text
''' </summary>
''' <param name="m"></param>
Protected Overrides Sub WndProc(ByRef m As Message)
    MyBase.WndProc(m)
    If m.Msg = &HF OrElse m.Msg = &H133 Then
        Dim hDC As IntPtr = GetWindowDC(m.HWnd)
        If hDC.ToInt32() = 0 Then
            Return
        End If
        Dim g As Graphics = Graphics.FromHdc(hDC)
        '画边框 
        Dim rect As New Rectangle(0, 5, Width - 12, Height)

        '画坚经
        'Dim rect1 As New Rectangle(Width - Height, 0, Height, Height)
        'ControlPaint.DrawBorder(g, rect, Color.Red, ButtonBorderStyle.Solid)
        'ControlPaint.DrawBorder(g, rect1, Color.Red, ButtonBorderStyle.Solid)
        'g.Clear(Color.Gray)
        Dim font As Font = New Font("Verdana", 9, FontStyle.Regular)
        g.DrawLine(New Pen(Color.White, Height - 5), 1, Convert.ToSingle(Height / 2), Width - 18, Convert.ToSingle(Height / 2))
        g.DrawString(Text, font, New SolidBrush(Color.Black), rect, StringFormat.GenericDefault)
        g.Dispose()
        'ControlPaint.DrawStringDisabled(g, Text, font, Color.Black, rect, StringFormat.GenericDefault)
        'ReleaseDC(m.HWnd, hDC)
    End If
End Sub

#End Region

End Class

‘’’
‘’’ 对象帮助类
‘’’
Public Class ObjectUtil
‘’’
‘’’ 获取对象的属性值
‘’’
‘’’ 可能是DataRowView或一个对象
‘’’ 属性名
‘’’ 属性值
Public Shared Function GetPropertyValue(obj As Object, propertyName As String) As Object
Dim result As Object = Nothing

    Try
        If TypeOf obj Is DataRow Then
            result = TryCast(obj, DataRow)(propertyName)
        ElseIf TypeOf obj Is DataRowView Then
            result = TryCast(obj, DataRowView)(propertyName)
        ElseIf TypeOf obj Is JObject Then
            '.getValue(propertyName);
            result = TryCast(obj, JObject).Value(Of JValue)(propertyName).Value
        Else
            result = GetPropertyValueFormObject(obj, propertyName)
        End If
        ' 找不到此属性
    Catch generatedExceptionName As Exception
    End Try

    Return result
End Function

''' <summary>
''' 获取对象的属性值
''' </summary>
''' <param name="obj">对象</param>
''' <param name="propertyName">属性名（"Color"、"BodyStyle"或者"Info.UserName"）</param>
''' <returns>属性值</returns>
Private Shared Function GetPropertyValueFormObject(obj As Object, propertyName As String) As Object
    Dim rowObj As Object = obj
    Dim result As Object = Nothing

    If propertyName.IndexOf(".") > 0 Then
        Dim properties As String() = propertyName.Split("."c)
        Dim tmpObj As Object = rowObj

        For i As Integer = 0 To properties.Length - 1
            Dim [property] As PropertyInfo = tmpObj.[GetType]().GetProperty(properties(i), BindingFlags.Instance Or BindingFlags.[Public] Or BindingFlags.NonPublic)
            If [property] IsNot Nothing Then
                tmpObj = [property].GetValue(tmpObj, Nothing)
            End If
        Next

        result = tmpObj
    Else
        Dim [property] As PropertyInfo = rowObj.[GetType]().GetProperty(propertyName, BindingFlags.Instance Or BindingFlags.[Public] Or BindingFlags.NonPublic)
        If [property] IsNot Nothing Then
            result = [property].GetValue(rowObj, Nothing)
        End If
    End If

    Return result
End Function

End Class

中间的全部是代码，不过好像不能识别折叠标识Region，代码内有注释，就不详细解释了

代码下载地址 https://download.csdn.net/download/qq_34951755/13184405