Private Sub Form_Load()
加载Toolbar Me.Toolbar0
End Sub
g、下面是加载Toolbar过程,新建一个模块,命名为modToolbar,将下面的过程复制到模块
Sub 加载Toolbar(ByVal objTbr As Object, ByVal objImglist As Object)
Dim Rs As Object
With objTbr
.Top = 0
.Left = 0
.Width = Forms("frmMain").InsideWidth
Set Rs = CurrentDb.OpenRecordset("select * from tblTbrBtn order by id")
Do Until Rs.EOF
.Buttons.Add CInt(Rs(0)), CStr(Rs(1)), CStr(Rs(2)), CStr(Rs(3)), CInt(Rs(4))
Rs.movenext
Loop
Set Rs = Nothing
Set Rs = CurrentDb.OpenRecordset("select * from tblTbrBtnMenu order by pid, id")
Do Until Rs.EOF
.Buttons(CInt(Rs(1))).ButtonMenus.Add CInt(Rs(0)), CStr(Rs(2)), CStr(Rs(3))
Rs.movenext
Loop
Set Rs = Nothing
End With
End Sub
h、加载完成后的窗体,图13
[attach]43400[/attach]
i、为所有的Button和ButtonMenu的单击事件指定过程
Private Sub Toolbar0_ButtonClick(ByVal Button As Object)
If Button.Key = "Exit" Then
DoCmd.Close acForm, Me.Name
Else
TbrClick Button.Key
End If
End Sub
Private Sub Toolbar0_ButtonMenuClick(ByVal ButtonMenu As Object)
TbrClick ButtonMenu.Key
End Sub
j、下面的按钮过程放在模块modToolbar中
Sub TbrClick(ByVal strAction As String)
MsgBox "当前调用的过程:" & strAction
End Sub
b、创建一个数据表用来保存控件的参数,命名为tblStatusbar,并输入数据
[attach]43405[/attach]
c、添加Panel
语法:Statusbar.Panels.Add index, key, text, Style
其中style有几个特定的值是用来显示电脑硬件信息的,这时候的text是默认的
d、添加Panel以后,对每一个Panel的属性进行设置
e、在窗体的加载事件中添加一句,成为:
Private Sub Form_Load()
加载Toolbar Me.Toolbar0
加载StatusBar Me.StatusBar0, Me.ImageList3.Object
End Sub
f、下面是加载过程。新建一个模块,命名modStatusbar,把下面的代码复制进去
Sub 加载StatusBar(ByVal objStatusBar As Object, ByVal objImagelist As Object)
Dim Rs As Object
With objStatusBar
.Top = 0
.Left = 0
.Width = Forms("frmMain").InsideWidth
Set Rs = CurrentDb.OpenRecordset("select * from tblStatusbar order by id")
Do Until Rs.EOF
If IsNull(Rs(2)) Then
.Panels.Add CInt(Rs(0)), Rs(1), , CInt(Rs(3))
ElseIf Rs("strtext") = "currentuser" Then
.Panels.Add CInt(Rs(0)), Rs(1), CurrentUser(), CInt(Rs(3))
Else
.Panels.Add CInt(Rs(0)), Rs(1), Rs(2), CInt(Rs(3))
End If
With .Panels(Int(Rs(0)))
If CInt(Rs(4)) <> 0 Then
.Picture = objImagelist.ListImages(CInt(Rs(4))).Picture
End If
.Alignment = Rs(5)
.AutoSize = Rs(6)
.Bevel = Rs(7)
.Width = Rs(8)
.ToolTipText = Rs(9)
End With
Rs.movenext
Loop
Set Rs = Nothing
End With
End Sub
g、其中第六个Panel是用来显示用户的操作信息的,当用户进行不同的操作时,提示简短的文字
过程如下,可以在需要的地方调用
Sub pnlEditText(ByVal strPnltext As String)
Forms("frmMain").Controls("StatusBar2").Panels(6).Text = strPnltext
End Sub
h、然后把原来在modToolbar中的那个点击事件过程中msgbox显示的信息,改到用Ststusbar来显示。
Msgbox "当前调用的过程:" & strAction
改为
pnlEditText "当前调用的过程:" & strAction
i、加载Toolbar和Statusbar以后的窗体,图18
5、Treeview,从名称可以知道是一个树控件
a、在窗体主体添加一个Treeview控件,适当调整一下大小,命名为Treeview0。图19
b、添加一个Imagelist作为Treeview的图标来源,命名为Imagelist1。为其添加适当的图标,图20
c、在Treeview0的属性对话框中设置属性,图21
d、创建一个数据表作为加载Treeview1的数据源,这个表要比前面的表难一些。
在这个实例中Treeview是用来显示文件夹之间的关系,每一个节点表示一个文件夹
Treeview中的节点分为二种情况,一种是顶层节点,这种节点只可能有若干个子节点而没有父节点。
另一种节点一定有一个也只能有一个父节点同时可能有若干个子节点。
因而数据表的设计要体现这种关系,它是一个无限(借用这个词)层次的,各条记录之间具有上下级或者平级关系的表。
e、设计表
[attach]43411[/attach]
f、输入一些临时数据
[attach]43412[/attach]
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
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、上面几节完成以后的演示
六、导入导出文件夹
这是难度比较大的一节内容。
操作过程是:
选择一个节点,点击菜单按钮“导入文件夹”,在选择文件夹对话框中把选中的文件夹连同它下面的所有文件夹添加到节点下,顺序、,名称不变
如果没有选择节点,则把这个文件夹作为一个新的根节点导入,它下面的文件夹顺序不变、不变。
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
[attach]43443[/attach]
七、在硬盘指定的位置将节点按原样导出为文件夹,实际就是上一节的反向操作
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
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
十、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