《串口编程调试代码》之二

《串口编程调试代码》之二

主form 

'********************************** 
'字符表示的十六进制数转化为相应的整数 
'错误则返回  -1 
'********************************** 

Function ConvertHexChr(str As String) As Integer 
     
    Dim test As Integer 
     
    test = Asc(str) 
    If test >= Asc("0") And test <= Asc("9") Then
test = test - Asc("0")
ElseIf test >= Asc("a") And test <= Asc("f") Then
test = test - Asc("a") + 10
ElseIf test >= Asc("A") And test <= Asc("F") Then
test = test - Asc("A") + 10
Else
test = -1 '出错信息
End If
COnvertHexChr= test

End Function

'**********************************
'字符串表示的十六进制数据转化为相应的字节串
'返回转化后的字节数
'**********************************

Function strHexToByteArray(strText As String, bytByte() As Byte) As Integer

Dim HexData As Integer '十六进制(二进制)数据字节对应值
Dim hstr As String * 1 '高位字符
Dim lstr As String * 1 '低位字符
Dim HighHexData As Integer '高位数值
Dim LowHexData As Integer '低位数值
Dim HexDataLen As Integer '字节数
Dim StringLen As Integer '字符串长度
Dim Account As Integer '计数

strTestn = "" '设初值
HexDataLen = 0
strHexToByteArray = 0

StringLen = Len(strText)
Account = StringLen / 2
ReDim bytByte(Account)

For n = 1 To StringLen

Do '清除空格
hstr = Mid(strText, n, 1)
n = n + 1
If (n - 1) > StringLen Then 
                HexDataLen = HexDataLen - 1 
                 
                Exit For 
            End If 
        Loop While hstr = " " 
         
        Do 
            lstr = Mid(strText, n, 1) 
            n = n + 1 
            If (n - 1) > StringLen Then 
                HexDataLen = HexDataLen - 1 
                 
                Exit For 
            End If 
        Loop While lstr = " " 
        n = n - 1 
        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 cboHexAscii_Click() 

     
     
    If frmMain.cboHexAscii.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 cmdAutoSend_Click() 
     
    If blnAutoSendFlag Then 
         
        frmMain.ctrTimer.Enabled = False 
         
        If Not blnReceiveFlag Then 
            frmMain.ctrMSComm.PortOpen = False 
        End If 
         
        frmMain.cmdAutoSend.Caption = "自动发送" 
    Else 
        If Not frmMain.ctrMSComm.PortOpen Then 
            frmMain.ctrMSComm.CommPort = intPort 
            frmMain.ctrMSComm.Settings = strSet 
            frmMain.ctrMSComm.PortOpen = True 
        End If 
         
        frmMain.ctrTimer.Interval = intTime 
        frmMain.ctrTimer.Enabled = True 
        frmMain.cmdAutoSend.Caption = "停止发送" 
    End If 
         
     
         
    blnAutoSendFlag = Not blnAutoSendFlag 
     
     
End Sub 

Private Sub cmdClear_Click() 

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

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

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

Private Sub cmdSetting_Click() 
     
    dlgSetting.Show 
    dlgSetting.txtPort.Text = str(intPort) 
    dlgSetting.txtSetting.Text = strSet 
    dlgSetting.txtTime.Text = str(intTime) 

End Sub 

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

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

End Sub 

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

