Visual Basic Code of the Week (COTW)
http://www.codeoftheweek.com
Issue #1 - Premier Issue
All content and source code is Copyright (c) 1997 by C&D Programming Corp. None of the source can be reprinted in any manner without express written permission of C&D Programming Corp.
If you would like to view this page in HTML format, point your browser to http://www.codeoftheweek.com/issues/0001.html

Welcome

Welcome to the premier issue of Code of the Week for Visual Basic. You have found what promises to be the best source code resource for your Visual Basic development.

Requirements for this Issue

The source code in this issue is designed for Visual Basic 4.0 16-bit. Similiar code can be implemented in the 32-bit versions of VB. Only the module declarations for the API call should need to be changed. If you are interested in seeing this code, please contact us at http://www.codeoftheweek.com/feedback.html

In this Issue

In this issue we are going to introduce a object class called cListBoxDragDrop. You can use this class to allow your end-users to rearrange the data in a standard Windows list box.

cListBoxDragDrop Class

Add drag and drop rearranging/sorting to a standard Windows list box. There are several important methods in the class.

Properties

FormObj - The form that contains the list box to this property (see Form_Load in the Sample Form)
ListBoxObj - The list box on which drag and drop actions should be performed.

Methods

MouseDown - Should be put in the MouseDown event of the list box.
MouseUp - Should be put in the MouseUp event of the list box.
DoDragDrop - Should be put in the MouseMove event of the list box with the X, Y values as parameters.
NOTE: Since a class can not trap events of a control in VB 4.0, you put these method calls in the events of the control and they perform the functions necessary to implement the drag and drop actions.

Sample Call/Form

To use this example, create a new project in Visual Basic 4.0 16-bit and drop a list box on a form. Change the Name property of the list box to lstWords. Paste the following code into the declarations section of the form.

Option Explicit

Dim oListDrag As New cListBoxDragDrop

Private Sub Form_Load()
    Set oListDrag.FormObj = Me
    Set oListDrag.ListBoxObj = lstWords
End Sub

Private Sub lstWords_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
    ' Traps the Mouse Down event which will start
    ' the dragging operation.
    oListDrag.MouseDown
End Sub

Private Sub lstWords_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
    ' Traps the MouseUp event which will end
    ' the dragging operation.
    oListDrag.MouseUp
End Sub

Private Sub lstWords_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
    ' Traps the MouseMove event which will show the
    ' item in the list being dragged around.
    oListDrag.DoDragDrop x, Y
End Sub

Source Code

Insert this code into a Class Module and call it cListBoxDragDrop.
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

Sample Compiled Program

If you would like to download the compiled executable, point your browser to http://www.codeoftheweek.com/issues/0001exe.html
This location contains the executable you can run provided you have Visual Basic 4.0 (16-bit) installed on your system or have previously installed a VB 4.0 application. The only run-time file requirement should be VB40016.DLL.

Summary

That concludes our first issue of COTW. We hope you find the source code useful in your development.

The below describes the ways you can supply us some feedback about COTW. We would like to see our members help mold COTW into the best Visual Basic source code resource available. But to do that we need your feedback about what you like and what you do not like.

How to tell us what you think

If you have any suggestions for topics you would like to see covered in COTW, please email them to info@codeoftheweek.com or use online feedback form at http://www.codeoftheweek.com/feedback.html.

If you have any source code you would like to submit for possible inclusion in COTW, please fill out our online submission form at http://www.codeoftheweek.com/submission.html.

Contact Information

C&D Programming Corp.
PO Box 20128
Floral Park, NY 11002-0128
Phone or Fax: (212) 504-7945
Email: info@codeoftheweek.com
Web: http://www.codeoftheweek.com

About Code of the Week and How to get your own subscription

If you have received this issue in a free offer, please check out http://www.codeoftheweek.com to order your own subscription to COTW. For a limited time you can get 52 issues of COTW for only $19.95. This is a full year of Visual Basic source code and information to help with all your development. So don't wait, subscribe now!