【文件属性】:
文件名称: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
网友评论
- 还好!还好!还好!
- 只是一简单的个案而已
- 没什么注释,太难懂了,不利于学习,仅供参考