form1.frm

该系统为空车计量系统.完成对空车的自动计量.附串口处理程序.

    Adodc3.Recordset.Fields("ch") = jl_ch
    Adodc3.Recordset.Fields("pz") = Val(Label1.Caption)
    Adodc3.Recordset.Fields("sj") = Format(Now, "yyyy-mm-dd-hh-nn-ss")
    Adodc3.Recordset.UpdateBatch adAffectAllChapters
    MsgBox "数据存盘成功"
    'Refresh
    tc.Show
    Label14.Caption = Val(Label4.Caption) + 1
    Command4.Enabled = True
    Label2.Caption = Val(Label2.Caption) + 1
End Sub
    
'##################################################################
'## 过程名称：Command3_Click
'## 参数： 无
'##################################################################
Private Sub Command3_Click()
    On Error Resume Next
    Dim xip(3) As Long
    Dim yip As Long
    Dim ii As Integer
 
    jl_pz = Val(Label1.Caption)
  
    strBarCode = Text1.Text & "*" & Trim(Label1.Caption)

    'Call PrintBarCode(test.Picture1, strBarCode, 66, 37, 9, True)
   ' Call PrintBarCode(test.Picture1, strBarCode, 66, 105, 9, True)
    'Call PrintBarCode(test.Picture1, strBarCode, 66, 180, 9, True)
    
   
    test.Show
End Sub
    
'##################################################################
'## 过程名称：Command4_Click
'## 参数： 无
'##################################################################
Private Sub Command4_Click()
    On Error Resume Next
    Label14.Caption = Val(Label14.Caption) - 1
    '*****************************
    Label2.Caption = Val(Label2.Caption) - 1
    Adodc1.RecordSource = "select * from chk where ch='" & Trim(Text1.Text) & "'"
    Adodc1.refresh
    If Adodc1.Recordset.EOF Then
        Exit Sub
    Else
        Adodc1.Recordset.delete
    End If
    Adodc1.RecordSource = "select * from kck where ch='" & Trim(Text1.Text) & "'"
    Adodc1.refresh
    Adodc1.Recordset.MoveLast
    
    If Adodc1.Recordset.EOF Then
        Exit Sub
    Else
        Adodc1.Recordset.delete
    End If
    Command4.Enabled = False
    
End Sub
    
'##################################################################
'## 过程名称：Command5_Click
'## 参数： 无
'##################################################################
Private Sub Command5_Click()
    cxsyk.Show
End Sub
    
'##################################################################
'## 过程名称：Command6_Click
'## 参数： 无
'##################################################################
Private Sub Command6_Click()
    Form2.Show
End Sub
    
'##################################################################
'## 过程名称：Command8_Click
'## 参数： 无
'##################################################################
Private Sub Command8_Click()
    End
End Sub
    
'##################################################################
'## 过程名称：cpbdy_Click
'## 参数： 无
'##################################################################
Private Sub cpbdy_Click()
    Call Command2_Click
End Sub
    
'##################################################################
'## 过程名称：cpdy_Click
'## 参数： 无
'##################################################################
Private Sub cpdy_Click()
    Call Command1_Click
End Sub
    
'##################################################################
'## 过程名称：Form_Load
'## 参数： 无
'##################################################################
Private Sub Form_Load()
    'On Error Resume Next
    Adodc3.RecordSource = "select * from kck order by sj"
    Adodc3.refresh
    If Adodc3.Recordset.EOF Then
        jl_lsh = 0
    Else
        Adodc3.Recordset.MoveLast
        jl_lsh = Adodc3.Recordset.Fields("slh")
    End If
    '*************************************
        Label14.Caption = jl_lsh
    Label18.Caption = jl_sby
     Adodc3.RecordSource = "select * from kck where sj like '%" & Format(Now, "yyyy-mm-dd") & "%' order by sj"
    Adodc3.refresh
  Label2.Caption = Trim(Str(Adodc3.Recordset.RecordCount))
   
    If Me.MSComm1.PortOpen = True Then
    Me.MSComm1.PortOpen = False
    End If
