vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
NEU! sevCoolbar 3.0 - Professionelle Toolbars im modernen Design!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2019
 
zurück
Rubrik: Maus & Tastatur · Drag & Drop   |   VB-Versionen: VB5, VB625.07.02
Drag & Drop Demo

Dieses Beispiel zeigt verschiedene Möglichkeiten, wie sich ein Programm mit einer Drag & Drop Funktion ausstatten lässt.

Autor:   Michael SchrieverBewertung:     [ Jetzt bewerten ]Views:  35.135 
www.michael-schriever.deSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

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

Dieser Tipp wurde bereits 35.135 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-2019 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