Private Sub Form_Load() 

    '设置默认发送接收关闭状态 
    blnAutoSendFlag = False 
    blnReceiveFlag = False 
     
    '接收初始化 
    intReceiveLen = 0 
     
    '默认发送方式为ASCII 
    intOutMode = 0 
    frmMain.cboHexAscii.Text = "按ASCII码" 
     
    '默认显示宽度位数为8 
    intHexWidth = 8 
     
    frmMain.sldLenth(0).Value = intHexWidth 
     
    '默认各复选框处于选定状态 
    intHexChk = 1 
    intAsciiChk = 1 
    intAddressChk = 1 
    intAdd48Chk = 1 
     
    frmMain.chkAddress.Value = intAddressChk 
    frmMain.chkAscii.Value = intAsciiChk 
    frmMain.chkHex.Value = intHexChk 
    frmMain.chkAddress48.Value = intAdd48Chk 
     
    '初始化显示视窗 
    frmMain.fraHexEditBackground.Left = frmMain.txtReceive.Left + 30 
    frmMain.fraHexEditBackground.Top = frmMain.txtReceive.Top + 30 
    frmMain.fraHexEditBackground.Width = frmMain.txtReceive.Width - 60 
    frmMain.fraHexEditBackground.Height = frmMain.txtReceive.Height - 60 
     
    frmMain.txtHexEditAddress.Top = 0 
    frmMain.txtHexEditHex.Top = 0 
    frmMain.txtHexEditText.Top = 0 
    frmMain.txtBlank.Top = 0 
     
    frmMain.txtHexEditAddress.Height = frmMain.fraHexEditBackground.Height 
    frmMain.txtHexEditHex.Height = frmMain.fraHexEditBackground.Height 
    frmMain.txtHexEditText.Height = frmMain.fraHexEditBackground.Height 
    frmMain.txtBlank.Height = frmMain.fraHexEditBackground.Height 
     
    '初始化滚动条 
    frmMain.vsclHexEdit.Width = 2 * ChrWidth 
    frmMain.vsclHexEdit.Top = frmMain.fraHexEditBackground.Top 
    frmMain.vsclHexEdit.Left = frmMain.fraHexEditBackground.Left + frmMain.fraHexEditBackground.Width - frmMain.vsclHexEdit.Width 
    frmMain.vsclHexEdit.Height = frmMain.fraHexEditBackground.Height 
     
    frmMain.hsclHexEdit.Height = ChrHeight 
    frmMain.hsclHexEdit.Left = frmMain.fraHexEditBackground.Left 
    frmMain.hsclHexEdit.Top = frmMain.fraHexEditBackground.Top + frmMain.fraHexEditBackground.Height - frmMain.hsclHexEdit.Height 
    frmMain.hsclHexEdit.Width = frmMain.fraHexEditBackground.Width 
     
     
    '设置滚动条最小和最大滚动 
    frmMain.vsclHexEdit.Min = 0 
    frmMain.vsclHexEdit.SmallChange = 1 
    frmMain.vsclHexEdit.LargeChange = 3 
    frmMain.vsclHexEdit.Value = 0 
     
    frmMain.hsclHexEdit.Min = 0 
    frmMain.hsclHexEdit.SmallChange = 1 
    frmMain.hsclHexEdit.LargeChange = 3 
    frmMain.hsclHexEdit.Value = 0 
     
    '显示初始化 
    Call cmdClear_Click 
     
     '初始化串行口 
    intPort = 2 
    intTime = 1000 
    strSet = "9600,n,8,1" 
    frmMain.ctrMSComm.InBufferSize = 1024 
    frmMain.ctrMSComm.OutBufferSize = 512 
     
     
    If Not frmMain.ctrMSComm.PortOpen Then 
        frmMain.ctrMSComm.CommPort = intPort 
        frmMain.ctrMSComm.Settings = strSet 
        frmMain.ctrMSComm.PortOpen = True 
    End If 
     
    frmMain.ctrMSComm.PortOpen = False 
     
     
End Sub 

Private Sub hsclHexEdit_Change() 
    intOriginX = -frmMain.hsclHexEdit.Value * ChrWidth 
    Call ScrollRedisplay 
End Sub 

Private Sub sldLenth_Change(Index As Integer) 

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

End Sub 

Private Sub vsclHexEdit_Change() 

    intOriginY = frmMain.vsclHexEdit.Value 
    Call ScrollRedisplay 
     
End Sub