VB-Homepage Tipp 090

per Drag und Drop Einträge in eine Listbox einfügen

Ein sicherlich interessanter Tipp, mit dem sich sogenanntes Drag and Drop
( zu deutsch : ziehen und fallenlassen ) für eigene Projekte auch schon unter VB3 einsetzen läßt.
Im Beispiel ist ein Image-Objekt als Drag&Drop Objekt definiert, das in eine Listbox gezogen und abgelegt wird. An der jeweiligen Stelle wird ein neuer Eintrag generiert, der auch noch die Nummer des Eintrags enthält.
Vorstellbar in der Praxis wäre zum Beispiel alle Anwendungen, in denen der Benutzer aus einer Anzahl Möglichkeiten, seine eigene Auswahl treffen soll.

Draglist.mak
DRAGLIST.FRM
ProjWinSize=99,544,248,215
ProjWinShow=2
IconForm="Form1"
Title="DRAGDROP"
ExeName="DRAGLIST.EXE"

Draglist.frm
VERSION 2.00
Begin Form Form1
Caption = "VB-Homepage Tipp"
ClientHeight = 2820
ClientLeft = 3465
ClientTop = 2865
ClientWidth = 5355
Height = 3225
Left = 3405
LinkTopic = "Form1"
ScaleHeight = 2820
ScaleWidth = 5355
Top = 2520
Width = 5475
Begin ListBox List1
Height = 1005
Left = 120
TabIndex = 0
Top = 120
Width = 5055
End
Begin Label Label3
Caption = "Aufgespürt bei COBBS/Inside VB"
Height = 255
Left = 120
TabIndex = 3
Top = 2280
Width = 5055
End
Begin Label Label2
Caption = "Image anklicken und in der Liste ablegen"
Height = 255
Left = 600
TabIndex = 2
Top = 1440
Width = 3735
End
Begin Label Label1
Caption = "Einfügen eines Datensatzes mit Drag and Drop"
Height = 255
Left = 120
TabIndex = 1
Top = 2040
Width = 5055
End
Begin Image Image1
BorderStyle = 1 'Fixed Single
DragMode = 1 'Automatic
Height = 360
Left = 120
Top = 1440
Width = 390
End
End
Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
Const LB_GETTOPINDEX = &H400 + 15
Sub Form_Load ()
Dim iX As Integer
Me.Show
'Auffüllen der Listbox mit Werten
For iX = 1 To 10
List1.AddItem "Item " & CStr(iX)
Next
End Sub
Sub List1_DragDrop (Source As Control, X As Single, Y As Single)
Dim lTop As Long
Dim iItemHeight As Integer
Dim iInsertPos As Long
lTop = SendMessage(List1.hWnd, LB_GETTOPINDEX, 0&, 0&)
iItemHeight = TextHeight("A ")
iInsertPos = Y \ iItemHeight
If iInsertPos <= List1.ListCount Then
List1.AddItem "This is inserted @" + Format$(iInsertPos + lTop, "0"), iInsertPos + lTop
Else
List1.AddItem "This is inserted"
End If
End Sub
Sub List1_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
Static iClickTwo As Integer
Static sDropText As String
Dim iRowHeight As Integer
Dim iTop As Integer
Dim iInsert As Integer
iTop = SendMessage(List1.hWnd, LB_GETTOPINDEX, 0&, 0&)
iRowHeight = TextHeight("X")
iInsert = Y \ iRowHeight
'Mit Benutzung der rechten Maustaste kann Datensatz gelöscht werden
If Button = 2 And sDropText = "" And iClickTwo = False Then
List1.ListIndex = iInsert + iTop
sDropText = List1.Text
MousePointer = 10
iClickTwo = True
List1.RemoveItem iInsert + iTop
ElseIf Button = 2 And Len(sDropText) > 2 And iClickTwo = True Then
If iInsert + iTop < List1.ListCount - 1 Then
List1.AddItem sDropText, iInsert + iTop
Else
List1.AddItem sDropText, iInsert + iTop + 1
End If
sDropText = ""
iClickTwo = False
MousePointer = 0
End If
End Sub

Um den Code zu nutzen, erstellen Sie sich mit einem Editor (ZBsp. Notepad) Dateien, die Sie wie beschrieben benennen und den jeweiligen Code hinein kopieren.
Rufen Sie dann die *.mak Datei aus dem Dateimanager auf oder starten Ihr VB-Programm und öffnen das Projekt.

Tipp-Download

Quelle :

Zurück zur Übersichtsseite