学习使用microsoft windows common controls 6.0 (sp6)中几个常用控件

xuwenning

学习了
收藏

sgrshh29

回复 sgrshh29 的帖子

5、Treeview，从名称可以知道是一个树控件
a、在窗体主体添加一个Treeview控件，适当调整一下大小，命名为Treeview0。图19
b、添加一个Imagelist作为Treeview的图标来源，命名为Imagelist1。为其添加适当的图标，图20
c、在Treeview0的属性对话框中设置属性，图21
d、创建一个数据表作为加载Treeview1的数据源，这个表要比前面的表难一些。
在这个实例中Treeview是用来显示文件夹之间的关系，每一个节点表示一个文件夹
Treeview中的节点分为二种情况，一种是顶层节点，这种节点只可能有若干个子节点而没有父节点。
另一种节点一定有一个也只能有一个父节点同时可能有若干个子节点。
因而数据表的设计要体现这种关系，它是一个无限（借用这个词）层次的，各条记录之间具有上下级或者平级关系的表。
e、设计表

f、输入一些临时数据

g、加载Treeview0
添加节点的语法：
顶层节点：Treeview..Nodes.Add , , Key, Text, Icon, SmallIcon
其它节点：Treeview.Nodes.Add ParentKey, tvwChild, Key, Text, Icon, SmallIcon
在窗体加载事件中添加一句：
加载Treeview Me.TreeView0
成为：
Private Sub Form_Load()
    加载Toolbar Me.Toolbar0
    加载StatusBar Me.StatusBar0, Me.ImageList3.Object
    加载Treeview Me.TreeView0
End Sub
下面是加载Treeview0模块，命名为modTreeview，将下面的代码复制进去
加载过程，其中用到了ado的二个对象
Sub 加载Treeview(ByVal objTree As Object)
    objTree.Nodes.Clear
    CreateADOCnnRs
    objRs.Open "select * from tblTreeview order by gid,id;", objCnn
    递归函数 objTree
    objRs.Close
    RemoveADOCnnRs
End Sub
递归函数，其中用到的数组
Sub 递归函数(ByVal objTree As Object, Optional ByVal lngfilter As String = 0)
    Dim lngIndex As Long
    Dim lngFilters() As String
    objRs.Filter = "gid=" & lngfilter
    Do Until objRs.EOF
        lngIndex = lngIndex + 1
        ReDim Preserve lngFilters(1 To lngIndex)
        lngFilters(lngIndex) = objRs("id")
        加载节点 objTree, objRs("id"), objRs("gid"), objRs("pname")
        objRs.movenext
    Loop
    For lngIndex = 1 To lngIndex
        递归函数 objTree, lngFilters(lngIndex)
    Next lngIndex
End Sub
添加节点过程
Sub 加载节点(ByVal objTree As Object, ByVal lngKey As Long, ByVal lngParentKey As Long, ByVal strName As String)
    If lngParentKey = 0 Then
        objTree.Nodes.Add , , "T" & lngKey, strName, 1, 2
    Else
        objTree.Nodes.Add "T" & lngParentKey, tvwChild, "T" & lngKey, strName, 1, 2
    End If
End Sub

h、上面的代码用到了adodb.connection和adodb.recordset这二个自动化对象，新增一个模块来定义它们，命名为modAdo，代码如下
Public objCnn As Object                    '定义adoConnection对象
Public objRs As Object                      '定义adorecordset对象
注：因为这二个对象在以后还要用到，所以定义为全局对象变量
创建ado对象过程
Public Sub CreateADO()
    Set objCnn = CreateObject("adodb.connection")
    Set objRs = CreateObject("adodb.recordset")
    Set objCnn = CurrentProject.Connection
End Sub
销毁ado对象过程
Public Sub RemoveADO()
    Set objRs = Nothing
    Set objCnn = Nothing
End Sub

i、下面是加载Treeview后的窗体

sgrshh29

回复 sgrshh29 的帖子

四、Treeview的操作
1、内容有：添加同级节点、添加子节点、删除节点（包含它的子节点）、编辑节点名称、拖动节点成为顶层节点或成为其它节点的子节点。
注意到Treeview是用数据表来保存信息的，所以进行上面的操作时，同时要对数据表进行相应的操作，即添加记录、删除记录、更新记录。

