Eventos de classificação de arrastar-soltar de controle de ListView

Reorganizando linhas de dados no controle ListView.

A Tarefa de Design.

1. 
   Crie uma nova tabela com um único campo de texto, com o nome do campo DataList .
   
2. 
   Salve a Tabela com o nome lvTables (lv significa ListView).
   
3. 
   Abra a tabela no modo folha de dados.
   
4. 
   Adicione alguns nomes de tabela e selecione nomes de consulta de seu banco de dados na tabela. Eu importei tabelas do banco de dados de exemplo Northwind para minha lista.
   
   Observação: O Anexo O campo não é válido no controle ListView. Crie consultas de seleção para tabelas com campo de anexo e selecione todos os campos, exceto o campo de anexo.
   
5. 
   Crie e abra um novo formulário no modo de design.
   
6. 
   Insira um controle ListBox no formulário, exiba a folha de propriedades e altere seu Nome valor da propriedade para List0 .
   
7. 
   Alterar seu rótulo filho Legenda valor para Tabelas .
   
8. 
   Exiba a folha de propriedades do controle ListBox e defina a Origem da linha valor da propriedade para as lvTables nome.
   
9. 
   Verifique se o Tipo de Origem da Linha está definido como Tabela/Consulta e o valor da propriedade Coluna Vinculada é 1. Se for diferente, altere.
   
10. 
    Insira um controle ListView da lista de controles ActiveX e altere seu valor de propriedade de nome para ListView1 .
    
11. 
    Redimensione ambos os controles conforme mostrado na imagem do formulário de demonstração fornecida acima.
    
12. 
    Insira um rótulo acima dos controles e altere seus valores de propriedade de nome e legenda para título. O valor da legenda será alterado do código vba quando uma tabela ou consulta for selecionada no ListBox.
    
13. 
    Crie um botão de comando abaixo dos controles e altere o valor da propriedade Name para cmdClose e o valor da propriedade Caption para Fechar .
    
14. 
    Clique com o botão direito do mouse no controle ListView, realce o Objeto ListViewCtrl opção e selecione Propriedades .
    
15. 
    Altere as configurações de propriedade para corresponder às configurações em Geral Imagem da guia fornecida abaixo.
    
16. 
    Imagem da folha de propriedades do controle ListView - a visualização da guia geral é fornecida abaixo:
    
    Algumas dessas opções já definimos nas sessões anteriores. Aqui precisamos das seguintes opções para nossa ação Arrastar Soltar:
    
    • 
      OLEDragAutomático - 1
      
    • 
      OLEDropManual - 1
      
    • 
      FullRowSelect - Verdadeiro
      
    • 
      HotTracking - Verdadeiro
      

O código VBA do módulo de formulário.

Option Compare Database
Option Explicit

Dim lvwList As MSComctlLib.ListView
Dim strTable As String
Dim db As DAO.Database
Dim rst As DAO.Recordset

Private Sub Form_Load()
    Set lvwList = Me.ListView1.Object

End Sub


Private Sub Form_Unload(Cancel As Integer)
On Error GoTo Form_Unload_Err
Dim lvItem As ListItem
Dim tmp As Long
Dim criteria As String
Dim strfield As String
Dim flag As Boolean
Dim fld As String

If strTable = "" Then
Set lvwList = Nothing
    Exit Sub
End If

Set db = CurrentDb
Set rst = db.OpenRecordset(strTable, dbOpenDynaset)
flag = False
For Each lvItem In lvwList.ListItems
    tmp = lvItem.Index
    strfield = lvwList.ColumnHeaders(1).Text
    criteria = strfield & " = " & Chr(34) & lvItem.Text & Chr(34)
    
    rst.FindFirst criteria
  
    If Not rst.NoMatch Then
       If (rst.Fields(strfield).Value = lvItem.Text) _
       And (rst.Fields(1).Value = tmp) Then
         'GoTo nextitem
       Else
            rst.Edit
            rst.Fields(1).Value = tmp
            rst.Update
       End If
    Else
        MsgBox "Item: " & tmp & " Not Found!"
    End If
Next
rst.Close

Set lvwList = Nothing
Set lvItem = Nothing
Set rst = Nothing
Set db = Nothing

Form_Unload_Exit:
Exit Sub

Form_Unload_Err:
MsgBox Err & " : " & Err.Description, , "Form_Unload()"
Resume Form_Unload_Exit

End Sub

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As Object)
' When a ColumnHeader object is clicked, the ListView control
' sorts the data of that column. On the first Click on the Column
'will sort in Ascending Order, second Click will sort in Descending
With Me.ListView1
    ' Set the SortKey to the Index of the ColumnHeader - 1
    .SortKey = ColumnHeader.Index - 1
    
