formdriver.frm

运输管理系统

    Else
        Me.OptSex(1).Value = True
    End If
    Me.DTPBir.Value = DataGrid1.Columns(4).Text
    Me.TxtWorkNum.Text = DataGrid1.Columns(5).Text
    Me.TxtTel.Text = DataGrid1.Columns(6).Text
    Me.TxtTeam.Text = DataGrid1.Columns(7).Text
    Me.TxtLicenceNum.Text = DataGrid1.Columns(8).Text
    Me.DTPLicDate.Value = DataGrid1.Columns(9).Text
    Me.TxtRemark.Text = DataGrid1.Columns(10).Text
End Sub


'*********************************************************************
'添加司机档案
'*********************************************************************

'清空按钮
Private Sub CmdEmpty_Click()
    Me.TxtName.Text = ""
    Me.TxtNum.Text = ""
    Me.OptSex(0).Value = False
    Me.OptSex(1).Value = False
    Me.DTPBir.Value = "2000-1-1"
    Me.TxtWorkNum.Text = ""
    Me.TxtTel.Text = ""
    Me.TxtTeam.Text = ""
    Me.TxtLicenceNum.Text = ""
    Me.DTPLicDate.Value = "2008-1-1"
    Me.TxtRemark.Text = ""
End Sub

'添加按钮
Private Sub CmdAdd_Click()
Dim DriverSex As Integer
Dim rsAdd As New ADODB.Recordset
Dim SqlStr As String
Dim Remark As String

    '首先检验输入
    '没有输入司机姓名
    If Len(Trim(Me.TxtName.Text)) <= 0 Then
        MsgBox "请输入司机姓名！", , "添加司机档案"
        Exit Sub
    End If
    '输入司机姓名不正确
    If Len(Trim(Me.TxtName.Text)) < 2 Or Len(Trim(Me.TxtName.Text)) > 4 Then
        MsgBox "输入司机姓名不正确！", , "添加司机档案"
        Exit Sub
    End If
    
    '没有输入身份证号
    If Len(Trim(Me.TxtNum.Text)) <= 0 Then
        MsgBox "请输入18位身份证号！", , "添加司机档案"
        Exit Sub
    End If
    '输入身份证号不正确
    If Len(Trim(Me.TxtNum.Text)) <> 18 Then
        MsgBox "身份证号不正确,请输入18位身份证号！", , "添加司机档案"
        Exit Sub
    End If
   
    '没有选择司机性别
    If Me.OptSex(0).Value = False And Me.OptSex(1).Value = False Then
        MsgBox "请选择司机性别！", , "添加司机档案"
        Exit Sub
    End If
    
    '没有输入司机工号
    If Len(Trim(Me.TxtWorkNum.Text)) <= 0 Then
        MsgBox "请输入司机工号！", , "添加司机档案"
        Exit Sub
    End If
    
    
    '没有输入电话号
    If Len(Trim(Me.TxtTel.Text)) <= 0 Then
        MsgBox "请输入11位电话号！", , "添加司机档案"
        Exit Sub
    End If
    '输入的电话不正确
    If Len(Trim(Me.TxtTel.Text)) <> 11 Then
        MsgBox "输入的电话不正确,请输入11位电话号码！", , "添加司机档案"
        Exit Sub
    End If
    
    '没有输入隶属车队名
    If Len(Trim(Me.TxtTeam.Text)) <= 0 Then
        MsgBox "请输入隶属车队名！", , "添加司机档案"
        Exit Sub
    End If
    
    '没有输入司机驾照号
    If Len(Trim(Me.TxtLicenceNum.Text)) <= 0 Then
        MsgBox "请输入司机驾照号！", , "添加司机档案"
        Exit Sub
    End If
    
    '检验完毕,数据入库
    If Me.OptSex(0).Value = True Then
        DriverSex = 0
    Else
        DriverSex = -1
    End If
    
    '备注项可选
    If Me.TxtRemark.Text = vbNullString Then '没有备注项
        SqlStr = "INSERT INTO DriverInfo"
        SqlStr = SqlStr & "(DriverName,DriverNum,DriverSex,DriverBir,DriverWorkNum,"
        SqlStr = SqlStr & "DriverTel,DriverTeam,DriverLicenceNum,DriverLicenceDate) "
        SqlStr = SqlStr & "VALUES ('" & Me.TxtName.Text & "',"
        SqlStr = SqlStr & "'" & Me.TxtNum.Text & "',"
        SqlStr = SqlStr & DriverSex & ","
        SqlStr = SqlStr & "#" & Me.DTPBir.Value & "#,"
        SqlStr = SqlStr & Me.TxtWorkNum.Text & ","
        SqlStr = SqlStr & "'" & Me.TxtTel.Text & "',"
        SqlStr = SqlStr & "'" & Me.TxtTeam.Text & "',"
        SqlStr = SqlStr & "'" & Me.TxtLicenceNum.Text & "',"
        SqlStr = SqlStr & "#" & Me.DTPLicDate.Value & "#);"
        Debug.Print SqlStr
        DBCn.Execute SqlStr
        
    Else    '有备注项
        Remark = Replace(Trim(Me.TxtRemark.Text), "'", "''")
        SqlStr = "INSERT INTO DriverInfo"
        SqlStr = SqlStr & "(DriverName,DriverNum,DriverSex,DriverBir,DriverWorkNum,"
        SqlStr = SqlStr & "DriverTel,DriverTeam,DriverLicenceNum,DriverLicenceDate,"
        SqlStr = SqlStr & "Remark) "
        SqlStr = SqlStr & "VALUES ('" & Me.TxtName.Text & "',"
        SqlStr = SqlStr & "'" & Me.TxtNum.Text & "',"
        SqlStr = SqlStr & DriverSex & ","
        SqlStr = SqlStr & "#" & Me.DTPBir.Value & "#,"
        SqlStr = SqlStr & Me.TxtWorkNum.Text & ","
        SqlStr = SqlStr & "'" & Me.TxtTel.Text & "',"
        SqlStr = SqlStr & "'" & Me.TxtTeam.Text & "',"
        SqlStr = SqlStr & "'" & Me.TxtLicenceNum.Text & "',"
        SqlStr = SqlStr & "#" & Me.DTPLicDate.Value & "#,"
        SqlStr = SqlStr & "'" & Remark & "');"
        Debug.Print SqlStr
        DBCn.Execute SqlStr
        
    End If

    MsgBox "添加成功", , "添加司机档案"
    Adodc1.Refresh
