Drag & Drop Demo Dieses Beispiel zeigt verschiedene Möglichkeiten, wie sich ein Programm mit einer Drag & Drop Funktion ausstatten lässt.
Autor:   Michael Schriever	Bewertung:     [ Jetzt bewerten ]	Views:  39.426
www.michael-schriever.de	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 39 Bewertung insgesamt: gut Durchschnittliche Bewertung: 3.5 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Dieser Code soll die Progammierung von DragAndDrop demonstrieren.

Auf einem Formular (frmMain) sind ein ListView (lvw), ein TreeView (tvw), ein Label (lblDaD) sowie ein RichTextField (rtf) positioniert.

Beispiel 1 zeigt, wie man Informationen aus einem ListView in einen TreeView bekommt. Dabei wird ein Label als Transfer-Control benutzt und die jeweiligen Tag-Eigenschaften zur Übertragung der Information. Das Beispiel ist leicht auf andere beteiligte Controls übertragbar.

Beispiel 2 zeigt, wie man Dateien aus z.B. dem Explorer in seine eigene Anwendung zieht.

Mit Beispiel 2.a kann mann Dateien vom Typ *.txt in das RichTextField ziehen, wo der Text dann angezeigt wird.

Mit Beispiel 2.b kann man registrierte Dateitypen (z.B. *.doc, *.zip) auf eine freie Fläche des Formulars ziehen, wobei die registrierte Anwendung für diesen Dateityp aufgeht und die anzeigt.

Option Explicit
 
Private Declare Function ShellExecute Lib "shell32.dll" _
  Alias "ShellExecuteA" ( _
  ByVal hWnd As Long, _
  ByVal lpOperation As String, _
  ByVal lpFile As String, _
  ByVal lpParameters As String, _
  ByVal lpDirectory As String, _
  ByVal nShowCmd As Long) As Long

Private Sub Form_Load()
  Call createTVW
  Call createLVW
 
  lvw.FullRowSelect = True
  lvw.SelectedItem.Selected = False
  lblDaD.Visible = False
 
  ' sonst findet das DragDrop-Ereignis in
  ' frmMain nicht statt
  Me.OLEDropMode = 1
End Sub

Private Sub createLVW()
  ' Aufbau des ListViews
  Dim li As ListItem
  Dim ch As ColumnHeader
 
  Set ch = lvw.ColumnHeaders.Add(, , _
    "EMail-Adresse", lvw.Width * 0.75)
  Set ch = lvw.ColumnHeaders.Add(, , _
    "Name", lvw.Width * 0.24)
 
  Set li = lvw.ListItems.Add(, , _
    "webmaster@michael-schriever.de")
  li.SubItems(1) = "Michael Schriever"
  li.Tag = li.SubItems(1) + "," + li.Text
 
  Set li = lvw.ListItems.Add(, , _
    "eric.warden@hotmail.com")
  li.SubItems(1) = "Eric Warden"
  li.Tag = li.SubItems(1) + "," + li.Text
 
  lvw.View = lvwReport
End Sub
 
Private Sub createTVW()
  ' Aufbau des TreeViews
  Dim nodX As Node
 
  Set nodX = tvw.Nodes.Add(, , "root", "root")
  Set nodX = tvw.Nodes.Add("root", tvwChild, "n1", "Node1")
  Set nodX = tvw.Nodes.Add("root", tvwChild, "n2", "Node2")
  Set nodX = tvw.Nodes.Add("root", tvwChild, "n3", "Node3")
 
  nodX.EnsureVisible
End Sub

Beispiel 1

Private Sub lvw_MouseDown(Button As Integer, Shift As Integer, _
  X As Single, Y As Single)
 
  ' Start der Drag-Operation bei linker Maustaste (Bsp. 1)
  Dim li As ListItem
 
  If Button <> vbLeftButton Then Exit Sub
 
  Set li = lvw.HitTest(X, Y)
 
  If li Is Nothing Then Exit Sub
 
  ' lblDaD positioniern
  lblDaD.Left = lvw.Left + X
  lblDaD.Top = lvw.Top + Y
  lblDaD.Width = 1000
 
  ' Übernahme der Information
  lblDaD.Tag = li.Tag
 
  ' Dragstart
  lblDaD.Drag
 
  Set li = Nothing
End Sub
 
Private Sub tvw_DragDrop(Source As Control, _
  X As Single, Y As Single)
 
  ' Drop über dem TreeView (Bsp. 1)
  Dim nodX As Node
  Dim s As String
  Dim sName As String
  Dim sEMail As String
  Dim pos As Long
 
  If Not (TypeOf Source Is Label) Then Exit Sub
  If Source.Name <> "lblDaD" Then Exit Sub
 
  Set nodX = tvw.HitTest(X, Y)
 
  If nodX Is Nothing Then Exit Sub
 
  ' root-Node nicht erlaubt
  If nodX.Key = "root" Then
      Set nodX = Nothing
      Exit Sub
  End If
 
  s = Source.Tag
 
  pos = InStr(1, s, ",")
  sName = Left(s, pos - 1)
  sEMail = Mid(s, pos + 1)
 
  ' Übername der Information
  nodX.Text = "Email-Adresse von " + sName + _
    " ist: " + sEMail
 
  Set nodX = Nothing
End Sub
 
Private Sub tvw_DragOver(Source As Control, X As Single, _
  Y As Single, State As Integer)
 
  ' HighLight des Nodes über dem man zieht (Bsp. 1)
 
  If Not (TypeOf Source Is Label) Then Exit Sub
  If Source.Name <> "lblDaD" Then Exit Sub
 
  Set tvw.DropHighlight = tvw.HitTest(X, Y)
End Sub

Beispiel 2.a

Private Sub rtf_OLEDragDrop(Data As RichTextLib.DataObject, _
  Effect As Long, Button As Integer, Shift As Integer, _
  X As Single, Y As Single)
 
  ' Drop *.txt-Datei über RichTextField (Bsp. 2.a)
  Dim s As String
 
  If Data.Files.Count = 0 Then Exit Sub
 
  s = Data.Files(1)
  If UCase(Right(s, 3)) <> "TXT" Then Exit Sub
 
  rtf.LoadFile s
End Sub

Beispiel 2.b

Private Sub Form_OLEDragDrop(Data As DataObject, _
  Effect As Long, Button As Integer, Shift As Integer, _
  X As Single, Y As Single)
 
  ' Drop *.* Datei über frmMain (Bsp. 2.b)
  Dim ret As Long
  Dim s As String
 
  If Data.Files.Count = 0 Then Exit Sub
 
  s = Data.Files(1)
  ret = ShellExecute(0, "open", s, 0, 0, vbNormalFocus)
 
  If ret <= 32 Then
    MsgBox "Datei konnte nicht geöffnet werden !", vbInformation
  End If
End Sub