文件名称：vb 用MSCOMM 与 功率计 通讯例子
文件大小：68KB
文件格式：EXE
更新时间：2016-01-15 03:18:08
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 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 End Sub Private Sub Form_Load() fname = App.Path & "\inout.xls" SetSysColors 100, 7, vbRed '设置菜单字体红色（可选择 H0 ----- HFFFFFF 共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 End If Else If shurugl < 2 Then If shuchdy < 10 Then flagbc = 11 End If End If 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