main.frm

VB串口编程调试精灵源码 VB串口编程调试精灵源码 VB串口编程调试精灵源码

        If n > StringLen Then
            HexDataLen = HexDataLen - 1
            Exit For
        End If
        
        HighHexData = ConvertHexChr(hstr)
        LowHexData = ConvertHexChr(lstr)
        
        If HighHexData = -1 Or LowHexData = -1 Then     '遇到非法字符中断转化
            HexDataLen = HexDataLen - 1
            
            Exit For
        Else
            
            HexData = HighHexData * 16 + LowHexData
            bytByte(HexDataLen) = HexData
            HexDataLen = HexDataLen + 1
            
            
        End If
                        
    Next n
    
    If HexDataLen > 0 Then                              '修正最后一次循环改变的数值
        HexDataLen = HexDataLen - 1
        ReDim Preserve bytByte(HexDataLen)
    Else
        ReDim Preserve bytByte(0)
    End If
    
    
    If StringLen = 0 Then                               '如果是空串,则不会进入循环体
        strHexToByteArray = 0
    Else
        strHexToByteArray = HexDataLen + 1
    End If
    
    
End Function






Private Sub combo_Click()

    
    
    If Main.combo.Text = "按ASCII码" Then
        intOutMode = 0
        
    Else
        intOutMode = 1
        
    End If
        
End Sub

Private Sub chkAddress_Click()
    
    If chkAddress.Value = 0 Then
        intAddressChk = 0
    Else
        intAddressChk = 1
    End If
    
    Call ScrollRedisplay
    
End Sub

Private Sub chkAddress48_Click()
    
    If chkAddress48.Value = 1 Then
        intAdd48Chk = 1
    Else
        intAdd48Chk = 0
    End If
    
    Call SlideRedisplay
    
End Sub

Private Sub chkAscii_Click()
    
    If chkAscii.Value = 1 Then
        intAsciiChk = 1
    Else
        intAsciiChk = 0
    End If
    
    Call ScrollRedisplay
    
End Sub

Private Sub chkHex_Click()
    
    If chkHex.Value = 0 Then
        intHexChk = 0
    Else
        intHexChk = 1
    End If
    
    Call ScrollRedisplay
    
End Sub

Private Sub send_Click()
    
    If blnAutoSendFlag Then
        
        Main.ctrTimer.Enabled = False
        
        If Not blnReceiveFlag Then
            Main.ctrMSComm.PortOpen = False
        End If
        
        Main.send.Caption = "自动发送"
    Else
        If Not Main.ctrMSComm.PortOpen Then
            Main.ctrMSComm.CommPort = intPort
            Main.ctrMSComm.Settings = strSet
            Main.ctrMSComm.PortOpen = True
        End If
        
        Main.ctrTimer.Interval = intTime
        Main.ctrTimer.Enabled = True
        Main.send.Caption = "停止发送"
    End If
        
    
        
    blnAutoSendFlag = Not blnAutoSendFlag
    
    
End Sub

Private Sub clear_Click()

    Dim bytTemp(0) As Byte
    
    ReDim bytReceiveByte(0)
    intReceiveLen = 0
    
    Call InputManage(bytTemp, 0)
    
    Call GetDisplayText
    Call display
    
    
End Sub

Private Sub send2_Click()
    
    If Not Main.ctrMSComm.PortOpen Then
        Main.ctrMSComm.CommPort = intPort
        Main.ctrMSComm.Settings = strSet
        Main.ctrMSComm.PortOpen = True
    End If
    
        Call ctrTimer_Timer
        
    If Not blnAutoSendFlag Then
    
    Main.ctrMSComm.PortOpen = False
    End If
    
End Sub