End Sub

'*********************************************************************
'修改司机档案
'*********************************************************************

'修改按钮
Private Sub CmdMod_Click()
    DataGrid1.Columns(1).Text = Me.TxtName.Text
    DataGrid1.Columns(2).Text = Me.TxtNum.Text
    If Me.OptSex(0).Value = True Then
        DataGrid1.Columns(3).Text = 0
    Else
        DataGrid1.Columns(3).Text = -1
    End If
    DataGrid1.Columns(4).Text = Me.DTPBir.Value
    DataGrid1.Columns(5).Text = Me.TxtWorkNum.Text
    DataGrid1.Columns(6).Text = Me.TxtTel.Text
    DataGrid1.Columns(7).Text = Me.TxtTeam.Text
    DataGrid1.Columns(8).Text = Me.TxtLicenceNum.Text
    DataGrid1.Columns(9).Text = Me.DTPLicDate.Value
    DataGrid1.Columns(10).Text = Me.TxtRemark.Text
    MsgBox "修改成功", , "修改司机档案"
End Sub


'*********************************************************************
'删除司机档案
'*********************************************************************

'删除按钮
Private Sub CmdDel_Click()
    On Error GoTo Err:
    
    If MsgBox("确定要删除选定档案吗？", vbOKCancel, "删除档案") = vbOK Then
        Adodc1.Recordset.Delete
        MsgBox "删除成功！", , "删除档案"
        CmdEmpty_Click
    End If
    Exit Sub
Err:
    MsgBox "其他表中包含相关记录，不能删除！", , "删除档案"
End Sub


'*********************************************************************
'司机档案查询
'*********************************************************************

