Solved

Listbox drag and drop

Posted on 2000-04-14
14
476 Views
Last Modified: 2013-12-25
Need to be able to drag and drop items to change their position in a listbox.

How can I do this (if it is possible)??
0
Comment
Question by:d_jedi
  • 5
  • 4
  • 3
  • +1
14 Comments
 
LVL 28

Expert Comment

by:AzraSound
Comment Utility
if youre interested, this code will move items by double clicking them:

'MOVE ITEMS AROUND IN LISTBOX
'************************************************************************
'
'FORM CODE
'
'************************************************************************

Dim pos As Integer
Dim newpos As Integer
Dim strOld As String
Dim drag As Boolean
Dim i As Integer



Private Sub List1_DblClick()
    If drag = False Then
        drag = True
        pos = List1.ListIndex
        strOld = List1.List(pos)
        List1.List(pos) = "---" & List1.List(pos) & "---"
    Else
        newpos = List1.ListIndex
        If pos < newpos Then
            For i = pos To newpos
                List1.List(i) = List1.List(i + 1)
            Next
        ElseIf pos > newpos Then
            For i = pos To newpos Step -1
                List1.List(i) = List1.List(i - 1)
            Next
        Else 'clicked the same item twice
        End If
        List1.List(newpos) = strOld
        drag = False
    End If
   
End Sub

Private Sub List1_LostFocus()
    If drag = True Then
        List1.List(pos) = strOld
        drag = False
    End If
End Sub




0
 

Author Comment

by:d_jedi
Comment Utility
This isn't what I was looking for..

I wanted to be able to drag and drop items in a list box to change their position in it..

Similar to how you can in Winamp or ICQ, if you've ever used those programs..
0
 
LVL 28

Expert Comment

by:AzraSound
Comment Utility
i know it isnt but as i know of no other solution i provided a simple workaround in case no one else can give you your answer.  i did some work and was unable to produce drag and drop within the same listbox.  sorry.
0
 
LVL 1

Expert Comment

by:RobMWilliams
Comment Utility
The listbox doesn’t provide feedback about where the mouse is.  If it did you could provide (still a crude) drag/drop functionality within itself.  Why don’t you consider using a ListView control  instead?  A ListView (in report view) looks exactly like a list box, but you have more control over all the elements of it, including dragging and dropping items within itself the way you describe (the way Internet Explorer does with the favorites list)

To make it work you need to:
 
Drop a ListView control on a form
Set the View property to 3 – lstReport
Be sure to create at least one column (use the Custom button to activate the property page)
Set the DragMode to 0 - vbManual
Also, set the DragIcon to an icon (otherwise you’d be dragging the outline of the control)

Add some stuff to the control for this example:
Private Sub Form_Load()

For x = 1 To 10
ListView1.ListItems.Add , , "hello"
Next x
ListView1.ListItems.Add , , "drag this baby"

End Sub


Create a public variable to hold what you are dragging:
Public DragItem As String


Start the drag in MouseDown (or other) event:

Set ListView1.DropHighlight = ListView1.HitTest(x, y)  ‘ This gets the item you want to move
DragItem = ListView1.DropHighlight.Text    ‘ and saves the text for dropping
ListView1.Drag 1  ‘ starts the dragging


Give the user feedback by highlighting which item it would be dropped near:
Private Sub ListView1_DragOver(Source As Control, x As Single, y As Single, State As Integer)
   Set ListView1.DropHighlight = ListView1.HitTest(x, y)
End Sub

Finally, drop the item:
Private Sub ListView1_DragDrop(Source As Control, x As Single, y As Single)
 ListView1.ListItems.Add ListView1.DropHighlight.Index, , DragItem
End Sub

I’ll leave it to you to provide code to delete the original position of the dragged item.

Hope this helps.

Rob

P.S. Instead of drag, you could use OleDrag… this would give your user the option to drop stuff in windows outside your program.
0
 
LVL 2

Accepted Solution

by:
Sage020999 earned 30 total points
Comment Utility
Option Explicit



Private Const MARGIN_SIZE = 60    ' in Twips
' variables for column dragging
Private m_bDragOK As Boolean
Private m_iDragCol As Integer
Private xdn As Integer, ydn As Integer
Private blnLoading As Boolean

Private Sub Form_Load()
  Dim intCol As Integer
  Dim intRow As Integer
  Dim m_iMaxCol As Integer

  datPrimaryRS.Visible = False
  blnLoading = True
'  datPrimaryRS.ConnectionString = m_strDatConnection & "Persist Security Info=False"
'  datPrimaryRS.Refresh

