Option Explicit On Option Strict On Option Infer Off Imports System.ComponentModel _ Public Class MoveItemCheckedListBox Inherits System.Windows.Forms.CheckedListBox 'Based on: 'mav.northwind http://www.codeproject.com/Members/mav-northwind 'http://www.codeproject.com/KB/list/LVCustomReordering.aspx #Region " Variables " Private Const WM_PAINT As Integer = &HF Private _LineBefore As Integer = -1I Private _LineAfter As Integer = -1I Private _itemDnD As Object = Nothing Private _itemIdx As Integer = -1I Private _itemChk As Boolean = False Private m_ItemMoveEnabled As Boolean Private m_InserLineClr As Color Public Event ItemMoved As EventHandler(Of ItemMovedEventArgs) Public Event ItemMoveEnabledChanged As EventHandler Private m_InserLineBr As SolidBrush Private m_InserLinePn As Pen #End Region #Region " Constructors " Public Sub New() 'Reduce flicker Me.DoubleBuffered = True 'Me.SetStyle(ControlStyles.OptimizedDoubleBuffer, True) MyBase.SelectionMode = Windows.Forms.SelectionMode.One m_ItemMoveEnabled = True m_InserLineClr = Color.Red m_InserLineBr = New SolidBrush(m_InserLineClr) m_InserLinePn = New Pen(m_InserLineClr, 1.0!) End Sub #End Region #Region " Properties: ItemMoveEnabled, InsertionLineColor, MultiSelect " _ Public Property ItemMoveEnabled() As Boolean Get Return m_ItemMoveEnabled End Get Set(ByVal value As Boolean) If m_ItemMoveEnabled <> value Then m_ItemMoveEnabled = value Call OnItemMoveEnabledChanged(EventArgs.Empty) End If End Set End Property _ Public Property InsertionLineColor() As Color Get Return m_InserLineClr End Get Set(ByVal value As Color) If Not m_InserLineClr.Equals(value) Then m_InserLineClr = value m_InserLineBr.Dispose() m_InserLinePn.Dispose() m_InserLineBr = New SolidBrush(m_InserLineClr) m_InserLinePn = New Pen(m_InserLineClr, 1.0!) End If End Set End Property _ Public Shadows ReadOnly Property SelectionMode() As Windows.Forms.SelectionMode Get Return MyBase.SelectionMode End Get End Property #End Region #Region " Overrides: WndProc, Dispose " _ Protected Overloads Overrides Sub WndProc(ByRef m As Message) MyBase.WndProc(m) ' We have to take this way (instead of overriding OnPaint()) because the ListView is just a wrapper ' around the common control ListView and unfortunately does not call the OnPaint overrides. If m.Msg = WM_PAINT Then If _LineBefore >= 0I AndAlso _LineBefore < Items.Count Then Dim rc As Rectangle = Me.GetItemRectangle(_LineBefore) Call DrawInsertionLine(rc.Left, rc.Right, rc.Top) End If If _LineAfter >= 0I AndAlso _LineBefore < Items.Count Then Dim rc As Rectangle = Me.GetItemRectangle(_LineAfter) Call DrawInsertionLine(rc.Left, rc.Right, rc.Bottom) End If End If End Sub Protected Overrides Sub Dispose(ByVal disposing As Boolean) If disposing Then 'The object is being explicitly disposed so dispose its children. m_InserLineBr.Dispose() m_InserLinePn.Dispose() End If m_InserLineBr = Nothing m_InserLinePn = Nothing MyBase.Dispose(disposing) End Sub #End Region #Region " DrawInsertionLine " ''' ''' Draw a line with insertion marks at each end ''' ''' Starting position (X) of the line ''' Ending position (X) of the line ''' Position (Y) of the line Private Sub DrawInsertionLine(ByVal X1 As Integer, ByVal X2 As Integer, ByVal Y As Integer) Using g As Graphics = Me.CreateGraphics() g.DrawLine(m_InserLinePn, X1, Y, X2 - 1I, Y) Dim leftTriangle() As Point = {New Point(X1, Y - 4I), New Point(X1 + 7I, Y), New Point(X1, Y + 4I)} Dim rightTriangle() As Point = {New Point(X2, Y - 4I), New Point(X2 - 8I, Y), New Point(X2, Y + 4I)} g.FillPolygon(m_InserLineBr, leftTriangle) g.FillPolygon(m_InserLineBr, rightTriangle) End Using End Sub #End Region #Region " Mouse: Down, Move, Up " Protected Overrides Sub OnMouseDown(ByVal e As System.Windows.Forms.MouseEventArgs) If Me.ItemMoveEnabled AndAlso Me.Items.Count > 1I Then If e.Button = Windows.Forms.MouseButtons.Left Then _itemIdx = MyBase.IndexFromPoint(New Point(e.X, e.Y)) If _itemIdx > -1I Then _itemDnD = MyBase.Items(_itemIdx) _itemChk = MyBase.GetItemChecked(_itemIdx) End If End If End If MyBase.OnMouseDown(e) End Sub Protected Overrides Sub OnMouseMove(ByVal e As System.Windows.Forms.MouseEventArgs) If _itemDnD IsNot Nothing Then ' Show the user that a drag operation is happening Me.Cursor = Cursors.Hand ' calculate the bottom of the last item in the LB so that you don't have to stop your drag at the last item Dim lastItemBottom As Integer = Math.Min(e.Y, Me.GetItemRectangle(Me.Items.Count - 1I).Bottom - 1I) Dim NewY As Integer = e.Y ' use 0 instead of e.X so that you don't have to keep inside the columns while dragging Select Case e.Y Case Is < 0I : NewY = 0I Case Is > lastItemBottom : NewY = lastItemBottom End Select Dim itemOver As Integer = MyBase.IndexFromPoint(New Point(0I, NewY)) If itemOver > -1I Then Dim rc As Rectangle = MyBase.GetItemRectangle(itemOver) If e.Y < rc.Top + (rc.Height / 2I) Then _LineBefore = itemOver _LineAfter = -1I Else _LineBefore = -1I _LineAfter = itemOver End If Me.SelectedIndex = _itemIdx ' invalidate the LB so that the insertion line is shown Me.Invalidate() End If End If MyBase.OnMouseMove(e) End Sub Protected Overrides Sub OnMouseUp(ByVal e As System.Windows.Forms.MouseEventArgs) If e.Button = Windows.Forms.MouseButtons.Left Then If _itemDnD IsNot Nothing Then Dim RaiseItemMoved As Boolean = False Dim OldIdx As Integer = _itemIdx Dim NewIdx As Integer = -1I Try Dim lastItemBottom As Integer = Math.Min(e.Y, Me.GetItemRectangle(Me.Items.Count - 1I).Bottom - 1I) Dim NewY As Integer = e.Y Select Case e.Y Case Is < 0I : NewY = 0I Case Is > lastItemBottom : NewY = lastItemBottom End Select Dim itemOver As Integer = Me.IndexFromPoint(New Point(0I, NewY)) If itemOver > -1I Then If _itemDnD IsNot Me.Items(itemOver) Then MyBase.Items.Remove(_itemDnD) MyBase.Items.Insert(itemOver, _itemDnD) MyBase.SetItemChecked(itemOver, _itemChk) NewIdx = itemOver RaiseItemMoved = True End If Me.SelectedIndex = itemOver End If Finally _itemDnD = Nothing _itemIdx = -1I Me.Cursor = Cursors.Default _LineAfter = -1I _LineBefore = -1I Me.Invalidate() End Try If RaiseItemMoved Then Call OnItemMoved(New ItemMovedEventArgs(OldIdx, NewIdx)) End If End If MyBase.OnMouseUp(e) End Sub Protected Overrides Sub OnMouseLeave(ByVal e As System.EventArgs) _LineAfter = -1I _LineBefore = -1I _itemDnD = Nothing _itemIdx = -1I Me.Cursor = Cursors.Default Me.Invalidate() End Sub #End Region #Region " EventHandlers: OnItemMoved, OnItemMoveEnabledChanged " Protected Sub OnItemMoved(ByVal e As ItemMovedEventArgs) RaiseEvent ItemMoved(Me, e) End Sub Protected Sub OnItemMoveEnabledChanged(ByVal e As System.EventArgs) RaiseEvent ItemMoveEnabledChanged(Me, e) End Sub #End Region End Class