'    Me.MSComm1.PortOpen = True
    'buff$ = Me.MSComm1.Input
    'Adodc3.Recordset.Close
End Sub
    
'##################################################################
'## 过程名称：left_Click
'## 参数： 无
'##################################################################
Private Sub left_Click()
    Picture3.Align = 3
End Sub
    
'##################################################################
'## 过程名称：Form_Resize
'## 参数： 无
'##################################################################
Private Sub Form_Resize()
    Picture1(0).Left = (Me.Width - Picture1(0).Width) / 2
End Sub
    
'##################################################################
'## 过程名称：Form_Unload
'## 参数：Cancel 为Integer型
'##################################################################
Private Sub Form_Unload(Cancel As Integer)
'    Me.MSComm1.PortOpen = False
End Sub
    
'##################################################################
'## 过程名称：fq_Click
'## 参数： 无
'##################################################################
Private Sub fq_Click()
    Call Command4_Click
End Sub
    
'##################################################################
'## 过程名称：Label1_Change
'## 参数： 无
'##################################################################
Private Sub Label1_Change()
    
End Sub
    
Private Sub Label17_Click()
Me.Label17.Caption = InputBox("输入主管姓名:", , Me.ScaleWidth / 2, Me.ScaleHeight / 2)
End Sub

'##################################################################
'## 过程名称：lspz_Click
'## 参数： 无
'##################################################################
Private Sub lspz_Click()
    Form2.Show
End Sub
    
'##################################################################
'## 过程名称：MSComm1_OnComm
'## 参数： 无
'##################################################################
Private Sub MSComm1_OnComm()
    On Error Resume Next
    Select Case MSComm1.CommEvent
            ' Handle each event or error by placing
            ' code below each case statement
            
            ' 错误
        Case comEventBreak   ' 收到 Break。
        Case comEventCDTO   ' CD (RLSD) 超时。
        Case comEventCTSTO   ' CTS Timeout。
        Case comEventDSRTO   ' DSR Timeout。
        Case comEventFrame   ' Framing Error
        Case comEventOverrun   '数据丢失。
        Case comEventRxOver '接收缓冲区溢出。
            MSComm1.InBufferCount = 0
        Case comEventRxParity ' Parity 错误。
        Case comEventTxFull   '传输缓冲区已满。
        Case comEventDCB   '获取 DCB] 时意外错误
            
            ' 事件
        Case comEvCD   ' CD 线状态变化。
        Case comEvCTS   ' CTS 线状态变化。
        Case comEvDSR   ' DSR 线状态变化。
        Case comEvRing   ' Ring Indicator 变化。
        Case comEvReceive   ' 收到 RThreshold # of chars.
            Dim wz As Integer
            Dim inp As String
            If MSComm1.InBufferCount > 54 Then
                
                buf$ = MSComm1.Input
                wz = InStr(buf$, Chr(13))
                'If wz > 7 Then
                inp = Mid(buf$, wz + 2) '去高位
                wz = InStr(inp, Chr(13))
                bb$ = Mid(inp, wz - 11, 5)
                Label1.Caption = Str(Val(bb$))
            End If
        Case comEvSend   ' 传输缓冲区有 Sthreshold 个字符                     '
            '
        Case comEvEOF   ' 输入数据流中发现 EOF 字符
            '
    End Select
End Sub
    
'##################################################################
'## 过程名称：pzbht_Click
'## 参数： 无
'##################################################################
Private Sub pzbht_Click()
    qx.Show
End Sub
    
'##################################################################
'## 过程名称：quit_Click
'## 参数： 无
'##################################################################
Private Sub quit_Click()
    End
End Sub
    
    
    
'##################################################################
'## 过程名称：right1_Click
'## 参数： 无
'##################################################################
Private Sub right1_Click()
    Picture3.Align = 4
End Sub
    
'##################################################################
'## 过程名称：syoz_Click
'## 参数： 无
'##################################################################
Private Sub syoz_Click()
    cxsyk.Show
