我想用vb实现类似windows资源管理器的程序

该如何实现啊??vb自带的那个文件列表控件不好用啊,而且样子比较丑,在里面又不可以显示图标,大家有什么好的建议啊??
[58 byte] By [cyberkit-木子] at [2008-2-12]
# 1
用向导生成一个资源管理器的界面,在相应的地方加入实现的功能。
# 2
Option Explicit
Private mNode As node ' 模块级节点变量。
Private mItem As ListItem ' 模块级列表项变量。
Private EventFlag As Integer ' 标记所发生的事件。
Private mCurrentIndex As Integer ' 设置标志保证这个节点没有被单击。
Private mStatusBarStyle As Integer ' 切换状态栏样式。
Private cn As ADODB.Connection ' 我们仅仅使用一个活动的连接。

Const PUBLISHER = 1 ' 对于 EventFlag, 标记发行商 colmunheader 对象。
Const TITLE = 2 ' EventFlag, 在 ListView 中标记标题
Private Sub cmdLoad_Click()
Dim intCounter As Integer ' Counter to set Progressbar.Value
Dim intIndex ' Variable for index of current node.
' 设置 ADODB 连接对象的连接字符串并且打开它。

' 创建 ADODB 记录集对象变量。
Dim rsPublishers As New ADODB.Recordset
' 打开记录集。
With rsPublishers
.Open "SELECT PubID, [Company Name] FROM Publishers", cn, adOpenStatic, adLockOptimistic
' 移动到记录尾部获得记录号,然后返回。
.MoveLast
.MoveFirst
End With
' 将进程栏设置为最大,并且使它可视。
With prgLoad
.Max = rsPublishers.RecordCount
.Visible = True
End With

' 当此记录不是最后一条记录时,添加 ListItem 对象。
' 为 ListItem 对象的文本使用 Name 字段。
Do While Not rsPublishers.EOF
intCounter = intCounter + 1
prgLoad.Value = intCounter ' 更新进程栏。

' 添加节点到 TreeView, 并且设置它的属性。
Set mNode = tvwDB.Nodes.Add(1, tvwChild, rsPublishers!pubID & " ID", CStr(rsPublishers![Company name]), "closed")
mNode.Tag = "Publisher" ' 标识此表。

' 设置变量 intIndex 到新创建的节点的 Index 属性。
' 使用此变量添加子节点对象到现在的节点。
intIndex = mNode.Index

rsPublishers.MoveNext ' 移动到下一个出版商记录。
Loop
' 隐藏进程栏
prgLoad.Visible = False
' 将状态栏样式设置为标准。
sbrDB.Style = sbrNormal
' 对出版商节点进行排序。
tvwDB.Nodes(1).Sorted = True
' 扩展顶节点。
tvwDB.Nodes(1).Expanded = True

End Sub

Private Sub cmbView_Click()
' 设置 ListView.View 属性。
lvwDB.View = cmbView.ListIndex
End Sub

Private Function FindBiblio() As String
On Error GoTo ErrHandler

' 在 Biblio.mdb 不能找到的情况下,配置命令对话框。
With dlgDialog
.DialogTitle = "不能找到 Biblio.mdb"
.Filter = "(*.MDB)|*.mdb"
End With

'如果用户点击“取消”按钮将导致错误。
dlgDialog.CancelError = True
dlgDialog.ShowOpen

Do While UCase(Right(Trim(dlgDialog.FileName), 10)) <> "BIBLIO.MDB"
MsgBox "文件名称与 BIBLIO.MDB 不符。"
dlgDialog.ShowOpen
Loop

FindBiblio = dlgDialog.FileName
Exit Function
ErrHandler:
If Err = 32755 Then
End
End If
End Function

Private Sub Form_Load()

' 首先打开全局的 Connection 对象。
On Error GoTo errFind
Set cn = New ADODB.Connection
' ConnectionString 包含数据库路径。如果
' Biblio.mdb 不存在与您的机器上,您可以在 MSDN CD 上查找。

With cn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & _
"C:\Program Files\Microsoft Visual Studio\VB98\Biblio.mdb"
.Open
End With

' Configure cmbView control.
With cmbView
.AddItem "Icon View" ' 0
.AddItem "SmallIcon View" ' 1
.AddItem "List View" ' 2
.AddItem "Report View" ' 3
.ListIndex = 3
End With

' Configure ListView control.
lvwDB.View = lvwReport

' Configure TreeView
With tvwDB
.Sorted = True
Set mNode = .Nodes.Add()
.LabelEdit = False
.LineStyle = tvwRootLines
End With