2、添加同级节点过程
Sub mAddNode()
    Dim strKey As String
    Dim objTree As Object
    Set objTree = Forms("frmMain").Controls("treeview0")
    If objTree.SelectedItem Is Nothing Then Exit Sub
    strKey = objTree.SelectedItem.Key
    pnlEditText "当前操作：添加" & objTree.SelectedItem & "同级节点"
    AddNewNode strKey, True
    Set objTree = Nothing
End Sub
3、添加子节点过程
Sub mAddSubNode()
    Dim strKey As String
    Dim objTree As Object
    Set objTree = Forms("frmMain").Controls("treeview0")
    If objTree.SelectedItem Is Nothing Then Exit Sub
    strKey = objTree.SelectedItem.Key
    pnlEditText "当前操作：添加" & objTree.SelectedItem & "子节点"
    AddNewNode strKey
    Set objTree = Nothing
End Sub
4、添加节点，这里用到了sql语句中的insert语句
Sub AddNewNode(ByVal strKey As String, Optional ByVal isSame As Boolean = False)
    Dim lngParent As String
    Dim objTree As Object
    Set objTree = Forms("frmMain").Controls("treeview0")
    lngParent = Mid(strKey, 2)
    If isSame Then lngParent = DLookup("gid", "tblTreeview", "id=" & Mid(strKey, 2))
    strKey = "T" & DMax("id", "tblTreeview") + 1
    CurrentDb.Execute ("insert into tblTreeview ( id, gid, pname, pdate ) " _
                              & "select dmax('id','tblTreeview')+1, '" & lngParent & "', 'New Item', '" & Now() & "'")
    If lngParent = 0 Then
        objTree.Nodes.Add , , strKey, "New Item", 1, 2
    Else
        objTree.Nodes.Add "T" & lngParent, tvwChild, strKey, "New Item", 1, 2
    End If
    Set objTree = Nothing
End Sub

5、删除节点过程
Sub mDeleteNode()
    Dim objNode As Object
    Dim objTree As Object
    Set objTree = Forms("frmMain").Controls("treeview0")
    If objTree.SelectedItem Is Nothing Then Exit Sub
    pnlEditText "当前操作：删除" & objTree.SelectedItem & "及其中的..."
    Set objNode = objTree.SelectedItem
    RemoveNode objNode
    Set objNode = Nothing
    Set objTree = Nothing
End Sub
6、删除节点并删除相应记录，当有子节点时确认同时删除子节点
Sub RemoveNode(ByVal objNode As Node)
    If objNode.Children > 0 Then
        If MsgBox("所选项目含有子项目,是否连子项目一起删除?", vbYesNo, "Infomation") = vbNo Then
            MsgBox "请先清除或移动所选项目的子项目再行删除!", vbOKOnly, "Infomation"
            pnlEditText "当前操作：取消删除" & objNode
            Exit Sub
        End If
    End If
    dirNode objNode
    Forms("frmMain").Controls("treeview0").Nodes.Remove objNode.Key
    pnlEditText "当前操作：删除" & objNode & "及其中...完成"
End Sub
7、删除数据表中相应记录过程，这里用到了sql语句的delete语句
Sub dirNode(nodeX As Node) '递归
    Dim IntNodes As Integer
    Dim CldNode As Node
    Dim i As Integer
    IntNodes = nodeX.Children
    CurrentDb.Execute ("delete * from tblTreeview where id=" & Mid(nodeX.Key, 2))
    If IntNodes > 0 Then
        Set CldNode = nodeX.Child
        For i = 1 To IntNodes
            dirNode CldNode
            Set CldNode = CldNode.Next
        Next
    End If
End Sub

