Question

求助vb串口接收数据并显示

Answer 1

Option Explicit
Dim a As Integer
Dim BytReceived() As Byte
Dim strData As String
Dim lenInput As Integer
Dim bytSendByte() As Byte '发送二进制数据
Dim strSendText As String '发送文本数据
Dim blnAutoSendFlag As Boolean
Dim openFlag As Boolean

Private Sub cmdClear_Click()
strData = ""
txtReceive = ""
End Sub

Private Sub cmdOpen_Click() '打开关闭端口
On Error GoTo Userr
If List1 <> "" And List2 <> "" And List3 <> "" And List3 <> "" And List3 <> "" Then
MSComm1.Settings = List2 & "," & List3 & "," & List5 & "," & List4
If openFlag Then
cmdOpen.Caption = "打开串口"
MSComm1.PortOpen = False '打开端口
Shape1.FillColor = vbRed
Else
MSComm1.CommPort = Val(List1)
MSComm1.PortOpen = True
cmdOpen.Caption = "关闭串口"
Shape1.FillColor = vbGreen
End If
End If
openFlag = Not openFlag
Exit Sub
Userr:
MsgBox ("Err号" & Err.Number & " 串口号错误或已打开!")
End Sub

Private Sub cmdSendASc_Click() '文本发送
Dim sj_Txt As String
sj_Txt = TxtSend
If MSComm1.PortOpen = True Then
MSComm1.Output = sj_Txt
End If
End Sub

Private Sub cmdSendHex_Click() '16进制发送
Dim sj() As Byte
Dim sj_Txt As String
Dim i As Integer
sj_Txt = TxtSend
If Len(TxtSend) Mod 2 = 0 And Len(TxtSend) <> 0 Then '检验16进制字符串长
ReDim sj(Len(sj_Txt) / 2 - 1)
For i = 0 To Len(sj_Txt) - 1 Step 2
sj(i / 2) = Val("&H" & Mid(sj_Txt, i + 1, 2))
Next
If MSComm1.PortOpen = True Then
MSComm1.Output = sj
Else
MSComm1.PortOpen = True
Shape1.FillColor = vbGreen
MSComm1.Output = sj
End If
Else
MsgBox ("格式不对!")
End If
End Sub
'字符串表示的十六进制数据转化为相应的字节串,返回转化后的字节数

Private Sub Form_Load()
MSComm1.InputMode = comInputModeBinary '采用二进制传输
MSComm1.InBufferCount = 0 '清空接受缓冲区
MSComm1.OutBufferCount = 0 '清空传输缓冲区
MSComm1.RThreshold = 1 '产生MSComm事件
MSComm1.InBufferSize = 1024
TxtSend = ""
TxtSend = "" '800A00113135323634389794"
txtReceive = ""
Text2 = ""
End Sub

Private Sub List1_Click()
On Error GoTo useErr
If List1 <> "" And List2 <> "" And List3 <> "" And List3 <> "" And List3 <> "" Then
MSComm1.CommPort = Val(List1)
End If
useErr:
End Sub

Private Sub List2_Click()
If List1 <> "" And List2 <> "" And List3 <> "" And List3 <> "" And List3 <> "" Then
MSComm1.Settings = List2 & "," & List3 & "," & List5 & "," & List4
cmdOpen.Enabled = True
End If
End Sub

Private Sub List3_Click()
If List1 <> "" And List2 <> "" And List3 <> "" And List3 <> "" And List3 <> "" Then
MSComm1.Settings = List2 & "," & List3 & "," & List5 & "," & List4
cmdOpen.Enabled = True
End If
End Sub

Private Sub List4_Click()
If List1 <> "" And List2 <> "" And List3 <> "" And List3 <> "" And List3 <> "" Then
MSComm1.Settings = List2 & "," & List3 & "," & List5 & "," & List4
cmdOpen.Enabled = True
End If
End Sub

Private Sub List5_Click()
If List1 <> "" And List2 <> "" And List3 <> "" And List3 <> "" And List3 <> "" Then
MSComm1.Settings = List2 & "," & List3 & "," & List5 & "," & List4
cmdOpen.Enabled = True
End If
End Sub

Private Sub MSComm1_OnComm() '接收数据
Dim strBuff As String
Select Case MSComm1.CommEvent
Case 2
MSComm1.InputLen = 0
strBuff = MSComm1.Input
BytReceived() = strBuff
jieshou
lenInput = Len(strData)
Text2 = lenInput \ 2
'数据处理代码
End Select
End Sub

Public Function jieshou() '接收数据处理为16进制
Dim i As Integer
For i = 0 To UBound(BytReceived)
If Len(Hex(BytReceived(i))) = 1 Then
strData = strData & "0" & Hex(BytReceived(i))
Else
strData = strData & Hex(BytReceived(i))
End If
Next
txtReceive = strData
End Function

Answer 2

Private Sub MSComm1_OnComm()

Dim BytReceived() As Byte
Dim strBuff As String
Dim i As Integer
Select Case MSComm1.CommEvent '事件发生
Case 2
Cls

MSComm1.InputLen = 0 '读入缓冲区全部内容
strBuff = MSComm1.Input '读入到缓冲区

If MSComm1.InputMode = comInputModeBinary Then
BytReceived() = strBuff '如果是二进制接收模式则进行数据处理，否则直接显示字符串
For i = 0 To UBound(BytReceived)
If Len(Hex(BytReceived(i))) = 1 Then
strData = strData & "0" & Hex(BytReceived(i)) & " " '如果只有一个字符，则前补0，如F显示0F，最后补空格
Else '方便显示观察如： 00 0F FE
strData = strData & Hex(BytReceived(i)) & " "
End If
Next
Text2 = Text2 & strData
strData = ""
Else
Text2 = Text2 & strBuff
End If
End Select
End Sub