With mNode ' Add first node.
.Text = "Publishers"
.Tag = "Biblio"
.Image = "closed"
End With
frmTreeview.Show

mnuLoad_Click
Exit Sub

' 如果 Biblio 数据库不能被找到,打开
' 公用对话框控件让用户来查找它。
errFind:

If Err = -2147467259 Then
Set cn = Nothing
Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & FindBiblio
cn.Open
Resume Next
ElseIf Err <> 0 Then ' 其他的错误
MsgBox "不期望的错误: " & Err.Description
End
End If
End Sub

Private Sub lvwDB_ColumnClick(ByVal ColumnHeader As ColumnHeader)
lvwDB.SortKey = ColumnHeader.Index - 1
' 设置 Sorted 为真对列表进行排序。
lvwDB.Sorted = True
End Sub

Private Sub lvwDB_ItemClick(ByVal Item As ListItem)
GetData Item.Key
End Sub
simb at 2007-10-21 > top of Msdn China Tech,visual basic,基础类...
# 3
Private Sub GetData(ISBN As String)
' 全局的 EventFlag 指示有多少个状态栏被使用。

If EventFlag <> TITLE Then
sbrDB.Panels.Clear
Dim pnlX As Panel
Set pnlX = sbrDB.Panels.Add(, "ISBN")
pnlX.AutoSize = sbrContents
Set pnlX = sbrDB.Panels.Add(, "author")
pnlX.AutoSize = sbrContents
Set pnlX = sbrDB.Panels.Add(, "year")
pnlX.Width = 1000
Set pnlX = sbrDB.Panels.Add(, "description")
pnlX.AutoSize = sbrContents
End If

' 打开 ADODB 记录集为状态栏获得数据。
Dim rsTitles As New ADODB.Recordset
Dim strQ As String
strQ = "SELECT Authors.Author, Titles.ISBN, Titles.[Year Published], " & _
"Titles.Description FROM Authors INNER JOIN (Titles INNER JOIN " & _
"[Title Author] ON " & _
"Titles.ISBN = [Title Author].ISBN) ON Authors.Au_ID = " & _
"[Title Author].Au_ID WHERE Titles.ISBN='" & ISBN & " '"

' 打开记录集。
rsTitles.Open strQ, cn, adOpenStatic, adLockOptimistic

' 使用信息组织状态栏窗格。
sbrDB.Panels("author").Text = rsTitles!author
sbrDB.Panels("ISBN").Text = rsTitles!ISBN
If Not IsNull(rsTitles![Year Published]) Then
sbrDB.Panels("year").Text = rsTitles![Year Published]
Else
sbrDB.Panels("year").Text = "n/a"
End If
If Not IsNull(rsTitles!Description) Then
sbrDB.Panels("description").Text = rsTitles!Description
Else
sbrDB.Panels("description").Text = "n/a"
End If
If Not rsTitles.EOF Then rsTitles.MoveNext
' 添加其他的作者名称。
Do Until rsTitles.EOF

If Not IsNull(rsTitles!author) Then
sbrDB.Panels("author").Text = sbrDB.Panels("author").Text & _
" & " & rsTitles!author
End If
rsTitles.MoveNext
Loop
' 设置 EventFlag 时窗格不被重新创建。
EventFlag = TITLE
End Sub

Private Sub mnuExit_Click()
Unload Me
End Sub

Private Sub mnuLoad_Click()
Static Loaded As Boolean
If Loaded = True Then
Exit Sub
Else
cmdLoad_Click
Loaded = Abs(Loaded - 1)
mnuLoad.Enabled = False
End If
End Sub

Private Sub tvwDB_Collapse(ByVal node As node)
' 只有文件夹中的节点可以被折叠。
If node.Tag = "Publisher" Or node.Index = 1 Then node.Image = "closed"
End Sub

Private Sub tvwDB_Expand(ByVal node As node)
' 只有顶节点,和出版商节点可以被折叠。
If node.Tag = "Publisher" Or node.Index = 1 Then
node.Image = "open"
node.Sorted = True
End If
If node.Tag = "Publisher" And EventFlag <> _
PUBLISHER Then MakeColumns
' 如果标志为 "Publisher" 并且 mItemCurrentIndex
' 索引与 Node.key 不相同 , 那么
' 激活 GetTitles 函数。
If node.Tag = "Publisher" And mCurrentIndex <> Val(node.Key) _
Then GetTitles node, Val(node.Key)

