formacc.frm

运输管理系统

    DataGrid1.Columns(8).Text = Me.TxtInsPay.Text
    DataGrid1.Columns(9).Text = Me.TxtComPay.Text
    DataGrid1.Columns(10).Text = Me.TxtOppPay.Text
    DataGrid1.Columns(11).Text = Me.TxtRemark.Text
    MsgBox "修改成功", , "修改事故记录"
End Sub

'查询按钮
Private Sub CmdQue_Click()
Dim Questr As String
Dim RsQuery As New ADODB.Recordset
Dim LtItm As ListItem
Dim Remark As String
Dim i As Integer
    
    '按车辆ID查询
    If Me.OptQue(0).Value = True Then
        '判断查询条件
        If Me.TxtQueCar.Text = "" Then
            MsgBox "请输入要查询的车辆ID！", , "查询事故记录"
            Exit Sub
        End If
        
        '生成查询语句
        Questr = "select * from AccRec where AccCarID = " & Val(Me.TxtQueCar.Text)
        
    '按司机ID查询
    ElseIf Me.OptQue(1).Value = True Then
        '判断查询条件
        If Me.TxtQueDriver.Text = "" Then
            MsgBox "请输入要查询的司机ID！", , "查询事故记录"
            Exit Sub
        End If
        
        '生成查询语句
        Questr = "select * from AccRec where AccDriverID = " & Val(Me.TxtQueDriver.Text)

    '按事故日期查询
    ElseIf Me.OptQue(2).Value = True Then
        '生成查询语句
        Questr = "select * from AccRec where AccDate= #" & Me.DTPQueDate.Value & "#"
    
    '按备注查询
    ElseIf Me.OptQue(3).Value = True Then
        '替换单引号
        Remark = Replace(Trim(Me.TxtQueRemark.Text), "'", "''")
        '生成查询语句
        Questr = "select * from AccRec where Remark Like '%" & 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("AcciID").Value
            LtItm.SubItems(1) = RsQuery.Fields("AcciCarID").Value
            LtItm.SubItems(2) = RsQuery.Fields("AcciDriverID").Value
            LtItm.SubItems(3) = RsQuery.Fields("AcciDate").Value
            LtItm.SubItems(4) = RsQuery.Fields("AcciPlace").Value
            LtItm.SubItems(5) = RsQuery.Fields("AcciOppName").Value
            LtItm.SubItems(6) = RsQuery.Fields("AcciOppNum").Value
            LtItm.SubItems(7) = RsQuery.Fields("AcciOppTel").Value
            LtItm.SubItems(8) = RsQuery.Fields("AcciInsPay").Value
            LtItm.SubItems(9) = RsQuery.Fields("AcciComPay").Value
            LtItm.SubItems(10) = RsQuery.Fields("AcciOppPay").Value
            If RsQuery.Fields("Remark").Value <> "" Then
                LtItm.SubItems(11) = RsQuery.Fields("Remark").Value
            End If
        '数据集指针指向下一条记录
        RsQuery.MoveNext
    Next i
    '关闭数据集
    RsQuery.Close
    
End Sub

'DataGrid控件中的焦点变换
Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
    '检验是否为空行
    If DataGrid1.Columns(0).Text = "" Then
        Exit Sub
    End If
    '将DataGrid中数据读入各个控件显示
    Me.CmbCarID.Text = DataGrid1.Columns(1).Text
    Me.CmbDriverID.Text = DataGrid1.Columns(2).Text
    Me.DTPDate.Value = DataGrid1.Columns(3).Text
    Me.TxtPlace.Text = DataGrid1.Columns(4).Text
    Me.TxtOppName.Text = DataGrid1.Columns(5).Text
    Me.TxtOppNum.Text = DataGrid1.Columns(6).Text
    Me.TxtOppTel.Text = DataGrid1.Columns(7).Text
    Me.TxtInsPay.Text = DataGrid1.Columns(8).Text
    Me.TxtComPay.Text = DataGrid1.Columns(9).Text
    Me.TxtOppPay.Text = DataGrid1.Columns(10).Text
    Me.TxtRemark.Text = DataGrid1.Columns(11).Text
End Sub

