VB串口通訊實例
作者：liwenzhao
高精度電壓表(24bit)  VB源程序
Dim PortValue As Integer    '端口號選擇1-4
Dim value As Double         '當前一次取值
Dim value2 As Double        '要顯示的值
Dim valueSum As Double        '和
Dim numCount As Double      '算平均值是的計數(shù)個數(shù)
Dim func As Integer         '功能號標志1-4
Dim valueFlag As Integer
Private Sub Check1_Click()
'自動刷新 被選中則 刷新按鈕無效
If Check1.value Then
    Command1.Enabled = False
Else
    Command1.Enabled = True
   
    Command1.SetFocus
End If
End Sub
Private Sub Command1_Click()
    '顯示
    Call display
End Sub
Private Sub Command2_Click()
    valueSum = 0 '清計數(shù)和
    numCount = 1 '清計數(shù)個數(shù)
    Label6.Caption = Str(numCount - 1) '顯示復位
    value = 0
    value2 = 0
    valueFlag = 0
    Call display
End Sub
Private Sub Form_Activate()
    numCount = 1
    value = 0
    valueSum = 0
    PortValue = 1
    Text1.Visible = False
    Label6.Caption = "0"
    Option1(0).value = True
    Option2(0).value = True
    Command1.SetFocus
    Label1.Caption = Format(value2, "0.000,000")
    For i = 0 To 3
        If Option2(i).value = True Then
            func = i + 1
        End If
    Next i
    Check1.value = 1
    'Call ComPortOpen
End Sub
Public Sub ComPortOpen() '開串口
    With MSComm1
        .CommPort = PortValue              '使用COM1
        .Settings = "9600,N,8,1"       '設置通信口參數(shù)
        .InBufferSize = 40
        '設置MSComm1接收緩沖區(qū)為40字節(jié)
        '.OutBufferSize = 2
        '設置MSComm1發(fā)送緩沖區(qū)為2字節(jié)
        .InputMode = comInputModeBinary
        '設置接收數(shù)據(jù)模式為二進制形式
        .InputLen = 1
        '設置Input 一次從接收緩沖讀取字節(jié)數(shù)為1
        '.SThreshold = 1
        '設置Output 一次從發(fā)送緩沖讀取字節(jié)數(shù)為1
        .InBufferCount = 0  '清除接收緩沖區(qū)
        '.OutBufferCount = 0     '清除發(fā)送緩沖區(qū)
        'MaxW = -99
        '最大值賦初值
        'MinW = 99             '最小值賦初值
        'w = 0
        '數(shù)據(jù)個數(shù)計數(shù)器清零
        .RThreshold = 1
        On Error Resume Next
        '設置接收一個字節(jié)產(chǎn)生OnComm事件
        If .PortOpen = False Then
            '判斷通信口是否打開
            .PortOpen = True       '打開通信口
            If Err Then        '錯誤處理
                msg = MsgBox(" 串口 COM" & PortValue & " 無效！ ", vbOKOnly, "警告")
                Exit Sub
            End If
        End If
    End With
    'MsgBox "端口已打開"
End Sub
Public Sub ComPortClose() '關串口
    MSComm1.PortOpen = False
    '   MsgBox "端口已關閉"
End Sub
Private Sub MSComm1_OnComm()
    Call recive
End Sub
Private Sub Option1_Click(Index As Integer)
    If MSComm1.PortOpen = True Then
        Call ComPortClose
    End If
    PortValue = Index + 1
    Call ComPortOpen
End Sub
Private Sub recive() '檢測起始位并接收數(shù)據(jù)
    Dim Buffer As Variant
    Dim Arr() As Byte
    Dim inData(5) As Byte
    Dim count  As Integer
    Dim temp As Byte
   
   
    '  MsgBox "OnComm"
    With MSComm1
   
            Select Case .CommEvent
            '判斷MSComm1通信事件
                Case comEvReceive
                    '收到Rthreshold個字節(jié)產(chǎn)生的接收事件
                    Buffer = .Input
                    Arr = Buffer
                   
                    '讀取一個接收字節(jié)
                    ' Text1.Text = Arr(0)
                    If Arr(0) = &H1B Then
                        .RThreshold = 0
                        Do
                            DoEvents
                        Loop Until .InBufferCount >= 4
                       
                        For i = 1 To 4
                            'count = .InBufferCount
                            Buffer = .Input
                            Arr = Buffer
                            inData(i) = Arr(0)
                        Next i
                        If inData(4) = &HA Then
                            If (inData(1) Mod 64) >= 32 Then
                                .RThreshold = 1
                                Exit Sub
                            End If
                            valueFlag = 1
                            '0.000003814697265625
                            temp = inData(1) Mod 16
                            If temp <= 7 Then
                                value = inData(1) Mod 8
                                value = value * 256 * 256
                                value = value + Val(inData(2)) * 256
                                value = value + Val(inData(3))
                                value = value * 3.814697265625E-06
                                'Text1.Text = Format(value, "0.000,000")
                            Else
                                value = inData(1) Mod 8
                                value = value * 256 * 256
                                value = value + Val(inData(2)) * 256
                                value = value + Val(inData(3))
                                value = value * 3.814697265625E-06
                                value = 0 - value
                            End If
                            temp = inData(1) Mod 128
                            ' test OF
                            If temp >= 64 Then
                                If value < 0 Then
                                    value = value - 0.000004
                                Else
                                    value = value + 0.000004
                                End If
                            End If
                            '檢測自動刷新
                            If Check1.value Then
                                 'valueFlag = 1
                                 Call display
                            End If
                        Else
                            .RThreshold = 1
                            Exit Sub
                        End If
                        .InBufferCount = 0
                        .RThreshold = 1
                    End If
            Case Else
        End Select
    End With
    'Text1.Text = Text1.Text + 1
End Sub
Private Sub Option2_Click(Index As Integer)
    func = Index + 1
End Sub
Public Sub display() '判斷功能并顯示
   
    '功能選擇
    Select Case func
        Case 1 '當前值
            value2 = value
           
        Case 2 '平均值
            If numCount > 100000 Then
                numCount = 1
                valueSum = 0
            End If
            If valueFlag = 1 Then
                valueSum = valueSum + value
                value2 = valueSum / numCount
                numCount = numCount + 1
                valueFlag = 0
                Label6.Caption = Str(numCount - 1)
            End If
        Case 3 '最大值
            If value > value2 Then
                value2 = value
            End If
        Case 4 '最小值
            If value < value2 Then
                value2 = value
            End If
        Case Else
    End Select
    'Text1.Text = Str(valueSum)
    Label1.Caption = Format(value2, "0.000,000")
   
End Sub
Private Sub Timer1_Timer()'清緩沖區(qū)
    ' Text1.Text = MSComm1.InBufferCount
    If MSComm1.InBufferCount >= 80 Then
        MSComm1.InBufferCount = 0
    End If
End Sub