'  DoEvents
'  If m_Sql <> "" Then
'    datPrimaryRS.RecordSource = m_Sql
'    datPrimaryRS.Refresh
'    If m_CallingFunction <> "" Then
'      datPrimaryRS.Recordset.Find "Item = '" & m_CallingFunction & "'"
'      lstItem.TopRow = datPrimaryRS.Recordset.AbsolutePosition
'    End If
'  End If

  With lstItem

    .Redraw = False
    ' place the columns in the right order
    .ColData(0) = 0
    .ColData(1) = 1
    .ColData(2) = 2
    .ColData(3) = 3
    .ColData(4) = 4
    .ColData(5) = 5
    .ColData(6) = 6
    .ColData(7) = 7
    .ColData(8) = 8

    '.Col = 0
    '.ColHeaderCaption(0, 1) = "SSS"

    ' loop to re-order the columns
    For intCol = 0 To .Cols - 1
      m_iMaxCol = intCol         ' find the highest value starting from this column
      For intRow = intCol To .Cols - 1
        If .ColData(intCol) > .ColData(m_iMaxCol) Then m_iMaxCol = intCol
      Next intRow
      '.ColPosition(m_iMaxCol) = 0   ' move the column with the max value to the left
    Next intCol

    ' set grid's column widths
    .ColWidth(0) = 1140
    .ColWidth(1) = 3060
    .ColWidth(2) = 765
    .ColWidth(3) = 870
    .ColWidth(4) = 1095
    .ColWidth(5) = 645
    .ColWidth(6) = 1350
    .ColWidth(7) = -1
    .ColWidth(8) = -1

    ' set grid's column merging and sorting
    For intCol = 0 To .Cols - 1
      .MergeCol(intCol) = True
    Next intCol

    .Sort = flexSortGenericAscending

    ' set grid's style
    .AllowBigSelection = True
    .FillStyle = flexFillRepeat

    ' make header bold
    .Row = 0
    .Col = 0
    '.RowSel = .FixedRows - 1
    .ColSel = .Cols - 1
    .CellFontBold = True

    ' grey every other column
    For intCol = .FixedCols To .Cols() - 1 Step 2
      .Col = intCol
      .Row = .FixedRows
      .RowSel = .Rows - 1
      .CellBackColor = &HC0C0C0   ' light grey
    Next intCol

    .AllowBigSelection = False
    .FillStyle = flexFillSingle
    .Redraw = True

  End With
 
  blnLoading = True
 
  Screen.MousePointer = 0

End Sub

Private Sub lstItem_Click()

  Dim intTempRow As Integer
  Dim strColTest As String
  Dim intColCnt As Integer
 
  If Not blnLoading Or m_Sql <> "" Then
    intTempRow = lstItem.Row
    lstItem.Row = 0
    For intColCnt = 0 To lstItem.Cols - 1
      lstItem.Col = intColCnt
      If lstItem.Text = "ITEM" Then
        Exit For
      End If
    Next intColCnt
    lstItem.Col = intColCnt
    lstItem.Row = intTempRow
    Me.Tag = lstItem.Text
   
    If Not (m_ctrlCall Is Nothing) Then
      If Left(m_ctrlCall.Name, 2) = "SS" Then
        m_ctrlCall.Row = m_ctrlCall.DataRowCnt + 1
        m_ctrlCall.Col = 1
        m_ctrlCall.Text = Me.Tag
     
        'Simulate Leave Cell event
        Select Case m_CallingFunction
          Case "Contract"
            m_ctrlCall.Action = 0
            frmContract.FillDTInfo (Me.Tag)
          Case "Invoice"
            m_ctrlCall.Action = 0
            frmInvoice.InvcAddItem (Me.Tag)
          Case Else
         
        End Select
       
      Else
        Me.Hide
      End If
     
    Else 'We will assume txt
      Me.Hide
    End If
  End If
 
  blnLoading = False

 
 
End Sub

Private Sub lstItem_DragDrop(Source As Control, x As Single, y As Single)
'-------------------------------------------------------------------------------------------
' code in grid's DragDrop, MouseDown, MouseMove, and MouseUp events enables column dragging
'-------------------------------------------------------------------------------------------

  If m_iDragCol = -1 Then Exit Sub  ' we weren't dragging
 
  If lstItem.MouseRow <> 0 Then Exit Sub
   
  With lstItem
    .Redraw = False
    .ColPosition(m_iDragCol) = .MouseCol

    .FillStyle = flexFillRepeat
    .Col = 0
    .Row = .FixedRows
    .RowSel = .Rows - 1
    .ColSel = .Cols - 1
    .CellBackColor = &HFFFFFF
    Dim iLoop As Integer
    For iLoop = .FixedCols To .Cols() - 1 Step 2
      .Col = iLoop
      .Row = .FixedRows
      .RowSel = .Rows - 1
      .CellBackColor = &HC0C0C0
    Next iLoop
    .FillStyle = flexFillSingle

    DoSort
    .Redraw = True
  End With

End Sub

Private Sub lstItem_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
'-------------------------------------------------------------------------------------------
' code in grid's DragDrop, MouseDown, MouseMove, and MouseUp events enables column dragging
'-------------------------------------------------------------------------------------------

  If lstItem.MouseRow <> 0 Then
    If Button <> 2 Then
      Exit Sub
    End If
  End If
 
 
  xdn = x
  ydn = y
  m_iDragCol = -1     ' clear drag flag
  m_bDragOK = True

End Sub

