frmmain.frm

我自己写的短距离无线通信系统的收发程序

End Sub

Private Sub Command3_Click()
Dim BuffOut(0 To 8) As Byte
Dim BufSend As Variant
Dim i As Integer
            BuffOut(0) = &HFF
            BuffOut(1) = &H0
            For i = 0 To 2
                BuffOut(2 * i + 2) = &HFF
                BuffOut(2 * i + 3) = &H3
            Next i
          '  BuffOut(8) = BuffOut(0) + BuffOut(1) + BuffOut(2) + BuffOut(3)
            BufSend = BuffOut()
            MSComm1.Output = BufSend
End Sub

Private Sub Command4_Click()
Dim BuffOut(0 To 8) As Byte
Dim BufSend As Variant
Dim i As Integer
            BuffOut(0) = &HFF
            BuffOut(1) = &H0
            For i = 0 To 2
                BuffOut(2 * i + 2) = &HFE
                BuffOut(2 * i + 3) = &H1
            Next i
          '  BuffOut(8) = BuffOut(0) + BuffOut(1) + BuffOut(2) + BuffOut(3)
            BufSend = BuffOut()
            MSComm1.Output = BufSend
End Sub

Private Sub Command5_Click()
Dim BuffOut(0 To 8) As Byte
Dim BufSend As Variant
Dim i As Integer
            BuffOut(0) = &HFF
            BuffOut(1) = &H0
            For i = 0 To 2
                BuffOut(2 * i + 2) = &HFE
                BuffOut(2 * i + 3) = &H2
            Next i
          '  BuffOut(8) = BuffOut(0) + BuffOut(1) + BuffOut(2) + BuffOut(3)
            BufSend = BuffOut()
            MSComm1.Output = BufSend
End Sub

Private Sub Command6_Click()
Dim BuffOut(0 To 8) As Byte
Dim BufSend As Variant
Dim i As Integer
            BuffOut(0) = &HFF
            BuffOut(1) = &H0
            For i = 0 To 2
                BuffOut(2 * i + 2) = &HFE
                BuffOut(2 * i + 3) = &H3
            Next i
          '  BuffOut(8) = BuffOut(0) + BuffOut(1) + BuffOut(2) + BuffOut(3)
            BufSend = BuffOut()
            MSComm1.Output = BufSend
End Sub

Private Sub Command7_Click()
Dim BuffOut(0 To 8) As Byte
Dim BufSend As Variant
Dim i As Integer
            BuffOut(0) = &HFF
            BuffOut(1) = &H0
            For i = 0 To 2
                BuffOut(2 * i + 2) = &H0
                BuffOut(2 * i + 3) = &H7
            Next i
          '  BuffOut(8) = BuffOut(0) + BuffOut(1) + BuffOut(2) + BuffOut(3)
            BufSend = BuffOut()
            MSComm1.Output = BufSend
End Sub

Private Sub Command8_Click()
Dim BuffOut(0 To 8) As Byte
Dim BufSend As Variant
Dim i As Integer
            BuffOut(0) = &HFF
            BuffOut(1) = &H0
            For i = 0 To 2
                BuffOut(2 * i + 2) = &H0
                BuffOut(2 * i + 3) = &H8
            Next i
          '  BuffOut(8) = BuffOut(0) + BuffOut(1) + BuffOut(2) + BuffOut(3)
            BufSend = BuffOut()
            MSComm1.Output = BufSend
End Sub

Private Sub Command9_Click()
Dim BuffOut(0 To 2) As Byte
Dim BufSend As Variant
Dim i As Integer
            BuffOut(0) = &HFF
            BuffOut(1) = &H0
            BuffOut(2) = &H1
            BufSend = BuffOut()
            MSComm1.Output = BufSend
End Sub

Private Sub Exit_Click()
MSComm1.PortOpen = False
End
End Sub

Private Sub Form_Load()
MSComm1.RTSEnable = True
    dd = 0
    aa = 0
    Dim i As Integer
    If Not ValidatePort Then
        MsgBox "There are no available comm ports on this computer.", , "Commx"
        End
    End If
    
