vb用MSCOMM与功率计通讯例子

Private Declare Function SetSysColors Lib "user32" (ByVal nChanges As Long, lpSysColor As Long, lpColorvalues As Long) As Long Private Sub Check1_Click() If Check1 Then csh = 100 Else csh = 200 End If End Sub Private Sub Command2_Click() On Error Resume Next If MSComm1.PortOpen = True Then MSComm1.PortOpen = False MSComm2.PortOpen = False Timer1.Enabled = False End If End Sub Private Sub Command1_Click() If Command1.Caption = "开始" Then Command1.Caption = "停止" GoTo start1 Else If Command1.Caption = "继续测试" Then Command1.Caption = "停止" GoTo start2 End If On Error Resume Next MSComm1.PortOpen = False MSComm2.PortOpen = False Timer1.Enabled = False Command1.Caption = "继续测试" Exit Sub End If start1: If MSComm1.PortOpen = True Then MSComm1.PortOpen = False Timer1.Enabled = False End If MSComm1.Settings = "19200,n,8,1" MSComm1.CommPort = 1 MSComm1.InputMode = 1 MSComm1.InputLen = 0 MSComm1.OutBufferCount = 0 '清空发送缓冲区MSComm1.InBufferCount = 0 MSComm1.RThreshold = 1 MSComm1.PortOpen = True Dim send(0) As Byte '打开串口On Error Resume Next '--- If csh 100 Then ' Call exlrd(indata) If fname = 1000 Then mulu = App.Path & "inout.xls" Else mulu = fname End If Set xlApp = CreateObject("Excel.Application") '创建EXCEL应用类xlApp.Visible = True '设置EXCEL可见Set xlBook = xlApp.Workbooks.open(mulu) '打开EXCEL工作簿Set xlSheet = xlBook.Worksheets(1) '打开EXCEL工作表mline = xlSheet.Cells(1, 22) + 1 End If Timer1.Enabled = True Exit Sub start2: MSComm1.CommPort = 1 MSComm1.InputMode = comInputModeBinary MSComm1.InputLen = 0 MSComm1.OutBufferCount = 0 '清空发送缓冲区MSComm1.InBufferCount = 0 MSComm1.RThreshold = 1 On Error Resume Next MSComm1.PortOpen = True flagbc = 22 ' 11允许进入保存，22不允许保存mline = xlSheet.Cells(1, 22) - 1 Timer1.Enabled = True End Sub Private Sub Command3_Click() Form1.Hide singe.Show End Sub Private Sub Command5_Click() fmulu.Show flagbc = 10 End Sub Private Sub Exit_Click() End Sub Private Sub Form_Load() fname = App.Path & "inout.xls" SetSysColors 100, 7, vbRed '设置菜单字体红色（可选择H0 ----- HFFF共16777216种颜色！） End Sub Private Sub in_Click() singe.Show Form1.Hide End Sub Private Sub inout_Click() Me.Hide Form1.Show End Sub Private Sub MSComm1_OnComm() Dim inlen As Integer Dim k As Integer Dim strbuff, glzhi As String Dim byt(0) As Byte 'MSComm1.RThreshold = 8 '==== Dim intInputLen As Integer Select Case Me.MSComm1.CommEvent Case comEvReceive '此处添加处理接收的代码MSComm1.InputMode = comInputModeBinary '二进制接收intInputLen = MSComm1.InBufferCount ReDim bytInput(intInputLen) bytInput = MSComm1.Input indata = jieshou End Select If Right(indata, 2) = "0D" Then Call pdjs1 Call shuchuhs End If '=== If indata = "EE" Then redel1 'Exit Sub End If On Error Resume Next '=== End Sub Private Sub Form_Activate() Form1.SetFocus Form1.Text5 = Date Form1.Label21 = fname csh = 200 flagbc = 0 End Sub Private Sub MSComm2_OnComm() Dim inlen As Integer Dim i As Integer Dim strbuff As String Dim byt(0) As Byte 'MSComm1.RThreshold = 32 '==== Dim intInputLen As Integer Select Case Me.MSComm2.CommEvent Case comEvReceive '此处添加处理接收的代码MSComm2.InputMode = comInputModeBinary '二进制接收intInputLen = MSComm2.InBufferCount ReDim bytInput(intInputLen) bytInput = MSComm2.Input 'bytInput = MSComm2.Input odata = jieshou End Select '=== If odata = "ED" Then redel3 End If '=== Call pdjs2 '判定是否保存If shuchudy > 10 Then If shurugl > 2 Then If shuchudl > 0.01 Then If flagbc = 11 Then '11上一次为没有功率mline = mline + 1 End If Call exlrd flagbc = 22 End If Else If shurugl < 2 Then If shuchdy < 10 Then flagbc = 11 End If End Sub Private Sub pinban_Click() scan.Show Form1.Hide End Sub Private Sub saveset_Click() fmulu.Show flagbc = 10 End Sub Private Sub timer1_Timer() Call shuruhs End Sub