8、编辑节点文本过程，这里用到了sql语句的update语句
Sub mEditNode()
    Dim objTree As Object
    Set objTree = Forms("frmMain").Controls("treeview0")
    If objTree.SelectedItem Is Nothing Then Exit Sub
    Dim strNew As String
    strNew = InputBox("请输入新的节点名称")
    If strNew = "" Or IsNull(strNew) Then Exit Sub
    pnlEditText "当前操作：编辑" & objTree.SelectedItem
    CurrentDb.Execute ("update tblTreeview set pname='" & strNew & "' where id=" & Mid(objTree.SelectedItem.Key, 2))
    objTree.SelectedItem.Text = strNew
End Sub

9、展开当前节点及其子节点过程
Sub mExpandNode()
    Dim i As Integer
    Dim objTree As Object
    Dim objNode As Node
    Set objTree = Forms("frmMain").Controls("treeview0")
    If objTree.SelectedItem Is Nothing Then Exit Sub
    Dim lngIndex As Integer
    Set objNode = objTree.SelectedItem
    pnlEditText "当前操作：展开" & objTree.SelectedItem
    objTree.Nodes(objNode.Index).Expanded = True
    lngIndex = objNode.Child.Index
    For i = 0 To objNode.Children - 1
        objTree.Nodes(lngIndex + i).Expanded = True
    Next i
End Sub

10、拖曳节点
先在窗体中添加事件
Private Sub Treeview0_OLEStartDrag(Data As Object, AllowedEffects As Long)
    pnlEditText "当前操作：拖曳" & Me.TreeView0.SelectedItem
