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 38.844 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
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. |
Neu! sevDTA 3.0 Pro SEPA mit Kontonummernprüfung Erstellen von SEPA-Dateien mit integriertem BIC-Verzeichnis und Konto- nummern-Prüfverfahren, so dass ungültige Bankdaten bereits im Vorfeld ermittelt werden können. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 Access-Tools Vol.1 Über 400 MByte Inhalt Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB |
||||||||||||||||
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. |