With MSComm1
     'CommPort=2                ‘使用COM2
     '.Setting=“9600,N,8,1"         ‘设置通信口参数
     .InBufferSize = 40
     '设置MSComm1接收缓冲区为40字节
     '.OutBufferSize = 4
     '设置MSComm1发送缓冲区为2字节
     .InputMode = comInputModeBinary
     '设置接收数据模式为二进制形式
     .InputLen = 1
     '设置Input 一次从接收缓冲读取字节数为1
     .SThreshold = 1
     '设置Output 一次从发送缓冲读取字节数为1
     .InBufferCount = 0  '清除接收缓冲区
     .OutBufferCount = 0     '清除发送缓冲区
End With

End Sub

Private Sub Form_Unload(Cancel As Integer)

    If (MSComm1.PortOpen) Then
        MSComm1.PortOpen = False
    End If
    
End Sub

Private Sub mnuCom_Click(Index As Integer)
    Dim i As Integer
    Dim OldPort As Long
    On Error Resume Next
    With MSComm1
        OldPort = .CommPort
        If MSComm1.PortOpen Then
            .PortOpen = False
            .CommPort = Index
            .PortOpen = True
            If Err.Number <> 0 Then     ' This should not happen...
                MsgBox "Com" & Index & " is not available." & _
                            vbCrLf & Err.Description
                Err.Clear
                .CommPort = OldPort
            Else
                For i = 1 To 4
                    mnuCom(i).Checked = False
                Next i
                mnuCom(Index).Checked = True
            End If
        Else
            .CommPort = Index
            For i = 1 To 4
                mnuCom(i).Checked = False
            Next i
            mnuCom(Index).Checked = True
        End If
    End With
End Sub

Private Sub mnuSpeedSel_Click(Index As Integer)
   Dim i As Integer
   Dim CurPortOpen As Boolean
   Dim NewSettings As String
    
   For i = 0 To 2
        If (i = Index) Then
            mnuSpeedSel(i).Checked = True
            Select Case Index
                Case 0      ' 8000
                    MSComm1.Settings = "9600,N,8,1"
                Case 1      ' 16000
                    MSComm1.Settings = "9600,N,8,1"
                Case 2      ' 32000
                    MSComm1.Settings = "9600,N,8,1"
            End Select
        Else
            mnuSpeedSel(i).Checked = False
        End If
        Next i
   
    
End Sub

Private Sub MSComm1_OnComm()
Dim BuffIn(0 To 10), Buf(10), BuffOut() As Byte
Dim Buffer, BufSend As Variant
Dim i, j, k, Count As Integer
Dim Value As Single
Dim CValue As String
Dim bijiao As Variant
Dim dd As Integer
Dim max, min, Mid As Single

'Dim ss As Single

'TimeDelay 100
Select Case MSComm1.CommEvent
    '判断MSComm1通信事件
    Case comEvReceive
        '收到Rthreshold个字节产生的接收事件
   
    Buffer = MSComm1.Input   '读取一个接收字节
       
    BuffIn(0) = Buffer(0)
    If BuffIn(0) = &HFF Then      '判断是否为数据开始标志FF
          Buffer = MSComm1.Input
          BuffIn(1) = Buffer(0)
           If BuffIn(1) = &H0 Then
          'MSComm1.RThreshold = 0
          '关闭OnComm事件接收
          ' Do
           '        DoEvents
          '  Loop Until MSComm1.InBufferCount >= 9
           '循环等待MSComm1接收缓冲区>=9个字节
           Buffer = MSComm1.Input
          '读取第二个字节(通道标志)
            BuffIn(2) = Buffer(0)
            If BuffIn(2) >= 0 And BuffIn(2) < 8 Then
                 For i = 3 To 5
                        Buffer = MSComm1.Input
                          '接收电压数据
                        BuffIn(i) = Buffer(0)
                      
                 Next i
                 If BuffIn(3) >= BuffIn(4) Then
                        max = BuffIn(3)
                        min = BuffIn(4)
                 Else
                        max = BuffIn(4)
                        min = BuffIn(3)
                 End If
                 If max <= BuffIn(5) Then
                        Mid = max
                 ElseIf BuffIn(5) <= min Then
                        Mid = min
                 Else
                        Mid = BuffIn(5)
                 End If
                 Value = Mid / 51
                  
                 Count = BuffIn(2)
                 If Count = 0 Then '判断通道
                                Text(0).Text = Format(Value, "0.00")
                                '显示电压模拟量，2位小数
                                Shape(0).FillColor = &HFF&
                 ElseIf Count = 1 Then
                                Text(1).Text = Format(Value, "0.00")
                                '显示电压模拟量，2位小数
                                Shape(1).FillColor = &HFF&
                 
                 End If
                
            End If
            End If
        
          If BuffIn(2) = &H9 Then
               For j = 3 To 258
                    Buffer = MSComm1.Input
                    BuffIn(j) = Buffer(0)
                 Open "a:\Test\FileTest" For Output As #1
                 Print #1, CStr(BuffIn(j))
                    If BuffIn(j) - aa = 0 Then
                        dd = dd + 1
                    End If
                Next j
                aa = (256 - dd) / 256
                Open "a:\Test\FileTest" For Output As #1
                Print #1, ""
                Print #1, "误码率为:"
                Print #1, aa
                Close #1
           
           End If
    End If
    
    End Select
