文件名称:
vb 用MSCOMM 与 功率计 通讯例子
开发工具:
文件大小: 68kb
下载次数: 0
上传时间: 2012-12-25
详细说明： 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 ...展开收缩
(系统自动生成,下载前可以参看下载内容)
下载文件列表
相关说明
- 本站资源为会员上传分享交流与学习,如有侵犯您的权益,请联系我们删除.
- 本站是交换下载平台，提供交流渠道，下载内容来自于网络，除下载问题外，其它问题请自行百度。
- 本站已设置防盗链，请勿用迅雷、QQ旋风等多线程下载软件下载资源，下载后用WinRAR最新版进行解压.
- 如果您发现内容无法下载，请稍后再次尝试；或者到消费记录里找到下载记录反馈给我们.
- 下载后发现下载的内容跟说明不相乎，请到消费记录里找到下载记录反馈给我们，经确认后退回积分.
- 如下载前有疑问，可以通过点击"提供者"的名字，查看对方的联系方式，联系对方咨询.