Private Sub Form_Load()
Dim RsDB As New ADODB.Recordset
Dim i As Integer

    '初始化日期
    Me.DTPDate.Value = Format(Now, "yyyy-mm-dd")
    Me.DTPQueDate.Value = Format(Now, "yyyy-mm-dd")
    
    '初始化ADO控件，连接数据库，设置列首
    Adodc1.ConnectionString = CnStr
    Adodc1.RecordSource = "Select AcciID as 事故信息记录号," & _
                                 "AcciCarID as 事故车辆ID," & _
                                 "AcciDriverID as 事故司机ID," & _
                                 "AcciDate as 事故日期," & _
                                 "AcciPlace as 事故地点," & _
                                 "AcciOppName as 事故对象姓名," & _
                                 "AcciOppNum as 事故对象身份证号," & _
                                 "AcciOppTel as 事故对象电话," & _
                                 "AcciInsPay as 保险理陪金额," & _
                                 "AcciComPay as 公司负担金额," & _
                                 "AcciOppPay as 对方负担金额," & _
                                 "Remark as 备注 " & _
                                 "From AccRec"
    Debug.Print Adodc1.RecordSource
    Set DataGrid1.DataSource = Adodc1   '不能缺少
    
    '读入已有车辆ID和司机ID
    RsDB.Open "select CarID from CarInfo order by CarID ", DBCn, adOpenStatic, adLockReadOnly, -1
    If RsDB.RecordCount > 0 Then
        If Not RsDB.BOF Then RsDB.MoveFirst
        For i = 1 To RsDB.RecordCount
            Me.CmbCarID.AddItem (RsDB.Fields("CarID").Value)
        If Not RsDB.EOF Then RsDB.MoveNext
        Next i
    Else
        MsgBox "还没有车辆档案，不能添加事故记录", , "车辆事故记录管理"
    End If
    RsDB.Close
    RsDB.Open "select DriverID from DriverInfo order by DriverID ", DBCn, adOpenStatic, adLockReadOnly, -1
    If RsDB.RecordCount > 0 Then
        If Not RsDB.BOF Then RsDB.MoveFirst
        For i = 1 To RsDB.RecordCount
            Me.CmbDriverID.AddItem (RsDB.Fields("DriverID").Value)
        If Not RsDB.EOF Then RsDB.MoveNext
        Next i
    Else
        MsgBox "还没有司机档案，不能添加事故记录", , "车辆事故记录管理"
    End If
    RsDB.Close
End Sub

'添加事故记录
Private Sub CmdAdd_Click()
Dim rsAdd As New ADODB.Recordset
Dim SqlStr As String