End Sub
    
'##################################################################
'## 过程名称：text1_KeyPress
'## 参数：KeyAscii 为Integer型
'##################################################################
Private Sub Text1_KeyPress(KeyAscii As Integer)
On Error Resume Next
    If KeyAscii = 13 Then
        '求出本日所过空车数，赋值给Label2.Caption
        Adodc3.RecordSource = "select * from kck where sj like '%" & Format(Now, "yyyy-mm-dd") & "%' ORDER BY SJ"
        DoEvents
        Adodc3.refresh
        '''********************************
        Label2.Caption = Adodc3.Recordset.RecordCount
          Adodc3.Recordset.Close
        '求出所记录的最后一个车的流水号
        Adodc3.RecordSource = "select slh from kck where sj like '%" & Format(Now, "yyyy-mm") & "%' ORDER BY SJ"
         DoEvents
        Adodc3.refresh
        ''''''''''''''
        If Adodc3.Recordset.EOF Then
            
            Adodc3.RecordSource = "select slh from kck where sj like '%" & Format(Now, "yyyy") & "%' ORDER BY SJ"
           Adodc3.refresh
         ''''
          If Adodc3.Recordset.EOF Then
            jl_lsh = 0
           Else
            Adodc3.Recordset.MoveLast
            jl_lsh = Adodc3.Recordset.Fields("slh")
         End If
        ''''''''''''''''''''
        Else
            Adodc3.Recordset.MoveLast
            jl_lsh = Adodc3.Recordset.Fields("slh")
        ''''''''''''''''''
        End If
          Adodc3.Recordset.Close
        '本车流水号
        Label14.Caption = jl_lsh + 1
        jl_ch = Text1.Text
        '车号
        Label11.Caption = jl_ch
        Label10.Caption = Format(Now, "yyyy年mm月dd日hh时nn分ss秒")
        Label12.Caption = Label1.Caption
        Adodc3.RecordSource = "select * from kck where ch='" & Trim(Text1.Text) & "' ORDER BY CH"
         DoEvents
        Adodc3.refresh
        
        
        If Adodc3.Recordset.EOF Then
            jl_pz = 0
        Else
            Adodc3.Recordset.MoveLast
            jl_pz = Adodc3.Recordset.Fields("pz")
        End If
        Label13.Caption = jl_pz
        
    End If
   
    'Command1.SetFocus
      Adodc3.Recordset.Close
End Sub
    
'##################################################################
'## 过程名称：Text1_LostFocus
'## 参数： 无
'##################################################################
Private Sub Text1_LostFocus()
    Call Text1_KeyPress(13)
End Sub
    
'##################################################################
'## 过程名称：Timer1_Timer
'## 参数： 无
'##################################################################
Private Sub Timer1_Timer()
    On Error Resume Next
            Adodc4.RecordSource = "select * from chetmp where chenghao=2"
    Adodc4.refresh
         If Adodc4.Recordset.EOF Then
        Adodc4.Recordset.AddNew
    End If
    Adodc4.Recordset.Fields("ch") = 2
    Adodc4.Recordset.Fields("miaoshu") = "空车计量"
    Adodc4.Recordset.Fields("zhongliang") = Val(Label1.Caption)
    Adodc4.Recordset.UpdateBatch adAffectCurrent
    Adodc4.Recordset.Close
    '    Adodc3.RecordSource = "select * from kck where sj like '%" & Format(Now, "yyyy-mm-dd") & "%'"
    'Adodc3.refresh
    '**************************
    ' Label2.Caption = Adodc3.Recordset.RecordCount
     
End Sub
    
'##################################################################
'## 过程名称：top_Click
'## 参数： 无
'##################################################################
Private Sub top_Click()
    Picture3.Align = 1
End Sub
    
'##################################################################
'## 过程名称：zcls_Click
'## 参数： 无
'##################################################################
Private Sub zcls_Click()
    frmcx.Show
End Sub