Rubrik: Maus & Tastatur · Drag & Drop | VB-Versionen: VB5, VB6 | 25.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 Schriever | Bewertung: | Views: 38.838 |
www.michael-schriever.de | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | 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