DEMO:通讯录（三）

四、功能代码：

'①主窗体代码：

’定义ADO的模型对象，用来数据库的连接和操作

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

Private Sub CKLXR_Click()
’查看全部联系人

    Dim i As Integer
    Dim list
    If ObjRs.EOF And ObjRs.BOF Then
        ObjRs.Close
'        MsgBox "通讯录中没有联系人"
        ObjRs.Open
        CKLXR.Enabled = True
    Else
        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 i
            ObjRs.MoveNext
        Loop
        ObjRs.Close
        CKLXR.Enabled = False
    End If
End Sub

Private Sub CZ_Click()
    FormCZ.Show 1
End Sub

'窗体加载的时候将listview控件填充表头

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 ObjCmd = New Command
    Set ObjCn = New Connection
    ObjCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=txl.mdb;Persist Security Info=False"
    ObjRs.Open "select * from message order by 姓名", ObjCn, 3, 1
End Sub

Private Sub SC_Click()
    FormDel.Show 1
End Sub

'用timer控件完成窗体显示的动态更新

Private Sub Timer2_Timer()
    Unload FormMain
    FormMain.Show
    Call CKLXR_Click
    Timer2.Enabled = False
End Sub

'用timer控件显示时间

Private Sub TimerNow_Timer()
    Label1.Caption = "今天是" & "" & Format(Now, "yyyy" & "年" & "mm" & "月" & "dd" & "日" & "   " & _
                     "现在是：" & "hh" & "时" & "mm" & "分" & "ss" & "秒")
End Sub

Private Sub TJ_Click()
    FormTJ.Show 1
End Sub

Private Sub XG_Click()
    FormXG.Show 1
End Sub

 

②添加联系人窗体代码：

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

'数据添加和矫正

Private Sub Command1_Click()
    Dim a As Integer
    If TextName.Text <> "" And TextNL.Text <> "" And _
        Combo1.Text <> "" And TextDH.Text <> "" And TextSJ.Text <> "" _
        And TextDZ.Text <> "" And TextDW.Text <> "" Then
        If IsNumeric(TextNL.Text) Then
            If IsNumeric(TextDH.Text) Then
                If IsNumeric(TextSJ.Text) Then
                    ObjRs.Open "select * from message order by 编号", ObjCn, 3, 1
                    ObjCmd.ActiveConnection = ObjCn
                    ObjCmd.CommandText = "insert into message values(trim('" & TextBH & "'),trim('" & TextName & "'),trim('" & TextNL & "'),trim('" & Combo1 & "'),trim('" & TextDH & "'),trim('" & TextSJ & "'),trim('" & TextDZ & "'),trim('" & TextDW & "'))"
                    ObjCn.BeginTrans
                    ObjCmd.Execute
                    ObjCn.CommitTrans
                    ObjRs.Close
                    a = MsgBox("填加联系人" & "【" & TextName.Text & "】" & "成功", 0, "提示")
                    Unload Me
                    FormMain.Timer2.Enabled = True
                Else
                    MsgBox "手机号码必须是纯数字"
                    TextSJ.Text = ""
                    TextSJ.SetFocus
                End If
            Else
                MsgBox "住宅电话必须是纯数字"
                TextDH.Text = ""
                TextDH.SetFocus
            End If
        Else
            MsgBox "年龄必须是纯数字"
            TextNL.Text = ""
            TextNL.SetFocus
        End If
    Else
        MsgBox "资料没有填写完全，请填写完整！"
        TextName.SetFocus
    End If
End Sub

'重新填充

Private Sub Command2_Click()
    TextName = ""
    TextNL.Text = ""
    TextDH.Text = ""
    TextSJ.Text = ""
    TextDZ.Text = ""
    TextDW.Text = ""
    TextName.SetFocus
End Sub

Private Sub Command3_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    Set ObjRs = New Recordset
    Set ObjCmd = New Command
    Set ObjCn = New Connection
    ObjCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=txl.mdb;Persist Security Info=False"
    TextBH.Text = Format(Now, "yyyy" & "mm" & "dd" & "hh" & "mm" & "ss")
    TextBH.Visible = False
End Sub