If node.Tag = "Publisher" Then PopStatus node

node.Sorted = True

End Sub

Private Sub MakeColumns()
' 清除 ColumnHeaders 集合。
lvwDB.ColumnHeaders.Clear
' 添加四个 ColumnHeaders。
lvwDB.ColumnHeaders.Add , , "Title", 2800
lvwDB.ColumnHeaders.Add , , "Author"
lvwDB.ColumnHeaders.Add , , "Year", 800
lvwDB.ColumnHeaders.Add , , "ISBN"

' 设置 EventFlag 变量使这个过程不要再三发生。
EventFlag = PUBLISHER
End Sub
Private Sub AddListItemsOnly(pubID)
Dim rsTitles As New ADODB.Recordset
Dim newNode As node
Dim strQ As String
strQ = "SELECT Titles.Title, Authors.Author, Titles.ISBN, " & _
"Titles.[Year Published] FROM Authors INNER JOIN " & _
"(Titles INNER JOIN [Title Author] " & _
"ON Titles.ISBN = [Title Author].ISBN) ON Authors.Au_ID = " & _
"[Title Author].Au_ID WHERE Titles.PubID=" & pubID

lvwDB.ListItems.Clear
With rsTitles
.Open strQ, cn, adOpenStatic, adLockReadOnly, adCmdText
.MoveLast
.MoveFirst
prgLoad.Max = .RecordCount + 1
End With

' 显示进程栏
prgLoad.Visible = True

Dim intCounter As Integer
' 创建子节点。

' 添加相应的 ListItem 。
AddListItem mItem, rsTitles

rsTitles.MoveNext
' 遍历记录集中的剩余记录。如果下一个记录是
' 一个副本,那么仅添加作者名称。
' 否则, 添加新的 Node 及 ListItem。
Do Until rsTitles.EOF
intCounter = intCounter + 1 ' 作用于进程栏
prgLoad.Value = intCounter ' 更新进程。

If mItem.Key = rsTitles!ISBN Then ' 副本
' 添加作者到作者列表。
mItem.ListSubItems(1).Text = _
mItem.ListSubItems(1).Text & _
" & " & rsTitles!author
Else
AddListItem mItem, rsTitles
End If
rsTitles.MoveNext
Loop
prgLoad.Visible = False
mCurrentIndex = pubID
End Sub
simb at 2007-10-21 > top of Msdn China Tech,visual basic,基础类...
# 4

Private Function GetTitles(ByRef ParentNode As node, pubID) As Boolean
Dim rsTitles As New ADODB.Recordset
Dim newNode As node ' 作为新的 Node.
Dim strQ As String
Dim intCounter As Integer ' 作为进程栏的值

' 检查节点是否没有被组织。如果已经被组织,那么
' 仅添加 ListItem 对象到 ListView 并且退出。
If ParentNode.Children Then
AddListItemsOnly pubID
Exit Function
End If

' 如果 ListView 已经被组织,则清除它。
lvwDB.ListItems.Clear

' SQL Query 检索所有所需字段。
strQ = "SELECT Titles.Title, Authors.Author, Titles.ISBN, " & _
"Titles.[Year Published] FROM Authors INNER JOIN " & _
"(Titles INNER JOIN [Title Author] " & _
"ON Titles.ISBN = [Title Author].ISBN) ON Authors.Au_ID = " & _
"[Title Author].Au_ID WHERE Titles.PubID=" & pubID

' 打开记录集。如果为空则退出。
With rsTitles
.Open strQ, cn, adOpenStatic, adLockReadOnly, adCmdText
If .BOF Then
' 如果为空,返回 false 并退出。
GetTitles = False
Exit Function
End If
.MoveLast
.MoveFirst
prgLoad.Max = .RecordCount + 1
End With

' 显示进程栏
prgLoad.Visible = True

On Error GoTo childErr
' 添加第一个节点。
AddNode newNode, ParentNode, rsTitles
' 添加相应的 ListItem 。
AddListItem mItem, rsTitles

rsTitles.MoveNext

' 遍历记录集中的剩余记录。如果下一个记录是
' 一个副本,那么仅添加作者名称。
' 否则, 添加新的 Node 及 ListItem。
Do Until rsTitles.EOF
intCounter = intCounter + 1 ' 作用于进程栏。
prgLoad.Value = intCounter ' 更新进程。