'查询按钮
Private Sub CmdQue_Click()
Dim Questr As String
Dim RsQuery As New ADODB.Recordset
Dim DriverName As String
Dim Remark As String
Dim LtItm As ListItem
Dim i As Integer
    
    '按姓名查询
    If Me.OptQue(0).Value = True Then
        '判断查询条件
        If Me.TxtQueName.Text = "" Then
            MsgBox "请输入要查询的司机姓名！", , "查询司机档案"
            Exit Sub
        ElseIf Len(Trim(Me.TxtQueName.Text)) > 4 Then
            MsgBox "司机姓名长度超出范围！", , "查询司机档案"
            Exit Sub
        End If
        
        '替换单引号
        DriverName = Replace(Trim(Me.TxtQueName.Text), "'", "''")
        '生成查询语句
        Questr = "select * from DriverInfo where DriverName Like '%" & DriverName & "%'"
        
    '按身份证号查询
    ElseIf Me.OptQue(1).Value = True Then
        '判断查询条件
        If Me.TxtQueNum.Text = "" Then
            MsgBox "请输入要查询的身份证号！", , "查询司机档案"
            Exit Sub
        ElseIf Len(Trim(Me.TxtQueNum.Text)) > 18 Then
            MsgBox "身份证号长度不符！", , "查询司机档案"
            Exit Sub
        End If
        
        '生成查询语句
        Questr = "select * from DriverInfo where DriverNum Like '%"
        Questr = Questr & Me.TxtQueNum.Text & "%'"
    
    '按性别查询
    ElseIf Me.OptQue(2).Value = True Then
        '生成查询语句
        If Me.OptQueSex(0).Value = True Then
            Questr = "select * from DriverInfo where DriverSex = 0"
        Else
            Questr = "select * from DriverInfo where DriverSex = -1"
        End If
        
    '按工号查询
    ElseIf Me.OptQue(3).Value = True Then
        Questr = "select * from DriverInfo where DriverWorkNum = "
        Questr = Questr & Val(Me.TxtQueWorkNum.Text)
    
    '按备注查询
    ElseIf Me.OptQue(4).Value = True Then
        '替换单引号
        Remark = Replace(Trim(Me.TxtQueRemark.Text), "'", "''")
        '生成查询语句
        Questr = "select * from DriverInfo where Remark Like '%"
        Questr = Questr & Remark & "%'"
    
    End If
    
    '打开数据集
    Debug.Print Questr
    RsQuery.Open Questr, DBCn, adOpenStatic, adLockOptimistic
    '显示查询结果
    If RsQuery.EOF Then
        MsgBox "数据库中没有符合要求的记录！", , "查询司机档案"
        Exit Sub
    End If
    Me.LvResult.Visible = True
    Me.CmdBack.Visible = True
   
    '清空列表
    Me.LvResult.ListItems.Clear
    '数据集指针指向第一个记录
    RsQuery.MoveFirst
    For i = 1 To RsQuery.RecordCount
        Set LtItm = Me.LvResult.ListItems.Add()
            LtItm.Text = RsQuery.Fields("DriverID").Value
            LtItm.SubItems(1) = RsQuery.Fields("DriverName").Value
            LtItm.SubItems(2) = RsQuery.Fields("DriverNum").Value
            If RsQuery.Fields("DriverSex").Value = 0 Then
                LtItm.SubItems(3) = "男"
            Else
                LtItm.SubItems(3) = "女"
            End If
            LtItm.SubItems(4) = RsQuery.Fields("DriverBir").Value
            LtItm.SubItems(5) = RsQuery.Fields("DriverWorkNum").Value
            LtItm.SubItems(6) = RsQuery.Fields("DriverTel").Value
            LtItm.SubItems(7) = RsQuery.Fields("DriverTeam").Value
            LtItm.SubItems(8) = RsQuery.Fields("DriverLicenceNum").Value
            LtItm.SubItems(9) = RsQuery.Fields("DriverLicenceDate").Value
            If RsQuery.Fields("Remark").Value <> "" Then
                LtItm.SubItems(10) = RsQuery.Fields("Remark").Value
            End If
        '数据集指针指向下一条记录
        RsQuery.MoveNext
    Next i
    '关闭数据集
    RsQuery.Close
    
End Sub

'返回按钮
Private Sub CmdBack_Click()
    Me.LvResult.Visible = False
    Me.CmdBack.Visible = False
End Sub

'设置焦点对应的单选按钮
Private Sub TxtQueName_GotFocus()
    Me.OptQue(0).Value = True
    EmptyQue
End Sub
Private Sub TxtQueNum_GotFocus()
    Me.OptQue(1).Value = True
    EmptyQue
End Sub
Private Sub OptQueSex_Click(Index As Integer)
    Me.OptQue(2).Value = True
    EmptyQue
End Sub
Private Sub TxtQueWorkNum_GotFocus()
    Me.OptQue(3).Value = True
    EmptyQue
End Sub
Private Sub TxtQueRemark_GotFocus()
    Me.OptQue(4).Value = True
    EmptyQue
End Sub

'清空查询内容函数
Private Sub EmptyQue()
    Me.TxtQueName.Text = ""
    Me.TxtQueNum.Text = ""
    Me.TxtQueWorkNum.Text = ""
    Me.TxtQueRemark.Text = ""
End Sub