End Sub


Private Function ValidatePort() As Boolean
    Dim i As Integer
    
    On Error Resume Next
    ValidatePort = False
    With MSComm1
        For i = 4 To 1 Step -1
            .CommPort = i
            Err.Clear
            .PortOpen = True
            If (Err.Number <> 0) Then
                mnuCom(i).Enabled = False
            Else
                ValidatePort = True
                .PortOpen = False
            End If
        Next i
    End With
End Function

Private Sub cmdOpen_Click()
On Error GoTo ErrHandler

If MSComm1.PortOpen Then
    MSComm1.PortOpen = False
    cmdOpen.Caption = "开启端口"
    cmdOpen.ToolTipText = "开启通讯端口"
    'cmdSet.Enabled = True
    'cmdSend.Enabled = False
Else
    MSComm1.PortOpen = True
    cmdOpen.Caption = "关闭端口"
    cmdOpen.ToolTipText = "关闭通讯端口"
    'cmdSet.Enabled = False
    'cmdSend.Enabled = True
End If
Exit Sub

ErrHandler:
MsgBox "不能操作端口，请重新设置端口！", vbInformation, "错误"

End Sub

Private Sub Send(ch1 As Byte, ch2 As Byte)
Dim BuffOut(0 To 8) As Byte
Dim BufSend As Variant
Dim i As Integer
            BuffOut(0) = &HFF
            BuffOut(1) = &H0
            For i = 0 To 2
                BuffOut(2 * i + 2) = ch1
                BuffOut(2 * i + 3) = ch2
            Next i
          '  BuffOut(8) = BuffOut(0) + BuffOut(1) + BuffOut(2) + BuffOut(3)
            BufSend = BuffOut()
            MSComm1.Output = BufSend
End Sub

Private Sub Receive()
Dim BuffIn(0 To 10), Buf(10), BuffOut() As Byte
Dim Buffer, BufSend As Variant
Dim i, j, k, Count As Integer
Dim Value As Single
Dim CValue As String
Dim bijiao As Variant
Dim dd As Integer
Dim max, min, Mid As Single
Dim Ri, Ra As Byte

'Dim ss As Single

'TimeDelay 100
Select Case MSComm1.CommEvent
    '判断MSComm1通信事件
    Case comEvReceive
        '收到Rthreshold个字节产生的接收事件
   
    Buffer = MSComm1.Input   '读取一个接收字节
       
    BuffIn(0) = Buffer(0)
    If BuffIn(0) = &HFF Then      '判断是否为数据开始标志FF
          Buffer = MSComm1.Input
          BuffIn(1) = Buffer(0)
           If BuffIn(1) = &H0 Then
          'MSComm1.RThreshold = 0
          '关闭OnComm事件接收
          ' Do
           '        DoEvents
          '  Loop Until MSComm1.InBufferCount >= 9
           '循环等待MSComm1接收缓冲区>=9个字节
           For i = 2 To 7
                 Buffer = MSComm1.Input
                 BuffIn(i) = Buffer(0)
           Next i
                 If ((BuffIn(2) - BuffIn(4)) = 0) Then
                     If ((BuffIn(3) - BuffIn(5)) = 0) Then
                          Ra = BuffIn(2)
                          Ri = BuffIn(3)
                     End If
                 ElseIf ((BuffIn(2) - BuffIn(5)) = 0) Then
                     If ((BuffIn(3) - BuffIn(6)) = 0) Then
                          Ra = BuffIn(2)
                          Ri = BuffIn(3)
                     End If
                 ElseIf ((BuffIn(4) - BuffIn(6)) = 0) Then
                     If ((BuffIn(5) - BuffIn(7)) = 0) Then
                          Ra = BuffIn(4)
                          Ri = BuffIn(5)
                     End If
                 End If
            End If
    End If
                 
End Sub