Private Sub lstItem_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
'-------------------------------------------------------------------------------------------
' code in grid's DragDrop, MouseDown, MouseMove, and MouseUp events enables column dragging
'-------------------------------------------------------------------------------------------

  ' test to see if we should start drag
  If Not m_bDragOK Then Exit Sub
  If Button <> 1 Then Exit Sub            ' wrong button
  If m_iDragCol <> -1 Then Exit Sub           ' already dragging
  If Abs(xdn - x) + Abs(ydn - y) < 50 Then Exit Sub   ' didn't move enough yet
  If lstItem.MouseRow <> 0 Then Exit Sub     ' must drag header

  ' if got to here then start the drag
  m_iDragCol = lstItem.MouseCol
  lstItem.Drag vbBeginDrag

End Sub

Private Sub lstItem_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
'-------------------------------------------------------------------------------------------
' code in grid's DragDrop, MouseDown, MouseMove, and MouseUp events enables column dragging
'-------------------------------------------------------------------------------------------

  m_bDragOK = False

End Sub

Sub DoSort()

  With lstItem
    .Redraw = False
    .Col = 0
    .Row = 1
    .RowSel = .Rows - 1
    '.Sort = flexSortGenericAscending
    .Redraw = True
  End With

End Sub

Private Sub Form_Resize()

  Dim sngButtonTop As Single
  Dim sngScaleWidth As Single
  Dim sngScaleHeight As Single

  On Error GoTo Form_Resize_Error
  With Me
    sngScaleWidth = .ScaleWidth
    sngScaleHeight = .ScaleHeight

    ' move Close button to the lower right corner
'    With .cmdClose
'        sngButtonTop = sngScaleHeight - (.Height + MARGIN_SIZE)
'        .Move sngScaleWidth - (.Width + MARGIN_SIZE), sngButtonTop
'    End With

'    .lstItem.Move MARGIN_SIZE, _
'      MARGIN_SIZE, _
'      sngScaleWidth - (2 * MARGIN_SIZE), _
'      sngButtonTop - (2 * MARGIN_SIZE)

  End With
  Exit Sub

Form_Resize_Error:
  ' avoid error on negative values
  Resume Next

End Sub

Private Sub cmdClose_Click()

  Me.Tag = ""
  Me.Hide

End Sub




0
 

Author Comment

by:d_jedi
Comment Utility
Please provide more information, Sage.

Which controls are you using on the form ??
Is this even for a listbox? (seems to me it's for a flexgrid?)
0
 
LVL 2

Expert Comment

by:Sage020999
Comment Utility
This particular control is the msFlexGrid.  Simular code has worked for me using the farpoint list boxes.  Which controls are you using. I will see if I have a project with drag and drop in them so that I can give you a cut and paste answer.
0
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 

Author Comment

by:d_jedi
Comment Utility
I'm just using a generic list box..
0
 

Author Comment

by:d_jedi
Comment Utility
By the way, what's a farpoint listbox?
0
 
LVL 2

Expert Comment

by:Sage020999
Comment Utility
Far Point is a 3rd party control.
0
 
LVL 2

Expert Comment

by:Sage020999
Comment Utility
I don't think this can be done with a standard list box.  Can you use a differant control and make it appear to be a list box.  It would probally give you more flexability. If not, I would suggest in purchasing a 3rd party control that handles that task.
0
 
LVL 2

Expert Comment

by:Sage020999
Comment Utility
I don't think this can be done with a standard list box.  Can you use a differant control and make it appear to be a list box.  It would probally give you more flexability. If not, I would suggest in purchasing a 3rd party control that handles that task.
0
 
LVL 1

Expert Comment

by:RobMWilliams
Comment Utility
If this is the question:
> Need to be able to drag and drop items
> to change their position in a listbox.
> How can I do this (if it is possible)??


Then the answer is use the ListView control.  It will accommodate EXACTLY what you want.  The example with the FlexGrid has to do with moving columns.  How moving columns has anything to do with moving the items in the list I don’t know, especially since the ListBox doesn’t even support columns.

But you can move the items in a FlexGrid by dragging, as you can move the columns in a ListView by dragging.  But unless you need the greater functionality of the FlexGrid, you should just stick with the less imposing ListView.

Rob
0
 
LVL 28

Expert Comment

by:AzraSound
Comment Utility
I fiddled with the code to use drag and drop in the listbox.  Here is simple example:

Dim pos As Integer
Dim newpos As Integer
Dim strOld As String
Dim ListItems(20) As String

Private Sub Form_Load()
    Dim x As Integer
    For x = 0 To 20
        List1.AddItem "Item #" & x
    Next x
End Sub

Private Sub List1_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
    pos = List1.ListIndex
    strOld = List1.List(pos)
    List1.MousePointer = 4
End Sub


Private Sub List1_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
    Dim i As Integer
    Dim newpos As Integer
    Dim counter As Integer
    newpos = List1.ListIndex
    If pos < newpos Then
        For i = pos To newpos
            List1.List(i) = List1.List(i + 1)
        Next
    ElseIf pos > newpos Then
        For i = pos To newpos Step -1
            List1.List(i) = List1.List(i - 1)
        Next
    End If
    List1.List(newpos) = strOld
    List1.MousePointer = 0
End Sub
0

Featured Post

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

744 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now