Rubrik: Controls · ListBox | VB-Versionen: VB4, VB5, VB6 | 20.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 Meier | Bewertung: | Views: 12.970 |
ohne Homepage | System: 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.