计算机与电子秤串口通信问题

Question

本人是一个VB初学者，有一台电子秤，想将电子秤的数据采集后通过二进制显示出来，但是每次显示的都是3个字节的乱码。
电子秤的数据格式如下：
每次发送6帧，每帧定义如下：
每10Bit为一数据帧，Bit1:起始位，Bit2-Bit9：数据位，Bit10：停止位
第一帧：D0-D7——OFFH（起始位）
第二帧：D0-D2——为小数点位
        D3-D4——当前工作模式：00-记重模式，01-记数模式，10-百分比模式
        D5   ——1表示重量为负，0表示重量为正
        D6   ——1表示重量稳定，0表示重量不稳定
        D7   ——1表示重量溢出，0表示重量未溢出
第三帧：D0-D7——BCD码1（显示数值的最低字节）
第四帧：D0-D7——BCD码2(显示数值的中间字节)
第五帧：D0-D7——BCD码3（显示数值的最高字节）
第六帧：D0-D7——记重模式下的单位：1表示单位是磅，0表示单位是公斤
下面是我的代码，希望各位高手指点一下小弟。
Dim indata As VariantPrivate Sub Form_Load()
MSComm1.CommPort = 1 '...使用Com1口
MSComm1.Settings = "9600,n,8,1"  '...设置通讯参数
MSComm1.InBufferSize = 40
MSComm1.InputMode = comInputModeBinary
MSComm1.InputLen = 24
MSComm1.RThreshold = 1
MSComm1.SThreshold = 1
MSComm1.PortOpen = True '...打开串口
End SubPrivate Sub MSComm1_OnComm()
Select Case MSComm1.CommEventCase comEvReceive '...有接收事件发生indata = MSComm1.InputText1.Text = indata  '…text1实时显示数显表的数据MSComm1.InBufferCount = 0 '...清空输入寄存器End Select
End Sub

Answer 1

首先建议你将MSComm1.RThreshold设置为10
然后在comEvReceive中
dim inData
inData=MSComm1.input
如返回数据为ASC码
text1.text=val(chr(inData(8)) & chr(inData(7)) & chr(inData(6)))/10^val(inData(1))
如返回为数字
text1.text=(inData(8)*100+inData(7)*10+inData(6))/10^inData(1)

Answer 2

BCD码是一种8421编码，它将一个字节分两部分，高4位代表一个数字，低4位代表一个数字。也就是说，计算机怎么识别一个字节到底是二进制码还是BCD码，这是由程序代码来运算的。
    每2个BCD码构成一字节，接收到每字节二进制数据需处理成16进制的字符形式。仅是由00-99的范围。而非00-FF范围。同样发送的10进制数以每2个BCD码组成1个16进制数形成二进制的一个字节发送来达到目的。
    收发代码如下：
Option ExplicitPrivate Sub cmdSend_Click()
    Call Timer1_Timer
End SubPrivate Sub Form_Load()
    Me.MSComm1.CommPort = 1
    Me.MSComm1.PortOpen = True
    Me.MSComm1.RThreshold = 1
    txtSend = "1234"
    txtReceive = ""
    Timer1.Interval = 0
End SubPrivate Sub MSComm1_OnComm()
    On Error Resume Next
    Dim BytesReceived() As Byte
    Dim buffer As String
    Dim HData As String
    Dim i As Integer
    Select Case MSComm1.CommEvent
        Case comEvReceive               '接收十六进制数据。并以十六进制显示
            MSComm1.InputLen = 0
            MSComm1.InputMode = comInputModeBinary  '设置当前以二进制数接收数据
            buffer = MSComm1.Input                  '接收数据至字符串中
            BytesReceived() = buffer                '将数据转入BYTE中
            For i = 0 To UBound(BytesReceived)      '显示结果以十六进制显示
                If Len(Hex(BytesReceived(i))) = 1 Then
                    HData = HData & "0" & Hex(BytesReceived(i))
                Else
                    HData = HData & Hex(BytesReceived(i))
                End If
                txtReceive.Text = HData       '最后将结果后入txtreceive中
                MSComm1.OutBufferCount = 0      '清除发送缓冲区
                MSComm1.InBufferCount = 0       '清除接收缓冲区
            Next
    End Select
End SubPrivate Sub Timer1_Timer()
    On Error Resume Next
    Dim bytData(1) As Byte
    Dim i As Integer
    For i = 1 To 4 Step 2
    bytData((i - 1) / 2) = Val("&H" & Mid(txtSend, i, 2))
    Next
    MSComm1.Settings = "9600,n,8,1"
    Call SendData(bytData)  '发送命令
End Sub
Public Function SendData(ByRef bytData() As Byte) As Long
    On Error Resume Next
    MSComm1.InBufferCount = 0 '清空接收缓冲区
    MSComm1.Output = bytData '发送数据
    Do
        DoEvents
    Loop Until MSComm1.OutBufferCount = 0 '等待，直到数据发送完毕
    MSComm1.OutBufferCount = 0          '清空发送缓冲区
End Function

Answer 3

依据你提供的通信协议，将上述代码修改如下：
Option Explicit
    Dim js_sj As String * 2
    Dim js_bcd As String * 6
    Dim ccl(2) As String * 1
    Dim cclL(2) As String * 4
    Dim i, j As Integer
    Dim bl As String * 1
    Dim bl_dm As String * 4
    Dim zt_dm1 As String * 8
    Dim zt_dm(8) As String * 1
    Dim zlDanwei As String * 2
    Dim fh As String * 1