' Set Sorted to True to sort the list.
 If .SortOrder = lvwAscending Then
    .SortOrder = lvwDescending
 Else
    .SortOrder = lvwAscending
 End If
 
    .Sorted = True
End With

End Sub

Private Sub List0_Click()

strTable = List0.Value

Call LoadListView(strTable)

End Sub

Private Sub LoadListView(ByVal s_Datasource As String)
On Error GoTo LoadListView_Err
    Dim j As Integer
    Dim tmpLItem As MSComctlLib.ListItem
    Dim strHeading As String
    
    strHeading = UCase(s_Datasource)
    With Me.Heading
        .caption = strHeading
        .FontName = "Courier New"
        .FontSize = 20
        .FontItalic = True
        .FontBold = True
    End With
    
   'Initialize ListView Control
    lvwList.ColumnHeaders.Clear
    lvwList.ListItems.Clear
    
    Set db = CurrentDb
    Set rst = db.OpenRecordset(s_Datasource, dbOpenSnapshot)
       
    'Initialize ListView & Column Headers Property Values
     With lvwList
        .Font.Size = 10
        .Font.Name = "Verdana"
        .Font.Bold = False
        .GridLines = True
    End With
    
    With lvwList
        'Syntax: .ColumnHeaders.Add Index, Key, Text, Width in Pixels, Alignment, Icon
       For j = 0 To rst.Fields.Count - 1
        .ColumnHeaders.Add , , rst.Fields(j).Name, IIf(j = 0, 3000, 1400), 0
       Next
    End With
   Dim I As Long
    rst.MoveFirst
    Do While Not rst.BOF And Not rst.EOF
    'Syntax: lvwList.ListItems.Add Index, Key, Text, Icon, SmallIcon
        Set tmpLItem = lvwList.ListItems.Add(, , rst.Fields(0).Value) 'Name column
        
         'Syntax: tmpLItem.ListSubItems.Add Index, Key, Text, ReportIcon, ToolTipText
          With tmpLItem
                For j = 1 To rst.Fields.Count - 1
                    .ListSubItems.Add , , Nz(rst.Fields(j).Value, "")
                Next
          End With
        rst.MoveNext
    Loop
    rst.Close
    
    With lvwList
        If .ListItems.Count > 0 Then
            .ListItems(1).Selected = True
        End If
    End With
  
    Set db = Nothing
    Set rst = Nothing
    
LoadListView_Exit:
Exit Sub

LoadListView_Err:
MsgBox Err & " : " & Err.Description, , "LoadListView()"
Resume LoadListView_Exit
End Sub