' 监察对应于当前 ISDN 的 Key 。 如果它们相同
' 那么此记录仅仅因包含不同的作者而不同。
' 那么添加作者到当前列表。
If newNode.Key = rsTitles!ISBN Then
' 添加作者到作者列表。
mItem.ListSubItems("author").Text = _
mItem.ListSubItems("author").Text & _
" & " & rsTitles!author
Else ' 添加新的 Node 和 ListItem
AddNode newNode, ParentNode, rsTitles
AddListItem mItem, rsTitles
End If
rsTitles.MoveNext
Loop
GetTitles = True ' 如果成功则返回 true

prgLoad.Visible = False
mCurrentIndex = pubID
Exit Function
childErr:
Debug.Print Err.Number, Err.Description

Debug.Print rsTitles!ISBN
Resume Next

Exit Function
End Function
Private Sub AddNode(ByRef newNode As node, ByRef ParentNode As node, ByRef rs As ADODB.Recordset)
' 添加新的节点。newNode 和 ParentNode 都是需要的。
Set newNode = tvwDB.Nodes.Add(ParentNode, _
tvwChild, rs!ISBN, rs!TITLE, "smlBook")
newNode.Tag = "book"
End Sub
Private Sub AddListItem(ByRef xItem As ListItem, ByRef xRec As ADODB.Recordset)
' 添加 ListItem 设置它的文本, 图标及小图标。然后
' 添加三个 ListSubItems 为它们设置 Key 及 Text 。
Set xItem = lvwDB.ListItems.Add(Key:=xRec!ISBN, _
Text:=xRec!TITLE, Icon:="book", SmallIcon:="smlBook")

xItem.ListSubItems.Add Key:="author", Text:=xRec!author
If Not IsNull(xRec![Year Published]) Then
xItem.ListSubItems.Add Key:="year", Text:=xRec![Year Published]
End If
xItem.ListSubItems.Add Key:="isbn", Text:=xRec!ISBN
End Sub

Private Sub tvwDB_NodeClick(ByVal node As node)
' 为 "Publisher" 和 EventFlag 变量检查标志
' 看看是否 ColumnHeaders 已经被创建。
' 如果没有创建,那么激活 MakeColumns 过程。
If node.Tag = "Publisher" And EventFlag <> _
PUBLISHER Then MakeColumns
' 如果标志为 "Publisher" 并且 mItemCurrentIndex
' 索引与 Node.key 不相同, 那么
' 激活 GetTitles 函数, 它将组织 Node 。
If node.Tag = "Publisher" And mCurrentIndex <> Val(node.Key) _
Then GetTitles node, Val(node.Key)

If node.Tag = "Publisher" Then PopStatus node
node.Sorted = True

' 如果节点的标志是 "book" 那么确定通过使用 EnsureVisible
' 方法使点击的书目在 ListView 中是可见的
If node.Tag = "book" Then
Dim liBook As ListItem
Set liBook = lvwDB.FindItem(node.Text)
liBook.EnsureVisible
End If

End Sub

Private Sub PopStatus(node As node)
' 只需更改状态栏来反映当前的值。
With sbrDB
.Panels.Clear
.Panels.Add , "name", node.Text
.Panels.Add , "number", node.Children & " titles"
.Panels(1).AutoSize = sbrContents
.Panels(2).AutoSize = sbrSpring
End With
End Sub
simb at 2007-10-21 > top of Msdn China Tech,visual basic,基础类...
# 5
不容易哦,不过网上有许多现成范例和控件。。。。
kmzs-.:RNPA:.山水岿濛 at 2007-10-21 > top of Msdn China Tech,visual basic,基础类...
# 6
请问有那些比较容易的控件呢?
cyberkit-木子 at 2007-10-21 > top of Msdn China Tech,visual basic,基础类...
# 7
http://vbworld.sxnw.gov.cn/activex/openfile.asp?kind=controls&id=19&filename=fldrvw20.zip

http://vbworld.sxnw.gov.cn/activex/openfile.asp?kind=controls&id=18&filename=filevw20.zip

不过好像要注册~~~~
pigpag-Pigpag-AGREFighter at 2007-10-21 > top of Msdn China Tech,visual basic,基础类...
# 8
http://expert.Codefund.cn/Expert/TopicView1.asp?id=3020237
pigpag-Pigpag-AGREFighter at 2007-10-21 > top of Msdn China Tech,visual basic,基础类...
# 9
http://www.vbaccelerator.com/home/VB/Code/Controls/TreeView/TreeView_Shell_Sample/article.asp

试试这个控件吧
Lbebo-风玉清 at 2007-10-21 > top of Msdn China Tech,visual basic,基础类...