Dim Remark As String

    '首先检验输入
    '没有选择车辆ID
    If Len(Trim(Me.CmbCarID.Text)) <= 0 Then
        MsgBox "请选择车辆ID！", , "添加事故记录"
        Exit Sub
    End If
    '没有选择司机ID
    If Len(Trim(Me.CmbDriverID.Text)) <= 0 Then
        MsgBox "请选择司机ID！", , "添加事故记录"
        Exit Sub
    End If
    '没有事故地点
    If Len(Trim(Me.TxtPlace.Text)) <= 0 Then
        MsgBox "请输入事故地点！", , "添加事故记录"
        Exit Sub
    End If
    '没有输入事故对象姓名
    If Len(Trim(Me.TxtOppName.Text)) <= 0 Then
        MsgBox "请输入事故对象姓名！", , "添加事故记录"
        Exit Sub
    End If
    '输入事故对象姓名不正确
    If Len(Trim(Me.TxtOppName.Text)) < 2 Or Len(Trim(Me.TxtOppName.Text)) > 4 Then
        MsgBox "输入事故对象姓名不正确！", , "添加事故记录"
        Exit Sub
    End If
    
    '没有输入身份证号
    If Len(Trim(Me.TxtOppNum.Text)) <= 0 Then
        MsgBox "请输入18位身份证号！", , "添加事故记录"
        Exit Sub
    End If
    '输入身份证号不正确
    If Len(Trim(Me.TxtOppNum.Text)) <> 18 Then
        MsgBox "身份证号不正确,请输入18位身份证号！", , "添加事故记录"
        Exit Sub
    End If
    '没有输入电话号
    If Len(Trim(Me.TxtOppTel.Text)) <= 0 Then
        MsgBox "请输入11位电话号！", , "添加事故记录"
        Exit Sub
    End If
    '输入的电话不正确
    If Len(Trim(Me.TxtOppTel.Text)) <> 11 Then
        MsgBox "输入的电话不正确,请输入11位电话号码！", , "添加事故记录"
        Exit Sub
    End If
    '没有输入保险理陪金额
    If Len(Trim(Me.TxtInsPay.Text)) <= 0 Then
        MsgBox "请输入保险理陪金额！", , "添加事故记录"
        Exit Sub
    End If
    '没有输入公司负担金额
    If Len(Trim(Me.TxtComPay.Text)) <= 0 Then
        MsgBox "请输入公司负担金额！", , "添加事故记录"
        Exit Sub
    End If
    '没有输入对方负担金额
    If Len(Trim(Me.TxtOppPay.Text)) <= 0 Then
        MsgBox "请输入对方负担金额！", , "添加事故记录"
        Exit Sub
    End If
        
        
    '检验完毕,数据入库，备注项可选
    If Me.TxtRemark.Text = vbNullString Then '没有备注项
        SqlStr = "INSERT INTO AccRec"
        SqlStr = SqlStr & "(AcciCarID,AcciDriverID,AcciDate,AcciPlace,AcciOppName,AcciOppNum,AcciOppTel,AcciInsPay,AcciComPay,AcciOppPay) "
        SqlStr = SqlStr & "VALUES ('" & Me.CmbCarID.Text & "',"
        SqlStr = SqlStr & "'" & Me.CmbDriverID.Text & "',"
        SqlStr = SqlStr & "#" & Me.DTPDate.Value & "#,"
        SqlStr = SqlStr & "'" & Me.TxtPlace.Text & "',"
        SqlStr = SqlStr & "'" & Me.TxtOppName.Text & "',"
        SqlStr = SqlStr & "'" & Me.TxtOppNum.Text & "',"
        SqlStr = SqlStr & "'" & Me.TxtOppTel.Text & "',"
        SqlStr = SqlStr & "'" & Me.TxtInsPay.Text & "',"
        SqlStr = SqlStr & "'" & Me.TxtComPay.Text & "',"
        SqlStr = SqlStr & "'" & Me.TxtOppPay.Text & "');"
        Debug.Print SqlStr
        DBCn.Execute SqlStr
        
    Else    '有备注项
        Remark = Replace(Trim(Me.TxtRemark.Text), "'", "''")
        SqlStr = "INSERT INTO AccRec"
        SqlStr = SqlStr & "(AcciCarID,AcciDriverID,AcciDate,AcciPlace,AcciOppName,AcciOppNum,AcciOppTel,AcciInsPay,AcciComPay,AcciOppPay,Remark) "
        SqlStr = SqlStr & "VALUES ('" & Me.CmbCarID.Text & "',"
        SqlStr = SqlStr & "'" & Me.CmbDriverID.Text & "',"
        SqlStr = SqlStr & "#" & Me.DTPDate.Value & "#,"
        SqlStr = SqlStr & "'" & Me.TxtPlace.Text & "',"
        SqlStr = SqlStr & "'" & Me.TxtOppName.Text & "',"
        SqlStr = SqlStr & "'" & Me.TxtOppNum.Text & "',"
        SqlStr = SqlStr & "'" & Me.TxtOppTel.Text & "',"
        SqlStr = SqlStr & "'" & Me.TxtInsPay.Text & "',"
        SqlStr = SqlStr & "'" & Me.TxtComPay.Text & "',"
        SqlStr = SqlStr & "'" & Me.TxtOppPay.Text & "',"
        SqlStr = SqlStr & "'" & Remark & "');"
        Debug.Print SqlStr
        DBCn.Execute SqlStr
        
    End If

    MsgBox "添加成功", , "添加事故记录"
    Adodc1.Refresh
End Sub

'设置焦点对应的单选按钮
Private Sub TxtQueCar_GotFocus()
    Me.OptQue(0).Value = True
    EmptyQue
End Sub
Private Sub TxtQueDriver_GotFocus()
    Me.OptQue(1).Value = True
    EmptyQue
End Sub
Private Sub DTPQueDate_Click()
    Me.OptQue(2).Value = True
    EmptyQue
End Sub
Private Sub TxtQueRemark_GotFocus()
    Me.OptQue(3).Value = True
    EmptyQue
End Sub
'清空查询内容函数
Private Sub EmptyQue()
    Me.TxtQueCar.Text = ""
    Me.TxtQueDriver.Text = ""
    Me.DTPQueDate.Value = "2006-1-1"
    Me.TxtQueRemark.Text = ""
End Sub