🚀 go-pugleaf

Zeff wrote in message <7p1ijr$clo$1@vnews.prima.com.ar>...
>Me gustaria saber como se utiliza el multiselect para drag&drop.
>El problema que tengo es el siguiente:
> Luego de elegir en un FileListBox una serie de elementos a la hora de
>arrastrarlos me toma el ultimo de ellos..Como configuro para que arrastre a
>los seleccionados?
>
>
Zeff
I am not sure exactly what you are asking for.  I had to recently reinstall
everything
and didn't get around to EZ Translator just yet ;-( Something about
Multiselect and FileListBoxes???)

I have the following to move items around listboxes using Drag and Drop.
I have not tried it on a filelistbox.  I am not sure it would make any sense
to
do the RemoveItem as my code does...

*Note*
 ( Uses a control array called ListNames, The LBs all have Drag/Drop=Manual,
You can vary the style selection between single and multiple select and the
code will adapt to that.)

Anybody know how I can improve upon the way I have done the Drag/drop?
I don't really like the Left button select-Right button Drag, but can't
think of
any other easy way to do this.  Please drop me a note or post it here.
 I have had this around for along time in a rather raw form.  I took alot of
time
today to recode this, tighten it up, test it and make it reasonably general.
If you reuse it or repost it I would appreciate your keeping the function
headers intact ;-)
Neila

Option Explicit

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA"
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As
Any) As Long
Private Const LB_SETCURSEL = &H186
Private Const LB_SETSEL = &H185
Private Const LB_GETSELITEMS = &H191
Private Const LB_GETSELCOUNT = &H190


Private Sub Form_Load()
    ListNames(0).AddItem "a"
    ListNames(0).AddItem "b"
    ListNames(0).AddItem "c"
    ListNames(0).AddItem "d"
    ListNames(0).AddItem "e"
    ListNames(1).AddItem "x"
    ListNames(1).AddItem "y"
    ListNames(1).AddItem "z"
End Sub

Private Sub ListNames_DragDrop(Index As Integer, Source As Control, X As
Single, Y As Single)
    'Don't Drop it on yourself and only allow from another Listbox!!!
    If TypeOf ActiveControl Is ListBox Then
        If ActiveControl <> ListNames(Index) Then
            Call LB_DropItems(ActiveControl, ListNames(Index))
        End If
    End If
End Sub

Private Sub ListNames_MouseDown(Index As Integer, Button As Integer, Shift
As Integer, X As Single, Y As Single)
    Dim I As Integer
    For I = 0 To ListNames.Count - 1
        'Don't clear Current Listbox
        If I <> Index Then LB_ClearSelects ListNames(I)
    Next I
    'OK now Drag if stuff is right !!!
    With ListNames(Index)
        If .SelCount > 0 And (.MultiSelect = False Or Button =
vbRightButton) Then .Drag
    End With
End Sub

'---------------------------------------------------------------------------
----------------------------------
'A Minimal subset of Listbox related functions for implimenting Drag-Drop
'---------------------------------------------------------------------------
----------------------------------

'Drop Items from Source Listbox to Destination Listbox
'Neila Nessa 1999
Public Sub LB_DropItems(LBSource As ListBox, LBDestination As ListBox)
    Dim SelectedItems() As Long
    ReDim SelectedItems(0)
        If LBSource.SelCount > 0 Then
            SelectedItems = LB_GetSelections(LBSource)
            Call LB_MoveSelections(LBSource, LBDestination, SelectedItems)
        End If
    LBDestination.SetFocus
End Sub


'Clear Selection from any listbox
'Neila Nessa 1999
Private Sub LB_ClearSelects(LBToClear As ListBox)
    With LBToClear
        If .MultiSelect = False Then
            SendMessage .hwnd, LB_SETCURSEL, -1&, 0&
        Else
            SendMessage .hwnd, LB_SETSEL, False, ByVal -1&
        End If
    End With
End Sub


'Obtains an array of selections from any listbox
'Neila Nessa 1999
Private Function LB_GetSelections(LBSource As ListBox) As Long()
    Dim aTmp() As Long
    ReDim aTmp(0)
    With LBSource
        If .MultiSelect Then
            aTmp = LB_ReturnMultipleSelectedIndexes(.hwnd)
        Else
            aTmp(0) = .ListIndex
        End If
    End With
    LB_GetSelections = aTmp
End Function

'Function Moves a list of indices (SelectedItems) from one Listbox
(LBSource)
'to another(LBDestination)
'Neila Nessa 1999
Private Sub LB_MoveSelections(LBSource As ListBox, LBDestination As ListBox,
SelectedItems() As Long, Optional blnBlastEm As Boolean = True)
Dim lngFromIndex As Long
Dim lngSelected As Long
Dim lngNewIndex As Long
Dim lngIndex As Long

    'Copy selected items in LBSource into LBDestination
    For lngIndex = LBound(SelectedItems) To UBound(SelectedItems)
        lngFromIndex = SelectedItems(lngIndex)
        With LBDestination
            .AddItem LBSource.List(lngFromIndex)
            lngNewIndex = .NewIndex
            .ItemData(lngNewIndex) = LBSource.ItemData(lngFromIndex)
            .Selected(lngNewIndex) = True
        End With
    Next

    'Get rid of the Selected Items from Source Listbox
    If blnBlastEm = True Then
        For lngIndex = UBound(SelectedItems) To LBound(SelectedItems)
Step -1&
            LBSource.RemoveItem SelectedItems(lngIndex)
        Next lngIndex
    End If
End Sub

'Function Returns an Array of Selected indices from MultiSelect ListBox
'Neila Nessa 1999
Function LB_ReturnMultipleSelectedIndexes(LBHwnd As Long) As Long()
Dim lngSelCount As Long

Dim aSelTmp() As Long
    lngSelCount = SendMessage(LBHwnd, LB_GETSELCOUNT, 0&, 0&)
    If lngSelCount > 0& Then
        ReDim aSelTmp(lngSelCount - 1&)
        Call SendMessage(LBHwnd, LB_GETSELITEMS, lngSelCount, aSelTmp(0))
    End If
    LB_ReturnMultipleSelectedIndexes = aSelTmp
End Function

english please :)

Zeff <dzeff@intramed.net.ar> wrote in message
news:7p1ijr$clo$1@vnews.prima.com.ar...
> Me gustaria saber como se utiliza el multiselect para drag&drop.
> El problema que tengo es el siguiente:
>  Luego de elegir en un FileListBox una serie de elementos a la hora de
> arrastrarlos me toma el ultimo de ellos..Como configuro para que arrastre
a
> los seleccionados?
>
>