Private Sub cmdSend_Click()
    Call Timer1_Timer
End SubPublic Function Hex_bin()
'输出口状态鉴别
For i = 1 To 2
ccl(i) = Mid(js_sj, i, 1)
Next i
For j = 1 To 2
bl = ccl(j)
If bl = "F" Then
bl_dm = "1111"
ElseIf bl = "E" Then
bl_dm = "1110"
ElseIf bl = "D" Then
bl_dm = "1101"
ElseIf bl = "C" Then
bl_dm = "1100"
ElseIf bl = "B" Then
bl_dm = "1011"
ElseIf bl = "A" Then
bl_dm = "1010"
ElseIf bl = "9" Then
bl_dm = "1001"
ElseIf bl = "8" Then
bl_dm = "1000"
ElseIf bl = "7" Then
bl_dm = "0111"
ElseIf bl = "6" Then
bl_dm = "0110"
ElseIf bl = "5" Then
bl_dm = "0101"
ElseIf bl = "4" Then
bl_dm = "0100"
ElseIf bl = "3" Then
bl_dm = "0011"
ElseIf bl = "2" Then
bl_dm = "0010"
ElseIf bl = "1" Then
bl_dm = "0001"
ElseIf bl = "0" Then
bl_dm = "0000"
Else:
bl_dm = ""
End If
cclL(j) = bl_dm
Next j
zt_dm1 = cclL(1) + cclL(2)
Text2 = zt_dm1
For i = 1 To 8
    zt_dm(i) = Mid$(zt_dm1, i, 1)
Next i
'进入第2帧位判别,需另写代码解决小数位数，工作模式,正负值,
'重量稳定与否 , 重量是否溢出等判别
If zt_dm(3) = 1 Then
fh = "-"
Else
fh = "+"
End If
End Function
Private Sub Form_Load()
    Me.MSComm1.CommPort = 1
    Me.MSComm1.PortOpen = True
    Me.MSComm1.RThreshold = 1
    txtSend = "1234"
    txtReceive = ""
    Timer1.Interval = 0
End SubPrivate Sub MSComm1_OnComm()
    On Error Resume Next
    Dim BytesReceived() As Byte
    Dim buffer As String
    Dim k As Integer
    Dim HData As String
    Select Case MSComm1.CommEvent
        Case comEvReceive               '接收十六进制数据。并以十六进制显示
            MSComm1.InputLen = 0
            MSComm1.InputMode = comInputModeBinary  '设置当前以二进制数接收数据
            buffer = MSComm1.Input                  '接收数据至字符串中
            BytesReceived() = buffer                '将数据转入BYTE中
            For k = 0 To UBound(BytesReceived)      '显示结果以十六进制显示
                If Len(Hex(BytesReceived(k))) = 1 Then
                    HData = HData & "0" & Hex(BytesReceived(k))
                Else
                    HData = HData & Hex(BytesReceived(k))
                End If
                txtReceive.Text = HData
            Next
                If Mid(HData, 1, 2) = "FF" Then
                    Label1.BackColor = vbGreen
                    zlDanwei = Mid(HData, 11, 2)
                    Text3 = zlDanwei
                    '请插入重量单位判别代码
                    js_sj = Mid(HData, 3, 2)
                    Call Hex_bin
                    js_bcd = Mid(HData, 5, 6) '取出BCD码
                    js_bcd = Mid(js_bcd, 6, 1) & Mid(js_bcd, 4, 1) & Mid(js_bcd, 2, 1)  '高低字节调整
                    js_bcd = fh & js_bcd ', 6, 1) & Mid(js_bcd, 4, 1) & Mid(js_bcd, 2, 1) '高低字节调整
                    Text1 = js_bcd
                Else
                    Label1.BackColor = vbRed
                End If                '最后将结果后入txtreceive中
                MSComm1.OutBufferCount = 0      '清除发送缓冲区
                MSComm1.InBufferCount = 0       '清除接收缓冲区
            
    End Select
End SubPrivate Sub Timer1_Timer()
    On Error Resume Next
    Dim bytData(1) As Byte
    Dim i As Integer
    For i = 1 To 4 Step 2
    bytData((i - 1) / 2) = Val("&H" & Mid(txtSend, i, 2))
    Next
    MSComm1.Settings = "9600,n,8,1"
    Call SendData(bytData)  '发送命令
End Sub
Public Function SendData(ByRef bytData() As Byte) As Long
    On Error Resume Next
    MSComm1.InBufferCount = 0 '清空接收缓冲区
    MSComm1.Output = bytData '发送数据
    Do
        DoEvents
    Loop Until MSComm1.OutBufferCount = 0 '等待，直到数据发送完毕
    MSComm1.OutBufferCount = 0          '清空发送缓冲区
End Function

Answer 4

2句作下修改：
Dim js_bcd As String js_bcd = Mid(js_bcd, 5, 2) & Mid(js_bcd, 3, 2) & Mid(js_bcd, 1, 2)  '高低字节调整

Answer 5

谢谢zdingyun的回复。但是我按照你的程序修改后，输出的是十六进制，我希望输出二进制码，是不是需要把十六进制转换成二进制后再输出？

Answer 6

你可利用给你的Hex_bin函数方法来将16进制转为二进制字符形式显示。
Public Function Hex_bin()
 '转换代码
End Function
但我不明白你显示由
01001010 01010101。。
组成的二进制字符串给谁看，为何不显示为10进制数显示？