End Sub
Private Sub Treeview0_OLEDragOver(Data As Object, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
    If Me.TreeView0.SelectedItem Is Nothing Then
        Set Me.TreeView0.SelectedItem = Me.TreeView0.HitTest(x, y)      ' 如无节点被选中，则选择你曾经拖过的一个.
    Else
        Set Me.TreeView0.DropHighlight = Me.TreeView0.HitTest(x, y)      ' 如有节点被选中，则选择高亮显示的一个.
    End If
End Sub
然后在模块中添加过程，这里用到了sql语句的update语句
Public Sub 拖曳节点()
    On Error GoTo Err_TreeDragDrop
    Dim strKey As String
    Dim objTree As Object
    Dim nodDragged As Node
    Set objTree = Forms("frmMain").Controls("treeview0").Object
    If objTree.SelectedItem Is Nothing = False Then
        Set nodDragged = objTree.SelectedItem
        strKey = nodDragged.Key
        If objTree.DropHighlight Is Nothing Then        ' 节点被拖放到空白区,则将其设为根节点
            CurrentDb.Execute ("update tblTreeview set gid=0 where id=" & Mid(nodDragged.Key, 2))
            加载Treeview Forms("frmMain").treeview0
            objTree.Nodes(strKey).Selected = True
            objTree.Nodes(strKey).Expanded = True
        ElseIf nodDragged.Index <> objTree.DropHighlight.Index Then     '节点被拖到选定节点
            Set nodDragged.Parent = objTree.DropHighlight
            CurrentDb.Execute ("update tblTreeview set gid=" & Mid(nodDragged.Parent.Key, 2) _
                                      & " where id=" & Mid(nodDragged.Key, 2))
        End If
    End If
Exit_TreeDragDrop:
    Set objTree.DropHighlight = Nothing
    Set nodDragged = Nothing
    Set objTree = Nothing
    Exit Sub
Err_TreeDragDrop:
     MsgBox "节点拖曳错误" & vbCrLf & Error.Description, vbCritical, "Information"
     Resume Exit_TreeDragDrop
End Sub

五、为“Tree视图”菜单按钮“ 及下级菜单的单击事件添加调用的过程
1、在窗体的botton和bottonmenu的单击事件中，分别将
TbrClick Button.Key
改为
TbrClick "m" & Button.Key
TbrClick ButtonMenu.Key
改为
TbrClick "m" & ButtonMenu.Key
2、在模块中添加一个Button单击事件的过程
Sub mTreeview()
    pnlEditText "添加删除节点(子节点)、编辑节点、展开节点。"
End Sub
3、在下面过程中添加一句执行代码
将
Sub TbrClick(ByVal strAction As String)
    pnlEditText "当前调用的过程：" & strAction
End Sub
改为
Sub TbrClick(ByVal strAction As String)
    pnlEditText "当前调用的过程：" & strAction
    Application.Run strAction
End Sub
4、上面几节完成以后的演示

c101

非常期待实例

yyinfo

对于新人来说了解过程比知道结果更重要，谢谢楼主好文 ！！不知是否能开个系列课程 呵呵！

sgrshh29

回复 sgrshh29 的帖子

这一节是文件夹导入导出

六、导入导出文件夹
这是难度比较大的一节内容。
操作过程是：
选择一个节点，点击菜单按钮“导入文件夹”，在选择文件夹对话框中把选中的文件夹连同它下面的所有文件夹添加到节点下，顺序、，名称不变
如果没有选择节点，则把这个文件夹作为一个新的根节点导入，它下面的文件夹顺序不变、不变。
1、选择文件夹对话框代码
Function getFolderName() As String
    Dim dlgFolder As Variant
    Set dlgFolder = Application.FileDialog(4)
    With dlgFolder
        .title = "请选择文件夹"
        .AllowMultiSelect = False
        .Filters.Clear
        .Show
    End With
    If dlgFolder.SelectedItems.count > 0 Then
        getFolderName = dlgFolder.SelectedItems(1)
    Else
        getFolderName = ""
    End If
    Set dlgFolder = Nothing
    DoEvents
End Function
2、创建对filesystemobject和dictionary二个对象的引用
Public objFso As Object
Public objDic As Object
Sub CreateFsoDic()
    Set objDic = CreateObject("scripting.dictionary")
    Set objFso = CreateObject("scripting.filesystemobject")
End Sub
Sub RemoveFsoDic()
    objDic.RemoveAll
    Set objDic = Nothing
    Set objFso = Nothing
End Sub
3、添加一个全局变量
Public lngGid AS Long

4、为"导入文件夹"菜单按钮添加事件过程
Sub mImportFolder()
    Dim strGetFolderPath As String
    strGetFolderPath = getFolderName
    If strGetFolderPath = "" Then Exit Sub
    Set objTree = Forms("frmMain").Controls("treeview0")
    pnlEditText "当前操作：正在保存文件夹..."
    CreateADOCnnRs
    CreateFsoDic
    If objTree.SelectedItem Is Nothing Then
        strKey = "T" & Nz(DMax("id", "tblTreeview")) + 1
        SaveFolderFile strGetFolderPath
    Else
        strKey = objTree.SelectedItem.Key
        lngGid = Mid(objTree.SelectedItem.Key, 2)
        SaveFolderFile strGetFolderPath
    End If
    RemoveADOCnnRs
    RemoveFsoDic
    pnlEditText "当前操作：保存文件夹完成"
    加载Treeview Forms("frmMain").Controls("Treeview0")
    objTree.Nodes(strKey).Selected = True
    objTree.Nodes(strKey).Expanded = True
End Sub

5、导入文件夹模块，这是一个递归函数
Dim lngIDp As Long
Function SaveFolderFile(ByVal strPath As String)
On Error Resume Next
    Dim lngSubP As Long
    Dim strSubP() As String
    Dim strParent As String
    Dim objFolder As Object
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
    If Len(strPath) - Len(Replace(strPath, "\", "")) = 1 Then
        strParent = objFso.GetFolder(strPath)
    Else
        strParent = objFso.GetFolder(strPath).ParentFolder
    End If
    If Right(strParent, 1) <> "\" Then strParent = strParent & "\"
    If objDic.Exists(strParent) Then
        lngGid = objDic(strParent)
    End If
    If DCount("id", "tblTreeview") > 0 Then
        lngIDp = DMax("id", "tblTreeview") + 1
    Else
        lngIDp = lngIDp + 1
    End If
    objDic.Add strPath, lngIDp
    If Len(strPath) - Len(Replace(strPath, "\", "")) = 1 Then
        AddFolder lngIDp, lngGid, objFso.getdriveName(objFso.getdrive(strPath)), _
                        objFso.getdrive(strPath).totalsize
    Else
        AddFolder lngIDp, lngGid, objFso.GetFolder(strPath).Name, _
                        objFso.GetFolder(strPath).Size, objFso.GetFolder(strPath).DateLastModified
    End If
    For Each objFolder In objFso.GetFolder(strPath).SubFolders
        Select Case objFolder.Attributes
            Case 16, 17, 48
            lngSubP = lngSubP + 1
            ReDim Preserve strSubP(1 To lngSubP)
            strSubP(lngSubP) = objFolder.Path
        End Select
    Next
    For lngSubP = 1 To lngSubP
        SaveFolderFile strSubP(lngSubP)
    Next lngSubP
End Function
6、将记录追加到数据表的过程，这里用到了sql语句的insert语句
Sub AddFolder(ByVal lngIDp As Long, ByVal lngGid As Long, ByVal strPName As String, _
                       ByVal lngPsize As Double, Optional ByVal datPDLModi As Date)
    Dim strSql As String
    strSql = "insert into tblTreeview (id, gid, pname, psize, pdate) select " & """" & lngIDp & """" & "," & """" & lngGid _
              & """" & "," & """" & strPName & """" & "," & """" & lngPsize & """" & "," & """" & datPDLModi & """"
    CurrentDb.Execute (strSql)
End Sub



七、在硬盘指定的位置将节点按原样导出为文件夹，实际就是上一节的反向操作
1、为"导出文件夹"菜单按钮添加事件过程
Sub mExportFolder()
    Set objTree = Forms("frmMain").Controls("treeview0")
    If objTree.SelectedItem Is Nothing Then Exit Sub
    pnlEditText "当前操作：正在将文件夹保存到硬盘..."
    ExportNode objTree.SelectedItem, objTree.SelectedItem.Text
    pnlEditText "当前操作：文件夹保存到硬盘完成"
End Sub
2、导出过程
Sub ExportNode(ByVal objNode As Node, ByVal strNodText As String)
On Error Resume Next
    Dim strPath As String
    strPath = getFolderName
    If strPath <> "" Then
        CreateADOCnnRs
        If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
        ExportSubNode objNode, strPath, strNodText
        RemoveADOCnnRs
    Else
        MsgBox "没有选择保存位置。", vbInformation, "Information"
        Exit Sub
    End If
End Sub
3、递归过程
Sub ExportSubNode(ByVal objNode As Node, ByVal strPath As String, ByVal strNodText As String) '节点递归
    Dim i As Integer
    Dim strFolder As String
    Dim strSubFld As String
    Dim intNodChildren As Integer
    Dim nodChild As Node
    intNodChildren = objNode.Children
    strSubFld = Mid(objNode.FullPath, InStr(objNode.FullPath, strNodText))
    strFolder = strPath & strSubFld & "\"
    If Dir(strFolder, vbDirectory) = "" Then
        MkDir strFolder
    Else
        If MsgBox("文件夹: " & strFolder & Chr(10) & Chr(13) & " 已经存在,是否继续?", _
                        vbInformation + vbYesNo, "Information") = vbNo Then End
    End If
    If intNodChildren > 0 Then
        Set nodChild = objNode.Child
        For i = 1 To intNodChildren
            ExportSubNode nodChild, strPath, strNodText
            Set nodChild = nodChild.Next
        Next i
    End If
End Sub

sgrshh29

回复 sgrshh29 的帖子

八、将外部文件夹拖曳到Treeview里
上一节是用菜单来导入文件夹及它的子文件夹，这一节是不用菜单，而是直接将外部文件夹拖曳到Treeview来进行导入文件夹和它的子文件夹
1、在窗体的Treeview0的拖放事件中添加代码来判断拖曳状态，有四种情况：
a、拖动Treeview的Node（在前面已经讲过了，这里就是添加判断）
b、拖动Listview的Item（以后要讲到）
c、拖动外部文件（以后要讲到）
d、拖动外部文件夹

2、拖曳外部文件夹到treeview的代码
先定义一个拖曳类型的全局变量
Public strDragType as String
然后在Treeview0_OLEStartDrag事件中对这个变量赋值
Private Sub Treeview0_OLEStartDrag(Data As Object, AllowedEffects As Long)
    strDragType = "TreeView"
End Sub
在拖曳结束时将这个变量置空
Private Sub TreeView0_OLECompleteDrag(Effect As Long)
    strDragType = ""
End Sub
在窗体的TreeView0_OLEDragDrop事件改写代码
Private Sub TreeView0_OLEDragDrop(Data As Object, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
On Error GoTo Err_TreeX_OLEDragDrop
    Dim i As Integer
    If strDragType = "TreeView" Then        '拖曳的是treeview的node
        pnlEditText "当前操作：拖曳" & Me.TreeView0.SelectedItem
        拖曳节点
    ElseIf strDragType = "ListView" Then   '拖曳的是listrview的item
    ElseIf Effect = 7 Then
        For i = 1 To Data.Files.count
            CreateFsoDic
            If objFso.FileExists(Data.Files(i)) Then  '拖曳的是外部文件
            ElseIf objFso.folderexists(Data.Files(i)) Then  '拖曳的是外部文件夹
            pnlEditText "当前操作：拖曳外部文件夹到Treeview"
            If Me.TreeView0.DropHighlight Is Nothing Then
                    lngGid = 0
                    strKey = "T" & DMax("id", "tblTreeview") + 1
                    SaveFolderFile Data.Files(i)
                Else                                                     
                    strKey = Me.TreeView0.DropHighlight.Key
                    lngGid = Mid(strKey, 2)
                    SaveFolderFile Data.Files(i)
                End If
            End If
        Next i
        RemoveFsoDic
        加载Treeview Me.TreeView0
        Me.TreeView0.Nodes(strKey).Selected = True
        Me.TreeView0.Nodes(strKey).Expanded = True
    End If
    Set TreeView0.DropHighlight = Nothing
Exit_TreeX_OLEDragDrop:
    Exit Sub
Err_TreeX_OLEDragDrop:
    MsgBox Err.Number & Err.Description
    Resume Exit_TreeX_OLEDragDrop
End Sub

sgrshh29

回复 sgrshh29 的帖子

九、接下来是Listview控件，从名称可以知道是一个列表控件。
在示例中控件是用来显示树节点（文件夹）下的内容（子文件夹和文件）
1、在窗体添加一个Listview控件，命名为Listview0，适当调整大小
2、添加一个Imagelist控件，命名为Imagelist2，在其属性对话框中添加图标，作为Listview0的大图标的来源
3、在属性中设置属性



4、创建一个数据表来保存Listview0项目数据，命名为tblListview
5、设计表



6、将这个表与tblTreeview建立关系，并且钩选实施参照完整性、级联更新、级联删除



7、输入一些临时数据

8、加载Listview0，在窗体加载中添加二句
初始化Listview Me.ListView0
加载ListItem
这二句的过程分别是
9、初始化
Sub 初始化Listview(ByVal objListview As Object)
    With objListview
        .ListItems.Clear
        .ColumnHeaders.Clear
        .LabelEdit = lvwManual
        .ColumnHeaders.Add , , "文件名", .Width * 3.1 / 5, lvwColumnLeft, 3
        .ColumnHeaders.Add , , "文件类型", .Width * 0.55 / 5, lvwColumnCenter
        .ColumnHeaders.Add , , "文件大小K   ", .Width * 0.67 / 5, lvwColumnRight
        .ColumnHeaders.Add , , "修改日期     ", .Width * 0.67 / 5, lvwColumnRight
    End With
End Sub
10、加载
Public Sub 加载ListItem(Optional strKey As String = "T1")
    Dim ItemX As ListItem
    Forms("frmMain").Controls("listview0").ListItems.Clear
    Set objRs = CurrentDb.OpenRecordset("select * from tblTreeview where gid=" & Mid(strKey, 2) & " order by id;")
    Do Until objRs.EOF
        Set ItemX = Forms("frmMain").Controls("listview0").ListItems.Add(, "P" & objRs("id"), objRs("pname"), 2, 1)
        ItemX.SubItems(1) = ""
        ItemX.SubItems(2) = Format(IIf(Not IsNull(objRs("psize")), objRs("psize"), "") / 1024, "#,##0.000")
        ItemX.SubItems(3) = IIf(Not IsNull(objRs("pdate")), Format(objRs("pdate"), "yyyy-mm-dd"), "")
        objRs.movenext
    Loop
    objRs.Close
    Set objRs = CurrentDb.OpenRecordset("select id, fname, ftype, fsize, fdate from tblListview where gid=" & Mid(strKey, 2) & " order by id;")
    Do Until objRs.EOF
        If blnSingle Then objRs.movelast
        Set ItemX = Forms("frmMain").Controls("listview0").ListItems.Add(, "L" & objRs("id"), objRs("fname"), 1, 4)
        ItemX.SubItems(1) = IIf(Not IsNull(objRs("ftype")), objRs("ftype"), "")
        ItemX.SubItems(2) = Format(IIf(Not IsNull(objRs("fsize")), objRs("fsize"), "") / 1024, "#,##0.000")
        ItemX.SubItems(3) = IIf(Not IsNull(objRs("fdate")), Format(objRs("fdate"), "yyyy-mm-dd"), "")
        objRs.movenext
    Loop
    objRs.Close
    Set objRs = Nothing
    Set ItemX = Nothing
    Exit Sub
End Sub

11、为不同的文件类型指定图标

12、然后在窗体的Treeview0的节点点击事件中，重新加载Listview0
Private Sub TreeView0_NodeClick(ByVal Node As Object)
    加载ListItem Node.Key
End Sub

13、完成以上步骤后的窗体演示

sgrshh29

回复 sgrshh29 的帖子


十、listview的操作
1、改变Listview显示样式
这里只选二种样式，大图标、报表
为按钮菜单添加过程
Sub mIcon()
    Set objList = Forms("frmMain").Controls("Listview0")
    objList.View = lvwIcon
    pnlEditText "当前操作：ListView为Icon"
End Sub
Sub mReport()
    Set objList = Forms("frmMain").Controls("Listview0")
    objList.View = lvwReport
    pnlEditText "当前操作：ListView为Report"
End Sub

2、编辑Listview的Item的文本并更新相应记录
为按钮菜单添加过程
Sub mEditeItem()
    Dim strName As String
    strName = InputBox("Typing New Name.", "Informationg")
    If strName = "" Then Exit Sub
    Set objTree = Forms("frmMain").Controls("treeview0")
    Set objList = Forms("frmMain").Controls("Listview0")
    pnlEditText "当前操作：编辑" & objList.SelectedItem
    objList.SelectedItem.Text = strName
    If objList.SelectedItem.SubItems(1) <> "" Then
        CurrentDb.Execute "update tblListview set fname='" & strName & "' where id = " & Mid(objList.SelectedItem.Key, 2)
    ElseIf objList.SelectedItem.SubItems(1) = "" Then
        CurrentDb.Execute "update tblTreeview set pname='" & strName & "' where id = " & Mid(objList.SelectedItem.Key, 2)
        objTree.Nodes("T" & Mid(objList.SelectedItem.Key, 2)).Text = strName
    End If
    pnlEditText "当前操作：编辑完成"
    Set objTree = Nothing
    Set objList = Nothing
End Sub

3、删除Listview的Item并且删除相应的记录
为按钮菜单添加过程
Sub mDeleteItem()
    Dim objNode As Object
    Dim strListKey As String
    Set objTree = Forms("frmMain").Controls("treeview0")
    Set objList = Forms("frmMain").Controls("Listview0")
    If objList.SelectedItem Is Nothing Then Exit Sub     '如果没有指定项目，就退出
    pnlEditText "当前操作：正在删除" & objList.SelectedItem
    strListKey = objList.SelectedItem.Key
    If objList.SelectedItem.SubItems(1) = "" Then
        strKey = "T" & Mid(strListKey, 2)
        Set objNode = objTree.Nodes(strKey)
        CurrentDb.Execute ("delete * from tblTreeview where id=" & Mid(strListKey, 2))
        objList.ListItems.Remove (strListKey)
        RemoveNode objNode
    Else
        strKey = "T" & DLookup("gid", "tblListview", "id=" & Mid(strListKey, 2))
        Set objNode = objTree.Nodes(strKey)
        CurrentDb.Execute ("delete * from tblListview where id=" & Mid(strListKey, 2))
        objList.ListItems.Remove (strListKey)
    End If
    Set objNode = Nothing
    Set objTree = Nothing
    Set objLidt = Nothing
    pnlEditText "当前操作：删除完成"
End Sub
4、改变listview的排序
为菜单按钮添加单击事件的过程
listview按文件名称排序
Sub mName()
    Set objList = Forms("frmMain").Controls("Listview0")
    objList.Sorted = True
    objList.SortKey = 0
    Set objList = Nothing
    pnlEditText "当前操作：ListView按文件名称排序"
End Sub
listview按文件类型排序
Sub mType()
    Set objList = Forms("frmMain").Controls("Listview0")
    objList.Sorted = True
    objList.SortKey = 1
    Set objList = Nothing
    pnlEditText "当前操作：ListView按文件类型排序"
End Sub
listview按最后修改日期排序
Sub mDate()
    Set objList = Forms("frmMain").Controls("Listview0")
    objList.Sorted = True
    objList.SortKey = 3
    Set objList = Nothing
    pnlEditText "当前操作：ListView按文件修改日期排序"
End Sub

5、Listview的Item拖曳到Treeview的其它节点
a、在Listview0_OLEStartDrag事件中写入代码定义拖动类型
Private Sub Listview0_OLEStartDrag(Data As Object, AllowedEffects As Long)
    strDragType = "ListView"
    pnlEditText "当前操作：拖动ListviewItem。"
End Sub
b、在TreeView0_OLEDragDrop事件中判断出拖曳类型后执行代码
    ElseIf strDragType = "ListView" Then   '拖曳的是listrview的item
        If Me.TreeView0.DropHighlight Is Nothing = False Then
            If Me.TreeView0.SelectedItem.Key = Me.TreeView0.DropHighlight.Key Then Exit Sub
        End If
        Set objNode = Me.TreeView0.SelectedItem
        ListDragDrop objNode
c、 ListDragDrop过程
Sub ListDragDrop(objNode As Node)
On Error GoTo Err_ListDragDrop
    Dim i As Integer
    Dim objTree As Object
    Dim objList As Object
    Dim nodDroped As Node
    Set objTree = Forms("frmMain").Controls("treeview0").Object
    Set objList = Forms("frmMain").Controls("listview0").Object
    strKey = objList.SelectedItem.Key
    With objList
        If .SelectedItem.SubItems(1) <> "" Then
            If objTree.DropHighlight Is Nothing Then
                Exit Sub
            Else
                Set nodDroped = objTree.DropHighlight
            End If
            CurrentDb.Execute "update tblListview set gid = " & Mid(nodDroped.Key, 2) & _
                                                 " where id = " & Mid(strKey, 2)
            .ListItems.Remove (strKey)
        ElseIf .SelectedItem.SubItems(1) = "" Then
            If objTree.DropHighlight Is Nothing Then
                CurrentDb.Execute "update tblTreeview set gid=0 where id=" & Mid(strKey, 2)
                加载Treeview Forms("frmMain").Controls("treeview0")
                objTree.Nodes("T" & Mid(strKey, 2)).Selected = True
                objTree.Nodes("T" & Mid(strKey, 2)).Expanded = True
                加载ListItem strKey
            Else
                Set nodDroped = objTree.DropHighlight
                CurrentDb.Execute "update tblTreeview set gid=" & Mid(nodDroped.Key, 2) & _
                                                 " where id=" & Mid(strKey, 2)
                Set objTree.Nodes("T" & Mid(strKey, 2)).Parent = nodDroped
                .ListItems.Remove (strKey)
            End If
        End If
    End With
Exit_ListDragDrop:
    Set objTree = Nothing
    Set objList = Nothing
    Set nodDroped = Nothing
    Exit Sub
Err_ListDragDrop:
    MsgBox Err.Description
    Resume Exit_ListDragDrop
End Sub

6、完成以上步骤后的窗体演示

sgrshh29

接下去就是如何将文件保存到ole字段，这部分内容论坛有很多示例了，就不详细讲了。只要把它做成通用过程嵌入到前面的模块里就可以了。

下面就把示例附上。



供各位朋友参考。