form1.frm

PC机与单片机的串口通信程序

                    OutByte(0) = &HFF
                    OutByte(1) = &HF0
                    Comm1.Output = OutByte
                    Stoplabel = True
                    Label2.Caption = "数据接收完毕，发送停止命令"
                ElseIf Option_Num = 3 And Time_Len >= Option_Content * 60 Then
                    ReDim OutByte(0 To 1) As Byte
                    OutByte(0) = &HFF
                    OutByte(1) = &HF0
                    Comm1.Output = OutByte
                    Stoplabel = True
                    Label2.Caption = "设定时间到，发送停止命令"
                    Timer1.Enabled = False
                End If
                
                GetData = False                             'if received all rounds ,close getdata label
                Comm1.RThreshold = 1
                Comm1.InputLen = 1
                If Stoplabel = True Then
                    If Comm1.InBufferCount < 2 Then
                        RuningState = False
                        MsgBox "接收数据完毕，单片机已停止运行！"
                        MoreOption.Enabled = True
                        Comm1.InBufferCount = 0
                        Start.Enabled = True
                        Stoplabel = False
                        Label2.Caption = "单片机已停止运行！"
                    End If
                End If
            End If
        Else
            Label2.Caption = "正在发送重发命令！"
            OutByte(0) = &H11
            Comm1.Output = OutByte
        End If
        

    ElseIf InByte(0) = &HFC Then
        If Comm1.InBufferCount > 2000 Then
            Comm1.InBufferCount = 0
        End If
        ReDim OutByte(0 To 1) As Byte
        OutByte(0) = &HFF
        OutByte(1) = &HF0
        Comm1.Output = OutByte
        Label2.Caption = "发送允许状态"
    ElseIf InByte(0) = &HFD Then
        ReDim Temp2(0 To 0) As Byte
        Temp2 = Comm1.Input
        Rounds = Temp2(0) 'CInt(AddT) - 1
        GetData = True
        Comm1.RThreshold = DataLen1 + 4
        Comm1.InputLen = DataLen1 + 4
        Label2.Caption = "开始接收数据！"
   End If

End Sub


Private Sub Command1_Click()
    Delay 1000
End Sub

Private Sub Form_Load()
    Label2.Caption = "准备就绪"
    If Comm1.PortOpen = True Then
        Comm1.PortOpen = False
    End If
    
    Comm1.CommPort = 1
    Label4.Caption = Comm1.Settings
    Comm1.InBufferCount = 0
    Comm1.OutBufferCount = 0                    'clear In&Output Buffers
    OKLabel = False
    GetData = False
    RuningState = False
    Stoplabel = False
    Timer1.Enabled = False
    Option_Num = 1
End Sub




Private Sub MoreOption_Click()
    Load Dialog
    Dialog.Show
End Sub

Private Sub Setprefer_Click()
    If OKLabel = False Then
        MsgBox "还未与单片机建立握手，请先建立握手！"
        GoTo back
    End If
    Dim DataLen As String
    Dim fLen As String
    Dim DelayLen As String
    Dim AddT As String
    Dim outBuff(0 To 5) As Byte
    
    DataLen = Trim(Text1.Text)
    fLen = Trim(Text2.Text)
    DelayLen = Trim(Text3.Text)
    AddT = Trim(Text4.Text)
    
    ReDim Tnum(0 To CInt(AddT)) As Integer
    For i = 0 To CInt(AddT)
        Tnum(i) = 0
    Next i
    If Val(DataLen) = 0 Or Val(fLen) = 0 Or Val(DelayLen) = 0 Or Val(AddT) = 0 Then
        MsgBox "错误的参数值！" & Chr(13) & "请重新设置！"
        Text4.SetFocus
        GoTo back
    End If
    If Val(AddT) > 8 Then
        MsgBox "通道数超出正常值！" & Chr(13) & "请重新设置！"
        Text4.SetFocus
        GoTo back
    End If
    If Val(fLen) <> 2 And Val(fLen) <> 4 And Val(fLen) <> 8 And Val(fLen) <> 16 And Val(fLen) <> 32 Then
        MsgBox "数字滤波次数应为2的N次幂！"
        Text2.SetFocus
        GoTo back
    End If
    If Len(DataLen) <> 4 Then
        MsgBox "数据长度错误，请重新设置！"
        Text1.SetFocus
        GoTo back
    End If
    
    If CInt(DelayLen) * 2 > 255 Then
        MsgBox "不用延时这么长时间吧？"
        Text3.SetFocus
        GoTo back
    End If
    
    DataLen1 = Val("&H" & DataLen)

    outBuff(0) = &HFD
    outBuff(1) = Val("&H" & Right(DataLen, 2))              'lower bit
    outBuff(2) = Val("&H" & Left(DataLen, 2))               'high bit
    outBuff(3) = Val("&H" & fLen)                           'filtering length
    outBuff(4) = Val("&H" & CStr(Hex(CInt(DelayLen) * 2)))                     'delay time length
    outBuff(5) = Val("&H" & AddT)
    Comm1.Output = outBuff
    Label2.Caption = "已成功设置参数！"
    MsgBox "参数设置成功！按开始将启动单片机运行！"
    
back:
End Sub

