vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Zippen wie die Profis!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: Controls · ListBox   |   VB-Versionen: VB4, VB5, VB620.01.04
Mehrere Listboxeinträge gleichzeitig verschieben

Dieser Tipp zeigt einen Weg, wie sich mehrere markierte ListBox-Einträge gleichzeitig mit der Maus verschieben lassen.

Autor:   Hans MeierBewertung:     [ Jetzt bewerten ]Views:  12.942 
ohne HomepageSystem:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

Bis jetzt war es ziemlich einfach einen Listboxeintrag per Maus innerhalb der Listbox zu verschieben. Doch wollte man mehrere Einträge verschieben, konnte das Verschieben ziemlich zeitaufwendig werden.

Mit nachfolgendem Code ist es möglich, mehrere ausgewählte Einträge gleichzeitig zu verschieben.

Um das Beispiel auszuprobieren, brauchen Sie eine Form mit einer Listbox "List1" und der Eigenschaft "Multiselec = 1- einfach".

Option Explicit
 
' Benötigte Variablen
Dim mark() As Long
Dim nIndex As Long
Dim newIndex As Long
Dim clickindex As Long
Dim mclick As Boolean
Dim shiftpress As Boolean
Dim min As Long
Dim max As Long
Private Sub Form_Load()
  ' ein paar Testeinträge erstellen
  Dim mal As Long
  For mal = 1 To 40
    List1.AddItem "Eintrag " & mal
  Next
 
  ReDim mark(0)
  mark(0) = -1
End Sub
Private Sub clearmark()
  ' hebt die Markierung aller Einträge in der Listbox auf
  Dim zahler As Single
  For zahler = 0 To List1.ListCount - 1
    List1.Selected(zahler) = False
  Next
End Sub
Private Sub setmark()
  ' setzt die Markierung der tatäschlich ausgewählten
  ' Einträge in der Listbox
  Dim zahler As Single
  For zahler = 1 To UBound(mark)
    List1.Selected(mark(zahler)) = True
  Next
End Sub
Private Sub List1_MouseDown(Button As Integer, Shift As Integer, _
  X As Single, Y As Single)
 
  ' Wenn die linke Maustaste gedrückt wurde
  If Button = 1 Then
    If mclick = False Then markadd (List1.ListIndex)
    nIndex = List1.ListIndex
    clickindex = List1.ListIndex
 
    ' wenn die Shifttaste beim Markieren gedrückt ist soll
    ' die Markierung der anderen Einträge nicht verloren gehen
    If Shift = 1 Then
      shiftpress = True
    Else
      shiftpress = False
      If mclick = False Then
        ReDim mark(0)
        mark(0) = -1
        markadd (List1.ListIndex)
        clearmark
        List1.Selected(List1.ListIndex) = True
      End If
    End If
    mclick = True
    setmark
  End If
End Sub
Private Sub List1_MouseMove(Button As Integer, Shift As Integer, _
  X As Single, Y As Single)
 
  Dim dummy As String
  Dim i As Single
  Dim k As Single
 
  If mclick = True Then
    newIndex = List1.ListIndex
    ' wenn sich der aktuelle Listindex zu dem Listindex
    ' geändert hat, der aktuell war, als die Maustaste
    ' gedrückt wurde
    If newIndex <> nIndex Then
      Select Case newIndex
        ' Eintrag wird nach oben in der Liste verschoben
        Case Is < nIndex
          ' wenn der oberste markierte Eintrag aus der
          ' Listbox geschoben werden würde
          If min - 1 < 0 Then
            zeug (True)
            Exit Sub
          End If
          For i = 1 To UBound(mark)
            dummy = List1.List(mark(i) - 1)
            List1.List(mark(i) - 1) = List1.List(mark(i))
            List1.List(mark(i)) = dummy
            mark(i) = mark(i) - 1
          Next
 
        ' Eintrag wird nach unten in der Liste verschoben
        Case Is > nIndex
          ' wenn der unterste markierte Eintrag aus der
          ' Listbox geschoben werden würde
          If max + 1 > List1.ListCount - 1 Then
            zeug (True)
            Exit Sub
          End If
 
          For k = 1 To UBound(mark)
            i = UBound(mark) - k + 1
            dummy = List1.List(mark(i) + 1)
            List1.List(mark(i) + 1) = List1.List(mark(i))
            List1.List(mark(i)) = dummy
            mark(i) = mark(i) + 1
          Next
      End Select
 
      zeug (True)
    End If
  End If
End Sub
Private Sub List1_MouseUp(Button As Integer, Shift As Integer, _
  X As Single, Y As Single)
 
  ' wenn die linke Maustaste wieder losgelassen wurde
  If Button = 1 Then mclick = False: clickindex = 0
End Sub
Private Sub zeug(markierung As Boolean)
  nIndex = newIndex
  If markierung = True Then
    clearmark
    setmark
  End If
 
  ' kleinster und größter markierter Eintrag
  ' in der Listbox ermitteln
  min = mark(1)
  max = mark(UBound(mark))
  List1.ListIndex = newIndex
  Call List1_MouseDown(1, shiftpress * -1, 0, 0)
End Sub
Private Function IsSelected(wo As Single)
  ' wie der Name schon, sagt gibt die Funktion
  ' zurück, ob ein bestimmter Eintrag markiert
  ' ist oder nicht
  Dim mal As Single
 
  IsSelected = -1
  If UBound(mark) = 0 Then Exit Function
  For mal = 1 To UBound(mark)
    If mark(mal) = wo Then IsSelected = mal: Exit For
  Next
End Function
Private Sub markadd(wo As Single)
  Dim dummy As Single
  Dim position As Single
  Dim zahler As Single
  Dim mal As Single
 
  position = IsSelected(wo)
 
  ' wenn der Eintrag noch nicht im Array ist
  If position = -1 Then
    ' Array um eins erhöhen, weil ja eine Zahl mehr reinkommt
    ReDim Preserve mark(UBound(mark) + 1)
 
    ' wenn jetzt das Array max 1 (also zwei Einträge hat)
    If UBound(mark) = 1 Then
      mark(1) = wo
    Else
      zahler = 0
      Do
        zahler = zahler + 1
        If mark(zahler) > wo Then
          dummy = mark(zahler)
          mark(zahler) = wo
          For mal = UBound(mark) To zahler + 1 Step -1
            mark(mal) = mark(mal - 1)
          Next
          mark(zahler + 1) = dummy
          Exit Do
        End If
 
        ' wenn durchgelaufen: wo = letzter Eintrag
        If zahler >= UBound(mark) Then
          mark(UBound(mark)) = wo
          Exit Do
        End If
      Loop
    End If
 
  ' Eintrag ist bereits im Array vorhanden
  Else
    ' Listindex muss immer markiert sein
    If wo <> newIndex Then
      If position < UBound(mark) Then
        For mal = position To UBound(mark) - 1
          mark(mal) = mark(mal + 1)
        Next
      End If
      ReDim Preserve mark(UBound(mark) - 1)
    End If
  End If
End Sub

Starten Sie das Projekt, klicken auf einen List-Eintrag und markieren weitere Einträge, indem Sie beim Mausklick die Umschalttaste gedrückt halten. Halten Sie die Umschalttaste weiterhin gedrückt und ziehen die markierten Einräge nun nach oben oder nach unten, um diese innerhalb der ListBox zu verschieben.
 

Dieser Tipp wurde bereits 12.942 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel