main.frm

VB编写的汽车训练场管理系统。可做毕业设计参考/

    
End Sub


Private Sub Combo1_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then Command3_Click: Text2.SetFocus
End Sub

Private Sub Command1_Click()
  On Error Resume Next
  Dim RS As New ADODB.Recordset
  Dim Bj As String
  Dim Sj As String
  Dim cs As Boolean
  cs = False
  If Len(Label4.Caption) = 0 Then
         MsgBox "服务器没有本车信息，系统不予提交", 0 + vbExclamation, "系统提示"
         MsgBox "提交失败", 0 + vbExclamation, "系统提示"
         Exit Sub
  End If
  If Label5.Caption = Label4.Caption Then
         MsgBox "服务器没有本车信息，系统不予提交", 0 + vbExclamation, "系统提示"
         MsgBox "提交失败", 0 + vbExclamation, "系统提示"
         Exit Sub
  End If
  If Val(Text3.Text) < 0 Then
         If MsgBox("所剩卡时不够消费，系统不予提交，是否交费？", 1 + vbExclamation, "系统提示") = vbOK Then
              Bj = Str(Abs(Val(Label23.Caption) * Val(Text3.Text)))
              Sj = Str(InputBox("收费："))
              Label22.Caption = (Val(Sj) - Val(Bj)) & "元"
         Else
           MsgBox "提交失败", 0 + vbExclamation, "系统提示"
           Exit Sub
         End If
  End If
  If Val(Text3.Text) < 2 Then
              MsgBox "本卡需回收", 0 + vbExclamation, "系统提示"
              Cn.Execute "INSERT cssf VALUES('" & Id_KH & "','" & Text1.Text & "','" & Abs(Val(Text3.Text)) & "','" & Bj & "','" & Yh & "''" & format(Date, "yyyy-mm-dd") & "')"
              LSSql = " where cph='" & Trim(Text1.Text) & "' and cps='" & Trim(Combo1.Text) & "' and rcsj between '" & format(BKsj, "yyyy年mm月dd日") & "00时00分' and '" & format(Date, "yyyy年mm月dd日") & format(Time, "HH时NN分") & "'"
              cs = True
  End If
  If Val(Text2.Text) = 0 And Val(Label19.Caption) = 0 Then
         MsgBox "所需资料不足，系统不予提交", 0 + vbExclamation, "系统提示"
         MsgBox "提交失败", 0 + vbExclamation, "系统提示"
         Exit Sub
  End If
  If MsgBox("确认提交", 1 + 32, "") <> vbOK Then
     Exit Sub
  End If
  Err.Clear
  RS.CursorLocation = adUseClient
  RS.Open "select * from ls where cph='" & Trim(Text1.Text) & "' and cps='" & Trim(Combo1.Text) & "' and rcsj='" & Trim(Label4.Caption) & "'", Cn, 1, 3
  RS.AddNew
  RS("cph") = Trim(Text1.Text)
  RS("cps") = Trim(Combo1.Text)
  RS("clly") = Trim(Label6.Caption)
  RS("rcsj") = Trim(Label4.Caption)
  RS("ccsj") = Trim(Label5.Caption)
  RS("yhjb") = Trim(Label12.Caption)
  RS("xfsj") = Mid(Trim(Label25.Caption), 1, 3)
  RS("xfje") = Trim(Label19.Caption)
  RS("clr") = Yh
  RS("tp") = Adodc1.Recordset("tp")
  RS.Update
  RS.Close
  If Err.Number Then
     MsgBox Err.Description & Chr(13) & "      提交失败", 0 + vbCritical, "系统提示"
     Exit Sub
  End If
  Err.Clear
  Cn.Execute "delete from rc where cph='" & Trim(Text1.Text) & "' and cps='" & Trim(Combo1.Text) & "' and rcsj='" & Trim(Label4.Caption) & "'"
  If Err.Number Then
     MsgBox Err.Description & Chr(13) & "      数据清除失败", 0 + vbCritical, "系统提示"
     Exit Sub
  End If
  If Id_KH <> "" Then
        RS.CursorLocation = adUseClient
        RS.Open "select ye from idyh where kh='" & Id_KH & "'", Cn, 1, 3
        RS("ye") = Trim(Str(Val(RS("ye")) - Val(Label25.Caption)))
        RS.Update
        RS.Close
  End If
  If cs Then
     If MsgBox(" 是否打印票据", 1 + 32, "系统提示") = vbOK Then
        DataReport1.Show
     End If
  End If
  Label7.Caption = ""
  Label8.Caption = ""
 ' Label11.Caption = ""
  Label13.Caption = ""
  Label4.Caption = ""
  Label5.Caption = ""
  Label6.Caption = ""
  Label23.Caption = ""
  Label17.Caption = ""
  Label25.Caption = ""
  Label19.Caption = ""
  Text2.Text = "0"
  MsgBox "提交成功", 0 + vbExclamation, "系统提示"
End Sub

Private Sub Command2_Click()
  Unload Me
End Sub

Private Sub Command3_Click()
  Dim CCSJ As String, RCSJ As String
  Dim XfSj As Double
  Adodc1.RecordSource = "select rc.idh,rc.cph,rc.cps,rc.clly,rc.rcsj,rc.tp,clly.sf from rc ,clly where clly.ly=rc.clly and cph='" & Trim(Text1.Text) & "' and cps='" & Trim(Combo1.Text) & "' order by rcsj desc"
  Adodc1.Refresh
  If Adodc1.Recordset.RecordCount >= 1 Then
        Label4.Caption = Adodc1.Recordset("rcsj")
        Label5.Caption = format(Date, "yyyy年mm月dd日") & format(Time, "hh时nn分")
        If Adodc1.Recordset.RecordCount < 1 Then Label4.Caption = Label5.Caption
        XfSj = (DateDiff("y", Mid(Label4.Caption, 1, 11), Mid(Label5.Caption, 1, 11))) * 24 + (Val(Mid(Label5.Caption, 12, 2)) - Val(Mid(Label4.Caption, 12, 2))) + (Val(Mid(Label5.Caption, 15, 2)) - Val(Mid(Label4.Caption, 15, 2))) / 60
        Label25.Caption = Round(XfSj, 3)
        Label17.Caption = Int(Val(Label23.Caption) * XfSj)
        Label19.Caption = Int(Val(Label23.Caption) * XfSj * Val(Label15.Caption) * 0.01)
        If Label11.Caption = "" Then Text2.Locked = False
        If Label11.Caption <> "" And (Val(Text2.Text) - Val(Label25.Caption)) < 0 Then
            'Label11.Caption = "1111"
            'Text2.Locked = False
        End If
        Text3.Text = Round(Val(Text2.Text) - Val(Label25.Caption), 2)
        Text2.SetFocus
  End If
End Sub

Private Sub Command4_Click()
  LSSql = " where cph='" & Trim(Text1.Text) & "' and cps='" & Trim(Combo1.Text) & "' and rcsj between '" & format(BKsj, "yyyy年mm月dd日") & "00时00分' and '" & format(Date, "yyyy年mm月dd日") & format(Time, "HH时NN分") & "'"
       
  DataReport1.Show
End Sub

Private Sub Label11_Change()
   Dim IdZt As Boolean
   Dim CCSJ As String, RCSJ As String
   Dim XfSj As Integer
   Dim RS As New ADODB.Recordset
   Dim RcRs As New ADODB.Recordset
   RS.CursorLocation = adUseClient
   RS.Open "select idyh.zh,idyh.xm,idyh.jb,idyh.ye,jb.dz,idyh.zt,idyh.sj from idyh ,jb where kh='" & Label11.Caption & "' and idyh.jb=jb.jb", Cn, 1, 3
   IdZt = False
   Label11.Refresh
   Id_KH = ""
   Id_KH = Label11.Caption
   If Not RS.EOF And Label11.Caption <> "" Then
     BKsj = RS("sj")
     Label8.Caption = RS("zh")
     Label7.Caption = RS("xm")
     Label12.Caption = RS("jb")
     Label13.Caption = RS("ye")
     Label15.Caption = RS("dz")
     IdZt = RS("zt")
     If Not IdZt Then
            If Label12.Caption <> "普通卡" Then Text2.Locked = True
            Text2.Text = Label13.Caption
            RcRs.CursorLocation = adUseClient
            RcRs.Open "select cph,cps from rc where idh='" & Label11.Caption & "' order by rcsj desc", Cn, 1, 3
            If Not RcRs.EOF Then
              Text1.Text = RcRs("cph")
              Combo1.Text = RcRs("cps")
              Command3_Click
            Else
              MsgBox Label11.Caption & "  的记录不存在", 0 + vbCritical, " 系统提示"
              Label7.Caption = ""
              Label8.Caption = ""
              Label11.Caption = ""
              Label13.Caption = ""
              Label4.Caption = ""
              Label5.Caption = ""
              Label6.Caption = ""
              Label23.Caption = ""
              Label17.Caption = ""
              Label25.Caption = ""
              Label19.Caption = ""
              Text2.Text = "0"
              Label11.Caption = ""
            End If
            RcRs.Close
      Else
            MsgBox Label11.Caption & "  卡已挂失", 0 + vbCritical, " 系统提示"
            Label7.Caption = ""
            Label8.Caption = ""
            Label11.Caption = ""
            Label13.Caption = ""
            Label4.Caption = ""
            Label5.Caption = ""
            Label6.Caption = ""
            Label23.Caption = ""
            Label17.Caption = ""
            Label25.Caption = ""
            Label19.Caption = ""
            Text2.Text = "0"
      End If
   End If
   RS.Close
End Sub

Private Sub MSComm1_OnComm()
   Dim Buffer As Variant '存储数据的缓冲区
   Dim CardNumber As Long '卡号
   Select Case MSComm1.CommEvent '串口事件
      Case comEvReceive '接收到数据
          Buffer = MSComm1.Input '清理接收缓冲区，此时，接收的字节数已经为0
          CardNumber = CDec(Buffer(4)) * 2 ^ 16 + (Buffer(5) * 2 ^ 8) + Buffer(6) '单个字节数据左移
          Label11.Caption = CardNumber
   End Select
End Sub

Private Sub MSComm2_OnComm()
    If MSComm2.DSRHolding = True Then SaveBmp_Click
End Sub

Private Sub SaveBmp_Click()
   CGCard.SaveBmp App.Path & "\pic\test.bmp"
   Image1.Picture = LoadPicture(App.Path & "\pic\test.bmp")
End Sub
Private Sub SnapEx_Click()
   Dim status As CGSTATUS
    If SnapEx.Caption = "启动采集" Then
       SnapEx.Caption = "关闭采集"
   Else
       SnapEx.Caption = "启动采集"
   End If
   If g_nOperation = OPD_NONE Then
        CGCard.Clear
        status = CGCard.OpenSnapEx
        If (Not CG_SUCCESS(status)) Then
            MsgBox CGCard.GetErrorString(status)
        Else
            status = CGCard.StartSnapEx(0, True, 2)
            If (Not CG_SUCCESS(status)) Then
                MsgBox CGCard.GetErrorString(status)
            Else
                g_nOperation = OPD_SNAP_EX
                CGCard.Clear
            End If
        End If
   Else
        status = CGCard.CloseSnapEx
        If (Not CG_SUCCESS(status)) Then
            MsgBox CGCard.GetErrorString(status)
        Else
            g_nOperation = OPD_NONE
        End If
   End If
    
End Sub
Private Sub Form_Load()
    'On Error Resume Next
    Sf_Zt = True
    If Dj_Zt = True Then Unload DJ1: Dj_Zt = False
    Me.Left = (MDIForm1.Width - Me.Width) / 2
    Me.Top = (MDIForm1.Height - Me.Height) / 2 - 1000
    Me.Show
    CGCard.VideoSource = Yj(2)
    g_nOperation = OPD_NONE
    CGCard.Begin 1
    CGCard.SetInputWindow 0, 0, 768, 576
    CGCard.SetOutputWindow 0, 0, CGCard.Width, CGCard.Height
    SnapEx_Click
    Combo1.Clear
    Combo1.AddItem "兰色"
    Combo1.AddItem "黄色"
    Combo1.AddItem "白色"
    Combo1.AddItem "其他"
    Combo1.Text = "兰色"
    Image1.Picture = LoadPicture(App.Path & "\pic\a.jpg")
    Adodc1.ConnectionString = Cn.ConnectionString
    MSComm1.CommPort = Yj(4) '串口号，
    MSComm1.Settings = "9600,N,8,1" '串口的属性
    MSComm1.InputLen = 0 '接收缓冲区的大小
    MSComm1.InputMode = comInputModeBinary '二进制接受方式
    MSComm1.RThreshold = 7 '每7个字节响应消息
    MSComm1.PortOpen = True '打开通信串口
    MSComm2.CommPort = Yj(6) '串口号，
    MSComm2.Settings = "9600,N,8,1" '串口的属性
    MSComm2.InputLen = 0 '接收缓冲区的大小
    MSComm2.InputMode = comInputModeBinary '二进制接受方式
    MSComm2.RThreshold = 7 '每7个字节响应消息
    MSComm2.PortOpen = True '打开通信串口
    If Err.Number Then
       MsgBox "对不起，COM口正在使用，请关闭已打开的界面", 0 + vbExclamation, "系统提示"
       Unload Me
       Exit Sub
    End If
    Text1.SetFocus
    Text1.SelStart = Len(Text1.Text)
End Sub
Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    Select Case g_nOperation
    Case OPD_CAPTURE_EX
        CGCard.CaptureEx False
    Case OPD_SNAP_EX
        CGCard.CloseSnapEx
    End Select

    CGCard.End
     MSComm1.PortOpen = False
     MSComm2.PortOpen = False
End Sub
Private Sub Text1_GotFocus()
    Text1.SelStart = 1
    Text1.SelLength = Len(Text1.Text) - 1
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then Combo1.SetFocus
   If KeyAscii > 96 Then KeyAscii = KeyAscii - 32
End Sub

Private Sub Text2_GotFocus()
    Text2.SelStart = 0
    Text2.SelLength = Len(Text2.Text)
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
      Label22.Caption = (Val(Text2.Text) - Val(Label19.Caption)) & "元"
      Command1_Click
   End If
End Sub