請教：如何實現在vb中拖曳控件（如listView）到windows資料夾，取得資料夾的路徑？

[scott21cn]

???

[scott21cn]

up!

[sonicdater]

Display a directory structure in a ListView, and save and restore the structure in a file
=========================================
Option Explicit

Dim fnode As node
Dim FIndent As Integer
Dim FIndex As Integer
Dim StrtPath As String

Private Sub Get_Files(FPath As String)
Dim file_name As String
Dim File_Path As String
Dim File_Read As Integer
Dim x As Boolean, xTemp As Integer, S$
Dim I As Integer
On Error Resume Next
FIndent = FIndent + 1
File_Path = FPath & "\"
file_name = Dir$(File_Path, vbDirectory)
File_Read = 1
x = False

Do While file_name <> ""
If file_name <> "." And file_name <> ".." Then
If GetAttr(File_Path & file_name) <> vbDirectory Then

FIndex = FIndex + 1


Else
StrtPath = File_Path & file_name

Set fnode = TreeView1.Nodes.Add(File_Path, tvwChild, FPath & "\", file_name)

'changed to dash/hyphen for readability
Text1.Text = Text1.Text & "->" & String(FIndent * FIndent, "_") & file_name & vbCrLf
S$ = ""
''possible hack ; if FIndent=1 this doesn't execute
For xTemp = 2 To FIndent
S$ = S$ & vbTab
Next
'write to a file; number of levels= number of tabs
Print #1, S$ & file_name

FIndex = FIndex + 1
x = True
'recursive call
Get_Files StrtPath

End If

End If
If x = True Then
file_name = Dir$(File_Path, vbDirectory)
For I = 2 To File_Read
file_name = Dir$
Next
x = False
End If
file_name = Dir$
File_Read = File_Read + 1

Loop
FIndent = FIndent - 1

End Sub


Private Sub cmdGo_Click()
Dim x As Integer, S$
Dim file_name As String

file_name = App.Path
If Right$(file_name, 1) <> "\" Then file_name = file_name & "\"
Open file_name & "Mytest.txt" For Output As #1

Text1.Text = ""
TreeView1.Nodes.Clear

file_name = txtPath.Text
If Right$(file_name, 1) <> "\" Then file_name = file_name & "\"

Text1.Text = Text1.Text & file_name & vbCrLf
' need \ on end of key here------------|
Set fnode = TreeView1.Nodes.Add(, , file_name, file_name)
'initial data to file; topmost root of tree
Print #1, file_name
'initialise variables
FIndent = 1
FIndex = 0
Text1.Visible = False
TreeView1.Visible = False
LblPrompt.Caption = "Processing drive..."
LblPrompt.Refresh
'note does not end with '\'
StrtPath = Left$(file_name, Len(file_name) - 1)
'start the directory reading
Get_Files StrtPath
Text1.Visible = True
TreeView1.Visible = True
LblPrompt.Caption = "Finished"

Close 1

End Sub

Private Sub Command1_Click()
Dim file_name As String

'read in the file to a tree
TreeView2.Visible = False

file_name = App.Path
If Right$(file_name, 1) <> "\" Then file_name = file_name & "\"
LoadTreeViewFromFile file_name & "Mytest.txt", TreeView2

TreeView2.Visible = True
End Sub

Private Sub Drive1_Change()
' Dim x As Integer, S$
' Open App.Path & "\" & "Mytest.txt" For Output As #1
'
' Text1.Text = ""
' TreeView1.Nodes.Clear
'
' Text1.Text = Text1.Text & Left$(Drive1.Drive, 2) & "\" & vbCrLf
' ' need \ on end of key here------------|
' Set fnode = TreeView1.Nodes.Add(, , Left$(Drive1.Drive, 2) & "\", Left$(Drive1.Drive, 2) & "\")
' 'initial data to file; topmost root of tree
' Print #1, Left$(Drive1.Drive, 2) & "\"
' 'initialise variables
' FIndent = 1
' FIndex = 0
' Text1.Visible = False
' TreeView1.Visible = False
' LblPrompt.Caption = "Processing drive..."
' LblPrompt.Refresh
' 'note does not end with '\'
' StrtPath = Left$(Drive1.Drive, 2)
' 'start the directory reading
' Get_Files StrtPath
' Text1.Visible = True
' TreeView1.Visible = True
' LblPrompt.Caption = "Finished"
'
' Close 1
End Sub

Private Sub Form_Load()
Dim path_name As String

path_name = App.Path
If Right$(path_name, 1) <> "\" Then path_name = path_name & "\"
txtPath.Text = path_name

Show
End Sub

Private Sub Form_Unload(Cancel As Integer)
'maynot be necessary
Close #1
End Sub

Private Sub LoadTreeViewFromFile(ByVal file_name As String, ByVal trv As TreeView)
Dim fnum As Integer
Dim text_line As String
Dim level As Integer
Dim tree_nodes() As node
Dim num_nodes As Integer

fnum = FreeFile
Open file_name For Input As fnum

trv.Nodes.Clear
Do While Not EOF(fnum)
' Get a line.
Line Input #fnum, text_line

' Find the level of indentation.
level = 1
Do While Left$(text_line, 1) = vbTab
level = level + 1
text_line = Mid$(text_line, 2)
Loop

' Make room for the new node.
If level > num_nodes Then
num_nodes = level
ReDim Preserve tree_nodes(1 To num_nodes)
End If

' Add the new node.
If level = 1 Then
Set tree_nodes(level) = trv.Nodes.Add(, , , text_line)
Else
Set tree_nodes(level) = trv.Nodes.Add(tree_nodes(level - 1), tvwChild, , text_line)
'tons faster without this
''tree_nodes(level).EnsureVisible
End If
Loop

Close fnum

End Sub


Private Sub TreeView1_Click()
On Error GoTo ehandler
Dim node As New node
Set node = TreeView1.SelectedItem
TreeView1.ToolTipText = node.Key
Exit Sub
ehandler:
MsgBox Err.Description & ":" & Err.Number & ":" & Err.LastDllError
End Sub

Private Sub TreeView1_KeyPress(KeyAscii As Integer)
Dim node As New node, fnode As New node

If KeyAscii = vbKeyReturn Then
Set node = TreeView1.SelectedItem
Open App.Path & "\" & "Mytest.txt" For Output As #1

Text1.Text = ""
TreeView1.Nodes.Clear

Text1.Text = Text1.Text & node.Key & vbCrLf
Set fnode = TreeView1.Nodes.Add(, , node.Key, node.Key)

'initial data to file; topmost root of tree
Print #1, node.Key

FIndent = 1
FIndex = 0
Text1.Visible = False
TreeView1.Visible = False
LblPrompt.Caption = "Processing drive..."
LblPrompt.Refresh
'note does not end with '\';item key does end with \
StrtPath = Mid$(node.Key, 1, Len(node.Key) - 1)

'start the directory reading
Get_Files StrtPath
Text1.Visible = True
TreeView1.Visible = True
LblPrompt.Caption = "Finished"
Close #1
End If

End Sub

[sonicdater]

这是 TreeView.的例子， 你参考一下：
===============================================================
Option Explicit

Private Enum ObjectType
otNone = 0
otFactory = 1
otGroup = 2
otPerson = 3
otFactory2 = 4
otGroup2 = 5
otPerson2 = 6
End Enum

Private SourceNode As Object
Private SourceType As ObjectType
Private TargetNode As Object
' ***********************************************
' Return the node's object type.
' ***********************************************
Private Function NodeType(test_node As Node) As ObjectType
If test_node Is Nothing Then Exit Function
Select Case Left$(test_node.Key, 1)
Case "f"
NodeType = otFactory
Case "g"
NodeType = otGroup
Case "p"
NodeType = otPerson
End Select
End Function
' ***********************************************
' Prepare the ImageList and TreeView controls.
' ***********************************************
Private Sub Form_Load()
Dim i As Integer
Dim factory As Node
Dim group As Node
Dim person As Node

' Load pictures into the ImageList.
For i = 1 To 6
TreeImages.ListImages.Add , , TreeImage(i).Picture
Next i

' Attach the TreeView to the ImageList.
OrgTree.ImageList = TreeImages

' Create some nodes.
Set factory = OrgTree.Nodes.Add(, , "f R & D", "R & D", otFactory, otFactory2)
Set group = OrgTree.Nodes.Add(factory, tvwChild, "g Engineering", "Engineering", otGroup, otGroup2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Cameron, Charlie", "Cameron, Charlie", otPerson, otPerson2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Davos, Debbie", "Davos, Debbie", otPerson, otPerson2)
person.EnsureVisible
Set group = OrgTree.Nodes.Add(factory, tvwChild, "g Test", "Test", otGroup, otGroup2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Able, Andy", "Andy, Able", otPerson, otPerson2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Baker, Betty", "Baker, Betty", otPerson, otPerson2)
person.EnsureVisible

Set factory = OrgTree.Nodes.Add(, , "f Sales & Support", "Sales & Support", otFactory, otFactory2)
Set group = OrgTree.Nodes.Add(factory, tvwChild, "g Showroom Sales", "Showroom Sales", otGroup, otGroup2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Gaines, Gina", "Gaines, Gina", otPerson, otPerson2)
person.EnsureVisible
Set group = OrgTree.Nodes.Add(factory, tvwChild, "g Field Service", "Field Service", otGroup, otGroup2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Helms, Harry", "Helms, Harry", otPerson, otPerson2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Ives, Irma", "Ives, Irma", otPerson, otPerson2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Jackson, Josh", "Jackson, Josh", otPerson, otPerson2)
person.EnsureVisible
Set group = OrgTree.Nodes.Add(factory, tvwChild, "g Customer Support", "Customer Support", otGroup, otGroup2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Klug, Karl", "Klug, Karl", otPerson, otPerson2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Landau, Linda", "Landau, Linda", otPerson, otPerson2)
person.EnsureVisible
End Sub
' ***********************************************
' Make the TreeView as large as possible.
' ***********************************************
Private Sub Form_Resize()
OrgTree.Move 0, 0, ScaleWidth, ScaleHeight
End Sub


' ***********************************************
' Save the node pressed so we can drag it later.
' ***********************************************
Private Sub OrgTree_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Set SourceNode = OrgTree.HitTest(x, y)
End Sub

' ***********************************************
' Start a drag if one is not in progress.
' ***********************************************
Private Sub OrgTree_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If SourceNode Is Nothing Then Exit Sub

If Button = vbLeftButton Then
' Start a new drag. Note that we do not get
' other MouseMove events while the drag is
' in progress.

' See what node we are dragging.
SourceType = NodeType(SourceNode)

' Select this node. When no node is highlighted,
' this node will be displayed as selected. That
' shows where it will land if dropped.
Set OrgTree.SelectedItem = SourceNode

' Set the drag icon for this source.
OrgTree.DragIcon = IconImage(SourceType)
OrgTree.Drag vbBeginDrag
End If
End Sub
' ***********************************************
' The user is dropping. See if the drop is valid.
' ***********************************************
Private Sub OrgTree_DragDrop(Source As Control, x As Single, y As Single)
If SourceNode Is Nothing Then Exit Sub

If Not (OrgTree.DropHighlight Is Nothing) Then
' It's a valid drop. Set source node's
' parent to be the target node.
Set SourceNode.Parent = OrgTree.DropHighlight
Set OrgTree.DropHighlight = Nothing
End If

Set SourceNode = Nothing
SourceType = otNone
End Sub
' ***********************************************
' The mouse is being dragged over the control.
' Highlight the appropriate node.
' ***********************************************
Private Sub OrgTree_DragOver(Source As Control, x As Single, y As Single, State As Integer)
Dim target As Node
Dim highlight As Boolean

If SourceNode Is Nothing Then Exit Sub

' See what node we're above.
Set target = OrgTree.HitTest(x, y)

' If it's the same as last time, do nothing.
If target Is TargetNode Then Exit Sub
Set TargetNode = target

highlight = False
If Not (TargetNode Is Nothing) Then
' See what kind of node were above.
If NodeType(TargetNode) + 1 = SourceType Then _
highlight = True
End If

If highlight Then
Set OrgTree.DropHighlight = TargetNode
Else
Set OrgTree.DropHighlight = Nothing
End If
End Sub

[gameboy999]

???是拖放一个资料夹到listview吧?!下面代码可以实现

Private Sub List1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo errorhandle
Dim i As Integer
i = 1
Do
List1.AddItem Data.Files(i)
i = i + 1
Loop
Exit Sub
errorhandle:

End Sub

[scott21cn]

to:gameboy999
不對，我要根據listView中所指的文件名從數據庫中把文件image拖放到桌面資料夾上，并建立！