Private Sub ShakeHand_Click()
    Dim ReadBuff() As Byte
    Dim outBuff(0 To 1) As Byte
    Dim Temp(0) As Byte
    Dim n As Integer
    Dim Inbuffer_Len As Integer
    Label2.Caption = "正在与单片机建立握手......"
    n = 0
    Temp(0) = &HFC
    outBuff(0) = &HFF
    outBuff(1) = &HF0
    Option1.Enabled = False
    Option2.Enabled = False
    If Comm1.PortOpen = False Then
        Comm1.Settings = "9600,n,8,1"
        Comm1.OutBufferSize = 512
        Comm1.InBufferSize = 5120
        Comm1.PortOpen = True
    End If
    Comm1.RThreshold = 0                                'close receive interupt
    Comm1.SThreshold = 0                                'close send interupt
    Comm1.InputMode = comInputModeBinary                'set input mode as Binary
    Comm1.InputLen = 0                                  'read all data once
    
    
    Comm1.Output = Temp
    Delay 1000
    Do
    If Comm1.InBufferCount > 0 Then
        Inbuffer_Len = Comm1.InBufferCount
        ReDim ReadBuff(0 To Inbuffer_Len) As Byte
        ReadBuff = Comm1.Input
        If ReadBuff(0) = &HFC Then
            Comm1.Output = outBuff
            Label2.Caption = "与单片机握手成功！"
            MsgBox ("与单片机握手成功！")
            OKLabel = True
            Exit Do
        Else
            Comm1.Output = Temp
        End If
    End If
    n = n + 1
    If n > 1000 Then
        Label2.Caption = "与单片机握手失败！"
        MsgBox "与单片机握手失败，请检查硬件联接！", vbOKOnly, "出错信息"
        Exit Do
    End If
    Loop
    
End Sub

Private Sub Start_Click()
    If OKLabel = False Then
        MsgBox "还未与单片机建立握手，请先建立握手！"
    Else
        Dim Temp(0 To 1) As Byte
        Temp(0) = &HFF
        Temp(1) = &HFE
        Label2.Caption = "单片机正在运行！"
        MsgBox ("单片机开始运行！")
        Comm1.Output = Temp
        Delay 1000
        Comm1.Output = Temp
        If Option_Num = 3 Then
            Timer1.Enabled = True
            Timer1.Interval = 1000
            Time_Len = 0
        End If
        SetPrefer.Enabled = False
        ShakeHand.Enabled = False
        MoreOption.Enabled = False
        Comm1.InputLen = 1
        Comm1.RThreshold = 1                           'open receive interupt
        Start.Enabled = False
        Comm1.InBufferCount = 0
        RuningState = True
    End If
End Sub


Private Sub Stop_Click()
    Dim Temp(1) As Byte
    Temp(0) = &HFF
    Temp(1) = &HF0
    If OKLabel = False Then
        MsgBox "还未与单片机进行握手！停止指令无效！"
    ElseIf RuningState = True Then
                                          'send stop label
        Comm1.Output = Temp
        Label2.Caption = "已发送停止命令！"
        Stoplabel = True
        Timer1.Enabled = False
    Else                                         'send stop label
        Comm1.Output = Temp
        Start.Enabled = True
        Comm1.InBufferCount = 0
        MsgBox ("单片机已经停止！")
        Label2.Caption = "单片机已经停止"
        MoreOption.Enabled = True
    End If
End Sub

Private Sub Clearfile_Click()
    For i = 0 To CInt(Trim(Text4.Text)) - 1
        Open "data" & CStr(i) & ".txt" For Output As #2
        Close 2                                        'clear data text
    Next i
End Sub

Private Sub Reset_Click()
    Dim Temp(0 To 0) As Byte
    Temp(0) = &H0
    If Comm1.PortOpen = False Then
        Comm1.PortOpen = True
        Comm1.Output = Temp
    End If
    If RuningState = True Then
        Comm1.Output = Temp
        MsgBox "尚未停止运行！"
    Else
    
        If Comm1.PortOpen = True Then
            Comm1.Output = Temp
            Comm1.PortOpen = False
        End If
        Label2.Caption = " 系统已复位！"
        Comm1.CommPort = 1
        Option1.Enabled = True
        Option2.Enabled = True
        ShakeHand.Enabled = True
        SetPrefer.Enabled = True
        Start.Enabled = True
        Comm1.InBufferCount = 0
        Comm1.OutBufferCount = 0                    'clear In&Output Buffers
        Option1.Value = True
        OKLabel = False
        GetData = False
        Stoplabel = False
        RuningState = False
        Option_Num = 1
        Timer1.Enabled = False
    End If
End Sub

Private Sub Option1_Click()
    Comm1.CommPort = 1
End Sub

Private Sub Option2_Click()
    Comm1.CommPort = 2
End Sub


Sub Delay(delaytime As Integer)
    For i = 0 To delaytime
    Next i
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If Comm1.PortOpen = True Then
        Comm1.PortOpen = False
    End If
    End
End Sub

Private Sub Quit_Click()
    If Comm1.InBufferCount > 2 Then
        GoTo quitback
    End If
    
    If OKLabel = True And Stoplabel = False Then
        GoTo quitback
    End If
    If Comm1.PortOpen = True Then
        Comm1.PortOpen = False
    End If
    End
quitback:
End Sub

Private Sub Timer1_Timer()
    Time_Len = Time_Len + 1
End Sub