vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
TOP-Angebot: 17 bzw. 24 Entwickler-Vollversionen zum unschlagbaren Preis!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik:    |   VB-Versionen: VB4, VB5, VB605.06.02
Zwei ListView-Items gekonnt vertauschen

Dieser Code zeigt, wie sich zwei mehrspaltige ListView-Einträge unter Berücksichtigung aller Festlegungen miteinander vertauschen lassen.

Autor:  Dieter OtterBewertung:     [ Jetzt bewerten ]Views:  1.420 
http://www.tools4vb.de/System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt 

Setzen Sie auch das Microsoft ListView-Control ein? Ist ja schließlich ein hervorragendes Control, um mal eben schnell eine mehrspaltige Liste zu erstellen. In einem unserer früheren Extra-Tipps haben wir Ihnen gezeigt, wie man solche mehrspaltigen Einträge mit nur einer Anweisung schnell hinzufügen kann. Was aber nun, wenn man zwei (mehrspaltige) Einträge miteinander vertauschen will oder einfach nur den gerade selektierten Eintrag per Buttonclick nach oben oder nach unten verschieben möchte?

Klar, man könnte jetzt hergehen und den zu verschiebenden Eintrag zunächst aus der Liste löschen, um ihn dann an der gewünschten Position neu einzufügen. Das gleiche dann für den zweiten Eintrag, was sich auch alles noch in Grenzen hält, solange es sich nicht um mehrspaltige Einträge handelt und keinerlei Icons (Symbole) und Farb-Einstellungen berücksichtigt werden müssen.

Wie Sie es aber vom vb@rchiv gewohnt sind, haben wir auch für dieses Problem wieder einmal einen passenden Tipp (Code) parat

Vorgehensweise:
Alle Informationen der beiden ListView-Einträge (Text, Icons, SubItems, Farben) speichern wir temporär in einem benutzerdefinierten Datentyp (UDT) und vertauschen anschließend die beiden UDTs miteinander.

Das ganze sieht dann so aus:

' UDT - Benutzerdefinierte Datentypen
' zum Speichern eines ListView-Items
Private Type UDT_SubItem
  Bold As Boolean
  ForeColor As Long
  Key As String
  ReportIcon As Long
  Tag As Variant
  Text As String
  ToolTipText As String
End Type
 
Private Type UDT_ListItem
  Bold As Boolean
  Checked As Boolean
  ForeColor As Long
  Ghosted As Boolean
  Icon As Long
  Key As String
  Selected As Boolean
  SmallIcon As Long
  Tag As Variant
  Text As String
  ToolTipText As String
  SubItems() As UDT_SubItem
End Type
' Zwei ListView-Items miteinander vertauschen
Private Sub lvwSwap(itemX As ListItem, itemY As ListItem)
  Dim UDT_ItemX As UDT_ListItem
  Dim UDT_ItemY As UDT_ListItem
  Dim sKey As String
 
  ' List-Items in UDT-Datentyp speichern
  UDT_ItemX = lvwItem_To_UDT(itemX)
  UDT_ItemY = lvwItem_To_UDT(itemY)
 
  ' Achtung! Key-Wert muss temporär geändert, da es
  ' sonst zum Fehler "Doppelter schlüssel in Auflistung"
  ' kommen kann
  sKey = UDT_ItemY.Key: UDT_ItemY.Key = "~temp"
 
  ' ItemX und ItemY vertauschen
  lvwUDT_To_Item itemX, UDT_ItemY
  lvwUDT_To_Item itemY, UDT_ItemX
 
  ' Key-Werte wiederherstellen
  itemX.Key = sKey
End Sub
' Kopie eines LisView-Items erstellen
Private Function lvwItem_To_UDT(oItem As ListItem) _
  As UDT_ListItem
 
  Dim I As Integer
 
  With lvwItem_To_UDT
    ' Eigenschaften
    .Bold = oItem.Bold
    .Checked = oItem.Checked
    .ForeColor = oItem.ForeColor
    .Ghosted = oItem.Ghosted
    .Icon = oItem.Icon
    .Key = oItem.Key
    .Selected = oItem.Selected
    .SmallIcon = oItem.SmallIcon
    .Tag = oItem.Tag
    .Text = oItem.Text
    .ToolTipText = oItem.ToolTipText
 
    ' SubItems
    ReDim .SubItems(oItem.ListSubItems.Count)
    For I = 1 To oItem.ListSubItems.Count
      With .SubItems(I)
        .Bold = oItem.ListSubItems(I).Bold
        .ForeColor = oItem.ListSubItems(I).ForeColor
        .Key = oItem.ListSubItems(I).Key
        .ReportIcon = oItem.ListSubItems(I).ReportIcon
        .Tag = oItem.ListSubItems(I).Tag
        .Text = oItem.ListSubItems(I).Text
        .ToolTipText = oItem.ListSubItems(I).ToolTipText
      End With
    Next I
  End With
End Function
' UDT-Datentyp nach Item
Private Sub lvwUDT_To_Item(oItem As ListItem, _
  UDT_Item As UDT_ListItem)
 
  Dim I As Integer
 
  With UDT_Item
    ' Eigenschaften
    oItem.Bold = .Bold
    oItem.Checked = .Checked
    oItem.ForeColor = .ForeColor
    oItem.Ghosted = .Ghosted
    oItem.Icon = .Icon
    oItem.Key = .Key
    oItem.Selected = .Selected
    oItem.SmallIcon = .SmallIcon
    oItem.Tag = .Tag
    oItem.Text = .Text
    oItem.ToolTipText = .ToolTipText
 
    ' SubItems
    For I = 1 To oItem.ListSubItems.Count
      With .SubItems(I)
        oItem.ListSubItems(I).Bold = .Bold
        oItem.ListSubItems(I).ForeColor = .ForeColor
        oItem.ListSubItems(I).Key = .Key
        oItem.ListSubItems(I).ReportIcon = .ReportIcon
        oItem.ListSubItems(I).Tag = .Tag
        oItem.ListSubItems(I).Text = .Text
        oItem.ListSubItems(I).ToolTipText = .ToolTipText
      End With
    Next I
  End With
End Sub

Vertauschen zweier ListView-Einträge
Nach so viel Code, nun ein kleines Beispiel. Über zwei Schaltflächen (cmdUp und cmdDown) soll der aktuell selektierte ListView-Eintrag um eine Position nach oben bzw. nach unten verschoben werden.

' nach oben verschieben
Private Sub lvw_MoveUp()
  Dim oItem_x As ListItem
  Dim oItem_y As ListItem
  Dim Index As Integer
 
  With ListView1
    If Not .SelectedItem Is Nothing Then
      Index = .SelectedItem.Index
      If Index > 1 Then
        Set oItem_x = .ListItems(Index)
        Set oItem_y = .ListItems(Index - 1)
        lvwSwap oItem_x, oItem_y
      End If
    End If
  End With
End Sub
' nach unten verschieben
Private Sub lvw_MoveDown()
  Dim oItem_x As ListItem
  Dim oItem_y As ListItem
  Dim Index As Integer
 
  With ListView1
    If Not .SelectedItem Is Nothing Then
      Index = .SelectedItem.Index
      If Index < .ListItems.Count Then
        Set oItem_x = .ListItems(Index)
        Set oItem_y = .ListItems(Index + 1)
        lvwSwap oItem_x, oItem_y
      End If
    End If
  End With
End Sub
Private Sub cmdUp_Click()
  lvw_MoveUp
End Sub
 
Private Sub cmdDown_Click()
  lvw_MoveDown
End Sub