Private Sub Receive_Click()
    
    
    If blnReceiveFlag Then
        
        If Not blnAutoSendFlag And Not blnReceiveFlag Then
            Main.ctrMSComm.PortOpen = False
        End If
        
        Main.Receive.Caption = "开始接收"
    Else
        
        If Not Main.ctrMSComm.PortOpen Then
            Main.ctrMSComm.CommPort = intPort
            Main.ctrMSComm.Settings = strSet
            Main.ctrMSComm.PortOpen = True
        End If
        
        Main.ctrMSComm.InputLen = 0
        Main.ctrMSComm.InputMode = 0
        
    
        Main.ctrMSComm.InBufferCount = 0
        Main.ctrMSComm.RThreshold = 1
        Main.Receive.Caption = "停止接收"
    End If
    
    blnReceiveFlag = Not blnReceiveFlag
    
        
End Sub

Private Sub setting_Click()
    
    config.Show
    config.Port.Text = str(intPort)
    config.setting.Text = strSet
    config.time.Text = str(intTime)


End Sub

Private Sub ctrMSComm_OnComm()
    
    Dim bytInput() As Byte
    Dim intInputLen As Integer
    
    
    Select Case Main.ctrMSComm.CommEvent
        
        
        Case comEvReceive
            If blnReceiveFlag Then
            
                If Not Main.ctrMSComm.PortOpen Then
                    Main.ctrMSComm.CommPort = intPort
                    Main.ctrMSComm.Settings = strSet
                    Main.ctrMSComm.PortOpen = True
                End If
                
                '此处添加处理接收的代码
                
                Main.ctrMSComm.InputMode = comInputModeBinary
                intInputLen = Main.ctrMSComm.InBufferCount
                ReDim bytInput(intInputLen)
                bytInput = Main.ctrMSComm.Input
                Call InputManage(bytInput, intInputLen)
                Call GetDisplayText
                Call display
      
                
                If Not blnAutoSendFlag And Not blnReceiveFlag Then
                    Main.ctrMSComm.PortOpen = False
                End If
            End If
            
    End Select
    
End Sub

Private Sub ctrTimer_Timer()
    Dim longth As Integer
    
    strSendText = Main.txtSend.Text
    If intOutMode = 0 Then
        Main.txtReceive.Text = "ascii"
        Main.ctrMSComm.Output = strSendText
    Else
        'add code
        longth = strHexToByteArray(strSendText, bytSendByte())
        
        If longth > 0 Then
            Main.ctrMSComm.Output = bytSendByte
        End If
        
    End If

End Sub

'*****************************************
'初始化
'*****************************************


Private Sub Form_Load()
If ctrMSComm.PortOpen = False Then

ctrMSComm.PortOpen = True

End If

    '设置默认发送接收关闭状态
    blnAutoSendFlag = False
    blnReceiveFlag = False
    
    '接收初始化
    intReceiveLen = 0
    
    '默认发送方式为ASCII
    intOutMode = 0
    Main.combo.Text = "按ASCII码"
    
    '默认显示宽度位数为8
    intHexWidth = 8
    
    
    '默认各复选框处于选定状态
    intHexChk = 1
    intAsciiChk = 1
    intAddressChk = 1
    intAdd48Chk = 1
    
    Main.chkAddress.Value = intAddressChk
    Main.chkAscii.Value = intAsciiChk
    Main.chkHex.Value = intHexChk
    Main.chkAddress48.Value = intAdd48Chk
    
   
    
    '显示初始化
    Call clear_Click
    
     '初始化串行口
    intPort = 2
    intTime = 1000
    strSet = "9600,n,8,1"
   
    
    If Not Main.ctrMSComm.PortOpen Then
        Main.ctrMSComm.CommPort = intPort
        Main.ctrMSComm.Settings = strSet
        Main.ctrMSComm.PortOpen = True
    End If
    
    Main.ctrMSComm.PortOpen = False
    
    
End Sub




Private Sub sldLenth_Change(Index As Integer)

    intHexWidth = Main.sldLenth(0).Value
    Call SlideRedisplay
    

End Sub