Private Sub ListView1_OLEDragOver(data As Object, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
    'Highlight the item when draged over it
    Set ListView1.DropHighlight = ListView1.HitTest(x, y)

End Sub

Private Sub ListView1_OLEDragDrop(data As Object, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)

'Item being dropped
Dim lvwDrag As ListItem
'Item being dropped on
Dim lvwDrop As ListItem
'Item being readded to the list
Dim lvwTarget As ListItem
'Subitem reference in dropped item
Dim lvwSub As ListSubItem
'Drop position
Dim intTgtIndex As Integer
Dim j As Integer

Set lvwDrop = lvwList.HitTest(x, y)
Set lvwDrag = lvwList.SelectedItem 'save a copy of draged item

'Ignore overlapping drag or drop Item actions
If (lvwDrop Is Nothing) Or (lvwDrag Is Nothing) Or (lvwDrop = lvwDrag) Then
    Set lvwList.DropHighlight = Nothing
    Set lvwDrop = Nothing
    Set lvwDrag = Nothing
    Exit Sub
End If

'Save the droped position Index Number
intTgtIndex = lvwDrop.Index
'Remove Dragged Item from its old position
lvwList.ListItems.Remove lvwDrag.Index

'For j = intTgtIndex To ListItems.Count
    
'Creates a new Item in the Target Item position
'with the Dropped Item Index Number and Dragged Item.Text.
'Saves the new Item reference in lvwTarget Item.

'* The original Droped-on Target) Item will be moved down
'* by incrementing its original Index Number
Set lvwTarget = lvwList.ListItems.Add(intTgtIndex, , lvwDrag.Text)

'Copy the original Draged Item's subitems to the new item
If lvwDrag.ListSubItems.Count > 0 Then
    For Each lvwSub In lvwDrag.ListSubItems
        lvwTarget.ListSubItems.Add , lvwSub.Key, lvwSub.Text
    Next
End If

'Highlight the draged item in its new position
lvwTarget.Selected = True

'Destroy all objects
Set lvwTarget = Nothing
Set lvwDrag = Nothing
Set lvwDrop = Nothing
Set lvwList.DropHighlight = Nothing

End Sub

Private Sub cmdClose_Click()
    DoCmd.Close acForm, Me.Name
End Sub

A ação de arrastar e soltar em imagens.

A análise por segmento de código VBA.

Private Sub List0_Click()
Dim strTable As String

strTable = List0.Value

  Call LoadListView(strTable)

End Sub

O procedimento ListView1_OLEDragOver().

Private Sub ListView1_OLEDragOver(Data As Object, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
    'Highlight the item when draged over it
    Set ListView1.DropHighlight = ListView1.HitTest(x, y)
End Sub 

O procedimento ListView1_OLEDragDrop.

Private Sub ListView1_OLEDragDrop(Data As Object, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)

'Item being dragged
Dim lvwDrag As ListItem
'Item being dropped on
Dim lvwDrop As ListItem
'Item being added to the list
Dim lvwTarget As ListItem
'Subitem reference used in For . . .Next loop
Dim lvwSub As ListSubItem
'Drop position index
Dim intTgtIndex As Integer

Set lvwDrop = lvwList.HitTest(x, y) 'save the source item
Set lvwDrag = lvwList.SelectedItem 'save a copy of draged item

'Ignore overlapping drag or drop Item actions
If (lvwDrop Is Nothing) Or (lvwDrag Is Nothing)  Or (lvwDrop = lvwDrag) Then
    Set lvwList.DropHighlight = Nothing
    Set lvwDrop = Nothing
    Set lvwDrag = Nothing
    Exit Sub
End If

'Save the droped position Index Number
intTgtIndex = lvwDrop.Index

'Remove Dragged Item from its old position
lvwList.ListItems.Remove lvwDrag.Index

'Creates a new Item in the Target Item position
'with the Dropped Item Index Number and Dragged Item.Text.
'Saves the new Item reference in lvwTarget Item.

'* The original Droped-on Target) Item will be moved down
'* by incrementing its original Index Number
Set lvwTarget = lvwList.ListItems.Add(intTgtIndex, , lvwDrag.Text)

'Copy the original Draged Item's subitems to the new item
If lvwDrag.ListSubItems.Count > 0 Then
    For Each lvwSub In lvwDrag.ListSubItems
        lvwTarget.ListSubItems.Add , lvwSub.Key, lvwSub.Text
    Next
End If

'Highlight the draged item in its new position
lvwTarget.Selected = True

'Destroy all objects
Set lvwTarget = Nothing
Set lvwDrag = Nothing
Set lvwDrop = Nothing
Set lvwList.DropHighlight = Nothing

End Sub

'Item being dragged
Dim lvwDrag As ListItem
'Item being dropped on
Dim lvwDrop As ListItem
'Reference of the Item being added to the list
Dim lvwTarget As ListItem
'Subitem reference used in For . . .Next loop
Dim lvwSub As ListSubItem
'Drop position index
Dim intTgtIndex As Integer

Set lvwDrop = lvwList.HitTest(x, y)
Set lvwDrag = lvwList.SelectedItem 'save a copy of draged item

Verificações de validação na ação de arrastar e soltar.

'Ignore overlapping drag or drop Item actions, 
'OR drag and drop happens on the same ListItem.
If (lvwDrop Is Nothing) Or (lvwDrag Is Nothing)  Or (lvwDrop = lvwDrag) Then
    Set lvwList.DropHighlight = Nothing
    Set lvwDrop = Nothing
    Set lvwDrag = Nothing
    Exit Sub
End If

'Save the dropped position ListItem Index Number
intTgtIndex = lvwDrop.Index

'Remove Dragged Item from its old position
lvwList.ListItems.Remove lvwDrag.Index

'Creates a new Item in the Target Item position
'with the Dropped Item Index Number and Dragged Item.Text.
'Saves the new Item reference in lvwTarget Item.

'* The original Droped-on Target) Item will be moved down
'* by incrementing its original Index Number
Set lvwTarget = lvwList.ListItems.Add(intTgtIndex, , lvwDrag.Text)

'Copy the original Draged Item's subitems to the new item
If lvwDrag.ListSubItems.Count > 0 Then
    For Each lvwSub In lvwDrag.ListSubItems
        lvwTarget.ListSubItems.Add , lvwSub.Key, lvwSub.Text
    Next
End If

'Highlight the draged item in its new position
lvwTarget.Selected = True

O impacto de excluir uma linha e criá-la em outro lugar.

Suponha que fazemos esse movimento na ordem inversa, como arrastar ListItem número 3 de cima e soltá-lo no item número 7, então o que acontece?

Naturalmente, excluiremos o 3º Item e tentaremos criar um novo item com o número de índice 7 no novo local. Quando o item número 3 for excluído, o item número 4 em diante mudará para cima ou 4,5,6,7,8,9 se tornará 3,4,5,6,7,8 (para fazer todos os itens em sequência) ou quanto mais cedo item com número de índice 7 se tornará 6.

Quando criamos o novo Item com número de índice 7, o 7,8 existente se tornará 8,9 novamente. Quando observamos o movimento das linhas durante a exclusão e o tempo de criação da linha, o primeiro exemplo moverá a linha de destino para baixo para abrir caminho para o item de entrada. No segundo exemplo explicado (mover de 3 para 7) a linha de destino se moverá para cima.

Observação: Assista to valor de ID de funcionários para sua colocação como uma pista para ListItem se deslocando para baixo ou para cima quando reorganizamos ListItem.

Eu mencionei ListItem em todos os lugares em operações de arrastar e soltar. O ListItem refere-se apenas à primeira coluna da linha ListView. Outros valores de coluna são ListSubItems ou os itens filho do ListItem. Isso significa que você poderá arrastar e soltar apenas a primeira coluna. Outras colunas ou ListSubItems serão movidas para ListItem com código VBA.

Isso é verdade se você não ativou a FullRowSelection na folha de propriedades do controle ListView na seção Geral Aba.

Se habilitado, você pode selecionar qualquer coluna, mas o sistema se refere ao índice ListItem para fins de reordenação de linhas. Compare as duas imagens acima com outro conjunto de duas imagens de amostra, a terceira e a quarta imagens do topo desta página.

A ação Arrastar e Soltar não funcionará se os dois valores de propriedade a seguir não estiverem definidos na folha de propriedades do controle ListView em Geral Aba.:

• ccOLEDragAutomático =1
• ccOLEDropManual =1

SELECT [FirstName] & " " & [LastName] AS EmployeeName, 
Employees.ID, 
Employees.EmployeeID, 
Employees.TitleOfCourtesy, 
Employees.Title, 
Employees.Address, 
Employees.City, 
Employees.Region, 
Employees.PostalCode, 
Employees.Country, 
Employees.HomePhone, 
Employees.Extension, 
Employees.Notes
FROM Employees
ORDER BY Employees.ID;

O Form_Unload() Código VBA do procedimento de evento.

Private Sub Form_Unload(Cancel As Integer)
Dim lvItem As ListItem
Dim tmp As Long
Dim criteria As String
Dim strfield As String
Dim fld As String

If strTable = "" Then
Set lvwList = Nothing
    Exit Sub
End If

Set db = CurrentDb
Set rst = db.OpenRecordset(strTable, dbOpenDynaset)

For Each lvItem In lvwList.ListItems
    tmp = lvItem.Index
    strfield = lvwList.ColumnHeaders(1).Text 'EmployeeName
    criteria = strfield & " = " & Chr(34) & lvItem.Text & Chr(34)
    
    rst.FindFirst criteria
  
    If Not rst.NoMatch Then
       If (rst.Fields(strfield).Value = lvItem.Text) And (rst.Fields(1).Value = tmp) Then
         'GoTo nextitem
       Else
            rst.Edit
            rst.Fields(1).Value = tmp 'replace ID number
            rst.Update
       End If
    Else
        MsgBox "Item: " & tmp & " Not Found!"
    End If
Next
rst.Close

Set lvwList = Nothing
Set lvItem = Nothing
Set rst = Nothing
Set db = Nothing

End Sub

1. 
   O Texto do ListItem (primeira coluna) valor do parâmetro é o nome do funcionário e organizado em ordem alfabética.
   
2. 
   O ListItems no controle ListView tem números de índice de 1 a 9 na ordem em que é mostrado na tela, ou seja, o número de índice do primeiro item é 1 e o último é 9. Os dados originais no valor do campo Employees Table ID não são nesta ordem.
   
3. 
   Pegamos o Texto Valor (Employee Name) do primeiro ListItem e procure o nome na tabela.
   
4. 
   Quando o registro é encontrado, o número Index do ListItem atual é atualizado (substituído) no campo ID da tabela.
   
5. 
   Esse processo foi repetido para todos os registros restantes da tabela.
   

O Windows Explorer gosta do método de classificação.

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As Object)
' When a ColumnHeader object is clicked, the ListView control is
' sorted by the subitems of that column.

With Me.ListView1
' Set the SortKey to the Index of the ColumnHeader - 1
    .SortKey = ColumnHeader.Index - 1
    
 If .SortOrder = lvwAscending Then
    .SortOrder = lvwDescending
 Else
    .SortOrder = lvwAscending
 End If
 ' Set Sorted to True to sort the list.
     .Sorted = True
End With
End Sub

1. Tutorial de controle ActiveX ListView-01.
2. Tutorial de controle do ListView-02.
3. Atribuindo imagens a itens do ListView.
4. Eventos de classificação por arrastar e soltar do controle ListView
5. Controle de ListView com MS-Access TreeView
6. TreeView/ListView controla eventos de arrastar e soltar