DEMO:通讯录（四）

③修改联系人窗体的代码：

Dim ObjCn As Connection
Dim ObjRs As Recordset
Dim ObjCmd As Command
Dim list As ListItem

'查找要修改的联系人

Private Sub Command1_Click()
    Dim i As Integer
    If Text1.Text = "" Then
        MsgBox "请输入您要修改的联系人！"
        Text1.SetFocus
    Else
        ObjRs.Open "select * from message where 姓名='" & Text1.Text & "'", ObjCn, 3, 1
'        ObjRs.Open "select * from message where 姓名='" & Text1 & "'", ObjCn, 3, 1
        If ObjRs.BOF And ObjRs.EOF Then
            ObjRs.Close
            MsgBox "没有找到您要修改的联系人！"
            Text1.Text = ""
            Text1.SetFocus
        Else
            Picture1.Visible = True
            ObjRs.MoveFirst
            Do While ObjRs.EOF = False
                Set list = ListView1.ListItems.Add(, , ObjRs.Fields(0))
                For i = 1 To ObjRs.Fields.Count - 1
                    list.SubItems(i) = ObjRs.Fields(i)
                Next
                ObjRs.MoveNext
            Loop
            ObjRs.Close
            MsgBox "您要修改的联系人" & Text1.Text & "已经全部显示！"
            Command1.Enabled = False
        End If
    End If
End Sub

Private Sub Command2_Click()
    Unload Me
End Sub

'删除显示的联系人

Private Sub Command3_Click()
    Dim a As Integer

    If Text3.Text = "" Or Text4.Text = "" Or Combo1.Text = "" Or Text5.Text = "" Or Text6.Text = "" Or Text7.Text = "" Or Text8.Text = "" Then
        a = MsgBox("请填写完整的资料,没有的请填写无！", 0, "提示")
    Else
       ObjRs.Open "select * from message where 编号='" & Text2 & "'", ObjCn, 3, 1
        ObjCmd.ActiveConnection = ObjCn
        If Not (ObjRs.EOF And ObjRs.BOF) Then
            ObjCmd.CommandText = "update message set 姓名= trim('" & Text2 & "'),年龄=trim('" & Text3 & "'),性别=trim('" & Combo1 & "'),住宅电话=trim('" & Text4 & "'),手机号码=trim('" & Text5 & "'),家庭住址=trim('" & Text6 & "'),工作单位=trim('" & Text7 & "') where 编号='" & Text8.Text & "'"
            ObjCn.BeginTrans
            ObjCmd.Execute
            ObjCn.CommitTrans
            ListView1.ListItems.Clear
            a = MsgBox("修改联系人" & "【" & Text1.Text & "】" & "成功！", 0, "提示")
            ObjRs.Close
            Unload Me
            FormMain.Timer2.Enabled = True
        End If
    End If
End Sub

Private Sub ListView1_BeforeLabelEdit(Cancel As Integer)
    Cancel = True
End Sub

'单击listview中的任何一个项目都会全选一行
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
    Text2.Text = Item.Text
    Text3.Text = Item.SubItems(1)
    Text4.Text = Item.SubItems(2)
    Combo1.Text = Item.SubItems(3)
    Text5.Text = Item.SubItems(4)
    Text6.Text = Item.SubItems(5)
    Text7.Text = Item.SubItems(6)
    Text8.Text = Item.SubItems(7)
End Sub

'加载表头
Private Sub Form_Load()
    Dim l1
    ListView1.GridLines = True
    ListView1.FullRowSelect = True
    ListView1.View = lvwReport
    Set l1 = ListView1.ColumnHeaders.Add(, , "编号", 0)
    Set l1 = ListView1.ColumnHeaders.Add(, , "姓名", 1000)
    Set l1 = ListView1.ColumnHeaders.Add(, , "年龄", 700)
    Set l1 = ListView1.ColumnHeaders.Add(, , "性别", 700)
    Set l1 = ListView1.ColumnHeaders.Add(, , "住宅电话", 1300)
    Set l1 = ListView1.ColumnHeaders.Add(, , "手机号码", 1300)
    Set l1 = ListView1.ColumnHeaders.Add(, , "家庭住址", 1400)
    Set l1 = ListView1.ColumnHeaders.Add(, , "工作单位", 1800)
    Set ObjRs = New Recordset
    Set ObjCn = New Connection
    Set ObjCmd = New Command
    ObjCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=txl.mdb;Persist Security Info=False"
    Picture1.Visible = False
End Sub

④查找联系人窗口代码：

Dim ObjRs As Recordset
Dim ObjCn As Connection
Dim ObjCmd As Command

Private Sub Command1_Click()
    Dim a
    Dim list
    If Text1.Text = "" Then
       a = MsgBox("请填写联系人姓名！", 0, "提示")
       Text1.SetFocus
    Else
        ObjRs.Open "select * from message where 姓名='" & Text1.Text & "'", ObjCn, 3, 1
        If ObjRs.EOF And ObjRs.BOF Then
            ObjRs.Close
            a = MsgBox("没有" & "【" & Text1.Text & "】的联系资料,是否填加此联系人？", 32 & vbYesNo, "提示")
            If a = vbYes Then
                Unload Me
                FormTJ.Show 1
            Else
                Text1.Text = ""
                Text1.SetFocus
            End If
        Else
             ObjRs.MoveFirst
        Do While ObjRs.EOF = False
            Set list = ListView1.ListItems.Add(, , ObjRs.Fields(0))
            For a = 1 To ObjRs.Fields.Count - 1
                list.SubItems(a) = ObjRs.Fields(a)
            Next a
        ObjRs.MoveNext
        Loop
        a = MsgBox("联系人名字为" & "【" & Text1.Text & "】已全部显示", 0, "提示")
        Text1.Text = ""
        Command1.Enabled = False
        ObjRs.Close
        End If
    End If
End Sub

Private Sub Command2_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    Dim l1
    ListView1.GridLines = True
    ListView1.FullRowSelect = True
    ListView1.View = lvwReport
    Set l1 = ListView1.ColumnHeaders.Add(, , "编号", 0)
    Set l1 = ListView1.ColumnHeaders.Add(, , "姓名", 1000)
    Set l1 = ListView1.ColumnHeaders.Add(, , "年龄", 700)
    Set l1 = ListView1.ColumnHeaders.Add(, , "性别", 700)
    Set l1 = ListView1.ColumnHeaders.Add(, , "住宅电话", 1300)
    Set l1 = ListView1.ColumnHeaders.Add(, , "手机号码", 1300)
    Set l1 = ListView1.ColumnHeaders.Add(, , "家庭住址", 1400)
    Set l1 = ListView1.ColumnHeaders.Add(, , "工作单位", 1800)
    Set ObjRs = New Recordset
    Set ObjCn = New Connection
    Set ObjCmd = New Command
    ObjCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=txl.mdb;Persist Security Info=False"
End Sub