⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmfave.frm

📁 vb编程+从基础到实践光盘代码
💻 FRM
📖 第 1 页 / 共 2 页
字号:
    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 + -