📄 frmfave.frm
字号:
Set tempRec = faveDB.OpenRecordset("faveFold", dbOpenDynaset)
tempRec.MoveFirst
Do Until tempRec.EOF
If tempRec!subject = oldSubject Then
With tempRec
.Edit
!subject = txtSubject.Text
!location = txtAdd.Text
.Update
End With
Exit Do
End If
tempRec.MoveNext
Loop
tempRec.Close
lsvAdd.ListItems(selItemX).Text = txtSubject.Text
lsvAdd.ListItems(selItemX).SubItems(1) = txtAdd.Text
cmdEditAdd.Enabled = False
End Sub
Private Sub cmdRemoveFold_Click()
'删除TreeView中选定的收藏夹
Dim selItem As Integer
selItem = TreeView1.SelectedItem.Index
If selItem = 1 Then
Exit Sub
End If
Dim subject As String
Dim strUser As String
'取得treeView中选定收藏夹的名称
strUser = TreeView1.Nodes(selItem).Text
Dim tempRec
'从数据库中删除相应的记录
'先删除表"faveFold"中相应的所有记录
Set tempRec = faveDB.OpenRecordset("faveFold", dbOpenDynaset)
tempRec.MoveFirst
Do Until tempRec.EOF
If tempRec!User = strUser Then
With tempRec
.Delete
End With
End If
tempRec.MoveNext
Loop
tempRec.Close
'删除表"user"中收藏夹的名称
Set tempRec = faveDB.OpenRecordset("user", dbOpenDynaset)
tempRec.MoveFirst
Do Until tempRec.EOF
If tempRec!User = strUser Then
With tempRec
.Delete
End With
Exit Do
End If
tempRec.MoveNext
Loop
'删除TreeView中相应的节点
Dim i
For i = 2 To TreeView1.Nodes.Count - 1
If TreeView1.Nodes(i).Checked = True Then
TreeView1.Nodes.Remove (i)
i = i - 1
End If
Next i
If TreeView1.Nodes(TreeView1.Nodes.Count).Checked = True Then
TreeView1.Nodes.Remove (TreeView1.Nodes.Count)
End If
TreeView1.Refresh
End Sub
Private Sub cmdReturn_Click()
'返回浏览器主窗体
Unload Me
End Sub
Private Sub Form_Load()
TreeView1.Sorted = True
TreeView1.LineStyle = tvwTreeLines
TreeView1.LabelEdit = False
Set nodroot = TreeView1.Nodes.Add(, , "Root")
nodroot.Text = "收藏夹"
nodroot.Image = "open"
'初始化ListView
lsvAdd.ColumnHeaders.Add 1, "title", "标题", lsvAdd.Width / 3
lsvAdd.ColumnHeaders.Add 2, "address", "地址", 2 * lsvAdd.Width / 3
lsvAdd.View = lvwReport
Set faveDB = DBEngine.OpenDatabase(App.Path & "\" & "faveLocation.mdb")
Dim recUser
Dim recLoc
Set recUser = faveDB.OpenRecordset("user", dbOpenDynaset)
Set recLoc = faveDB.OpenRecordset("faveFold", dbOpenDynaset)
recUser.MoveFirst
recLoc.MoveFirst
Dim nodeX As Node
'将数据库中的收藏夹添加到TreeView的节点中
Do Until recUser.EOF
Set nodeX = TreeView1.Nodes.Add(1, tvwChild)
nodeX.Image = "closed"
nodeX.Text = recUser!User
recUser.MoveNext
Loop
recUser.Close
recLoc.Close
End Sub
Function FoldIsExsit(NameKey As String)
'此函数用来判断TreeView中的节点是否存在与字符串NameKey相同的收藏夹
'如果存在,则返回值为-1,否则返回值为1
Dim i
For i = 1 To TreeView1.Nodes.Count
If TreeView1.Nodes(i).Key = NameKey Then
FoldIsExsit = -1
Exit Function
End If
Next i
FoldIsExsit = 1
End Function
Private Sub Form_Unload(Cancel As Integer)
faveDB.Close
End Sub
Private Sub lsvAdd_AfterLabelEdit(Cancel As Integer, NewString As String)
'直接在ListView中修改网址的主题(subject),修改数据库表"faveFold"中相应记录的subject
Dim tempRec
Dim tempUser As String
Dim selX As Integer
selX = TreeView1.SelectedItem.Index
tempUser = TreeView1.Nodes(selX).Text
Set tempRec = faveDB.OpenRecordset("faveFold", dbOpenDynaset)
tempRec.MoveFirst
Do Until tempRec.EOF
If tempRec!subject = oldSubject And tempRec!User = tempUser Then
With tempRec
.Edit
!subject = NewString
.Update
End With
Exit Do
End If
tempRec.MoveNext
Loop
tempRec.Close
End Sub
Private Sub lsvAdd_BeforeLabelEdit(Cancel As Integer)
'取得要修改的网址的主题,用以从数据库中找出相应的记录进行修改
Dim selX As Integer
selX = lsvAdd.SelectedItem.Index
oldSubject = lsvAdd.ListItems(selX)
End Sub
Private Sub lsvAdd_DblClick()
'双击ListView中相应的网址,将网址返回给浏览器主窗体进行连接
Dim i
For i = 1 To lsvAdd.ListItems.Count
If lsvAdd.ListItems(i).Selected = True Then
frmBrowser.cboAddress.AddItem lsvAdd.ListItems(i).SubItems(1), 0
frmBrowser.cboAddress.Text = lsvAdd.ListItems(i).SubItems(1)
Unload Me
frmBrowser.brwWebBrowser.Navigate frmBrowser.cboAddress.Text
Exit For
End If
Next i
End Sub
Private Sub lsvAdd_ItemClick(ByVal Item As MSComctlLib.ListItem)
'单击ListView中相应的网址,将网址的内容加入到修改的文本框中以便于修改
selItemX = lsvAdd.SelectedItem.Index
oldSubject = Item.Text
txtSubject.Text = Item.Text
txtAdd.Text = Item.SubItems(1)
End Sub
Private Sub TreeView1_AfterLabelEdit(Cancel As Integer, NewString As String)
'可以从TreeView中直接修改收藏夹的名称
'修改后从数据库中找出相应的记录进行修改
Dim tempRec
'从数据库的表"user",找出记录收藏夹名称的记录进行修改
Set tempRec = faveDB.OpenRecordset("user", dbOpenDynaset)
tempRec.MoveFirst
Do Until tempRec.EOF
If tempRec!User = oldUser Then
With tempRec
.Edit
!User = NewString
.Update
End With
Exit Do
End If
tempRec.MoveNext
Loop
tempRec.Close
'从数据库的表"faveFold"中找出与修改前收藏夹的名称相一致的记录,
'将其字段user改为修改的收藏夹的名称
Set tempRec = faveDB.OpenRecordset("faveFold", dbOpenDynaset)
tempRec.MoveFirst
Do Until tempRec.EOF
If tempRec!User = oldUser Then
With tempRec
.Edit
!User = NewString
.Update
End With
End If
tempRec.MoveNext
Loop
tempRec.Close
End Sub
Private Sub TreeView1_BeforeLabelEdit(Cancel As Integer)
'在修改收藏夹之前,取得要修改的收藏夹的名称
Dim selItem1 As Integer
selItem1 = TreeView1.SelectedItem.Index
oldUser = TreeView1.Nodes(selItem1).Text
End Sub
Private Sub TreeView1_Collapse(ByVal Node As MSComctlLib.Node)
TreeView1.Nodes(1).Image = "closed"
End Sub
Private Sub TreeView1_Expand(ByVal Node As MSComctlLib.Node)
TreeView1.Nodes(1).Image = "open"
End Sub
Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
Dim i
'单击选择收藏夹,从数据库中找出相应的记录加入到ListView中
cmdEditAdd.Enabled = False
For i = 2 To TreeView1.Nodes.Count
TreeView1.Nodes(i).Checked = False
TreeView1.Nodes(i).Image = "closed"
Next i
Node.Image = "open"
Node.Checked = True
Dim selItem As Integer
selItem = TreeView1.SelectedItem.Index
Dim strUser As String
strUser = TreeView1.Nodes(selItem).Text
If selItem <> 1 Then
Do While lsvAdd.ListItems.Count <> 0
lsvAdd.ListItems.Remove 1
Loop
Dim strSql As String
strSql = "select * from faveFold where user ='" & strUser & "'"
Dim tempRec
Set tempRec = faveDB.OpenRecordset(strSql, dbOpenDynaset)
Dim itemX As ListItem
Do Until tempRec.EOF
Set itemX = lsvAdd.ListItems.Add(, , tempRec!subject)
itemX.SubItems(1) = tempRec!location
tempRec.MoveNext
Loop
End If
End Sub
Private Sub txtAdd_Change()
cmdEditAdd.Enabled = True
End Sub
Private Sub txtAdd_GotFocus()
'当输入焦点移动到文本框txtAdd中时,选择所有的文本
txtAdd.SelStart = 0
txtAdd.SelLength = Len(txtAdd.Text)
End Sub
Private Sub txtSubject_Change()
cmdEditAdd.Enabled = True
End Sub
Private Sub txtSubject_GotFocus()
'当输入焦点移动到文本框txtSubject中时,选择所有的文本
txtSubject.SelStart = 0
txtSubject.SelLength = Len(txtSubject.Text)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -