Source code for Issue Number 1

'----------------------------------------------------------------------
'
'   Class Name:    cListBoxDragDrop
'   Written By:     C&D Programming Corp.
'   Create Date:    1/7/98
'   Copyright:      Copyright 1997-98 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'
'----------------------------------------------------------------------
Option Explicit

' Declaration for the API call to get the top index in the Listbox.
Private Declare Function SendMessage& Lib "User" (ByVal hWnd%, ByVal _
                                  wMsg%, ByVal wParam%, lParam As Any)
Const LB_GETTOPINDEX = &H400 + 15

' Pointer to the actual listbox that going to have drag and drop
' actions performed on it.
Dim mlstDragDrop As ListBox
' Form that contains the listbox we are acting on.
Dim mfrmObj As Form

' Text of the item that is being dragged
Dim msDraggedItem As String
' Last index in the listbox of the item that is being dragged
' within the list.  We need to remember this so that
' we don't do unneccesary moves during the MouseMove
' event.
Dim mlLastPos As Long

Public Sub MouseDown()
    ' Start our drag action.  Change pointer and remember
    ' item being moved
    msDraggedItem = ListBoxObj.List(ListBoxObj.ListIndex)
    ' use custom pointer if you specify your own icon in
    ' the MouseIcon property.
    'FormObj.MousePointer = 99
    FormObj.MousePointer = 2    ' cross hair
    mlLastPos = ListBoxObj.ListIndex
End Sub

Public Property Get ListBoxObj() As ListBox
    Set ListBoxObj = mlstDragDrop
End Property

Public Property Set ListBoxObj(lstBox As ListBox)
    Set mlstDragDrop = lstBox
End Property

Public Property Get FormObj() As Form
    Set FormObj = mfrmObj
End Property

Public Property Set FormObj(frm As Form)
    Set mfrmObj = frm
    ' You can specify your own MousePointer for the
    ' Drag and Drop operation here.  If you set this
    ' be sure to change the code in MouseDown to
    ' set MousePointer to 99 (custom pointer)
    ' The Point02.ico file that comes with VB in the
    ' icons directory is a pretty good pointer
    ' icon.
    'frm.MouseIcon = LoadPicture("Point02.ico")
End Property

' This call should be put into the MouseUp event of the list box
' that is performing drag and drop.
Public Sub MouseUp()
    msDraggedItem = ""                  ' done dragging, "forget" item
    FormObj.MousePointer = vbDefault    ' return pointer to default pointer
    mlLastPos = ListBoxObj.ListIndex    ' remember the last position we are
                                        ' at in the list box
End Sub

' This call should be put into the MouseMove event of the list box
' that is performing drag and drop.
Public Sub DoDragDrop(x As Single, Y As Single)
    Dim iTop As Integer, iInsert As Single
    Dim lNewPos As Long
    Dim lRowHeight As Long

    ' figure out the index of the top most element in the list box
    iTop = SendMessage(ListBoxObj.hWnd, LB_GETTOPINDEX, 0&, 0&)
    ' calculate the height of a single row in the list box
    lRowHeight = FormObj.TextHeight("X")
    ' figure out which row we are at
    iInsert = Y \ lRowHeight

    ' if we haven't moved to a new row yet, just exit
    If mlLastPos = ListBoxObj.ListIndex Then
        Exit Sub
    End If

    ' calculate the new index to insert the item being dragged
    lNewPos = iInsert + iTop
    If lNewPos < 0 Then
        lNewPos = 0
    End If
    If lNewPos >= ListBoxObj.ListCount Then
        lNewPos = ListBoxObj.ListCount - 1
    End If

    ' if we have an item, move it to the new position
    ' take care of case when moving item up or down in list
    If Len(msDraggedItem) >= 1 Then
        If mlLastPos < ListBoxObj.ListIndex Then
            ListBoxObj.RemoveItem mlLastPos
            If lNewPos >= ListBoxObj.ListCount Then
                ListBoxObj.AddItem msDraggedItem
            Else
                ListBoxObj.AddItem msDraggedItem, lNewPos
            End If
            mlLastPos = ListBoxObj.NewIndex
        Else
            ListBoxObj.RemoveItem mlLastPos
            ListBoxObj.AddItem msDraggedItem, lNewPos
            mlLastPos = ListBoxObj.NewIndex
        End If
    End If
End Sub