frmmain.frm

VB6.0编写串行口调试软件,通信软件,可实现十六进制,ASCII码的显示.欢迎指正!

    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           '接收到数据即触发OnComm
        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.txtTimer.Text = str(intTimer)
    
End Sub
'检测CommEvent，从串行口接收数据
Private Sub ctrMSComm_OnComm()
    
    Dim bytInput() As Byte    '用于接收数据的字节数组
    Dim intInputLen As Integer
    
    Select Case frmmaim.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 bytimput(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
'接收到字节流后，将把它与原来的数据保存在一起，代码如下：
'输入处理
'处理接收到的字节流，并保存在全局变量
'bytReceiveByte（）
Public Sub InputManage(bytInput() As Byte, intInputLen As Integer)
    Dim n As Integer      '定义变量及初始化
    
    ReDim Preserve bytReceiveByte(intReceiveLen + intInputlLenth)
    For n = 1 To intInputLenth Step 1
        bytReceiveByte(intReceiveLen + n - 1) = bytInput(n - 1)
    Next n
    intReceiveLen = intReceiveLen + intInputLenth
    
    
End Sub

'为输出准备文本
'保存在全局变量
'strText
'strHex
'strAddress
'总行数保存在
'intLine

Public Sub GetDisplayText()
    Dim n As Integer
    Dim intValue As Integer
    Dim intHighHex As Integer
    Dim intLowHex As Integer
    Dim strSingleChr As String
    
    Dim intAddress As Integer
    Dim intAddressArray(8) As Integer
    Dim intHighAddress As Integer
    
    strASCII = ""    '设置初值
    strHex = ""
    strAddress = ""
     
    '获得16进制码和ASCII码的字符串
    For n = 1 To intReceiveLen
        intValue = bytReceiveByte(n - 1)
    
        If intValue < 32 Or intValue > 128 Then    '处理非法字符
            strSingleChr = Chr(46)                 '对于不能显示的ASCII码，
        Else
            strSingleChr = Chr(intValue)           '用“.”表示
        End If
    
        strASCII = strASCII + strSingleChr
    
        intHighHex = intValue \ 16                '获得高位值
        intLowHex = intValue - intHighHex * 16    '获得低位值
    
        If intHighHex < 10 Then
            intHighHex = intHighHex + 48
        Else
            intHighHex = intHighHex + 55
        End If
        
        If intLowHex < 10 Then
            intLowHex = intLowHex + 48
        Else
            intLowHex = intLowHex + 55
        End If
        
        strHex = strHex + "" + Chr$(intHighHex) + Chr$(intLowHex) + ""
        
        If (n Mod intHexWidth) = 0 Then                     '设置换行
            strASCII = strASCII + Chr$(13) + Chr$(10)
            strHex = strHex + Chr$(13) + Chr$(10)
        Else
        
        End If
    Next n
    
    '获得地址字符串
    intLine = intReceiveLen \ intHexWidth                   '计算总行数
    If (intReceiveLen - intHexWidth * intLine) > 0 Then
        intLine = intLine + 1
    End If
    
    For n = 1 To intLine
        intAddress = (n - 1) * intHexWidth
        
        If intAdd48Chk = 1 Then
            intHighAddress = 8
        Else
            intHighAddress = 4
        End If
        
        intAddressArray(0) = intAddress
        
        For m = 1 To intHighAddress
            intAddressArray(m) = intAddressArray(m - 1) \ 16
        Next m
        
        For m = 1 To intHighAddress
            If intAddressArray(intHighAddress - m) < 10 Then
                intAddressArray(intHighAddress - m) = intAddressArray(intHighAddress - m) + Asc("0")
            Else
                intAddressArray(intHighAddress - m) = intAddressArray(intHighAddress - m) + Asc("A") - 10
            End If
            strAddress = strAddress + Chr$(intAddressArray(intHighAddress - m))
        Next m
        
        strAddress = strAddress + Chr$(13) = Chr$(10)    '设置换行
    Next n
    
End Sub


'Timer触发的事件,所有的发送都在这里执行
Private Sub ctrTimer_Timer()
    
    Dim longth As Integer
   
   'Dim bytSendByte() As Byte
    
    strSendText = frmMain.txtSend.Text
    
    If intOutMode = 0 Then
        frmMain.txtReceive.Text = "ASCII"
        frmMain.ctrMSComm.Output = strSendText    '发送文本
    Else
        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.Value = intHexWidth
    
    '默认各复选框为选定状态
    intHexChk = 1
    intASCIIChk = 1
    intAddressChk = 1
    intAdd48Chk = 1
    
    frmMain.chkHex.Value = intHexChk
    frmMain.chkASCII.Value = intASCIIChk
    frmMain.chkAddress.Value = intAddressChk
    frmMain.chkAddress48.Value = intAdd48Chk
    
    '初始化串行口
    intPort = 1                             '串行口号
    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     '关闭串行口
    
    
    '初始化显示窗口
    '设置回显视窗位置尺寸
    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.txtHexEditASCII.Top = 0
    frmMain.txtBlank.Top = 0
    
    frmMain.txtHexEditAddress.Height = frmMain.fraHexEditBackground.Height
    frmMain.txtHexEditHex.Height = frmMain.fraHexEditBackground.Height
    frmMain.txtHexEditASCII.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.vsclHexEdit.Height = chrHeight
    frmMain.vsclHexEdit.Left = frmMain.fraHexEditBackground.Left
    frmMain.vsclHexEdit.Top = frmMain.fraHexEditBackground.Top + frmMain.fraHexEditBackground.Top - frmMain.vsclHexEdit.Top
    frmMain.vsclHexEdit.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
    
    
End Sub

'对滑轨的响应

Private Sub sldLenth_Change()

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

End Sub

'显示输出
Public Sub display()
    Dim intViewWidth As Long      '横向宽度(像素)
    Dim intViewLine As Integer    '纵向宽度(行)
    Dim strDisplayAddress As String    '
    Dim strDisplayHex As String        '
    Dim strDisplayASCII As String      '
     
    strDisplayAddress = ""             '
    strDisplayHex = ""
    strDisplayASCII = ""
    
    Dim intStart As Integer            '
    Dim intLenth As Integer            '
    
    '
    
    If intAdd48Chk = 1 Then
        frmMain.txtHexEditAddress.Width = 8 * chrWidth + BorderWidth
    Else
        frmMain.txtHexEditAddress.Width = 4 * chrWidth + BorderWidth
    End If
    
    frmMain.txtHexEditHex.Width = intHexWidth * 4 * chrWidth + BorderWidth
    frmMain.txtHexEditHex.Width = intHexWidth * chrWidth + BorderWidth
    frmMain.txtBlank.Width = BorderWidth
    
    intViewWidth = frmMain.txtHexEditAddress.Width * intAddressChk + frmMain.txtHexEditHex.Width * intHexChk + frmMain.txtHexEditASCII.Width * intASCIIChk
    
    If intViewWidth <= frmMain.fraHexEditBackground.Width And intLine < LineMax Then
        frmMain.txtBlank.Width = frmMain.fraHexEditBackground.Width - intViewWidth
        frmMain.hsclHexEdit.Visible = False
        frmMain.vsclHexEdit.Visible = False
        intViewWidth = frmMain.fraHexEditBackground.Width
        intViewLine = intLine
        intOriginX = 0
        intOriginY = 0
        
    ElseIf intViewWidth > frmMain.fraHexEditBackground.Width And intLine < linemin Then
        frmMain.hsclHexEdit.Visible = True
        frmMain.vsclHexEdit.Visible = False
        frmMain.hsclHexEdit.Width = frmhexeditbackground.Width
        intViewLine = intLine
        
        intOriginY = 0
        If intOriginX > intViewWidth - frmMain.fraHexEditBackground.Width Then
            intOriginX = intViewWidth - frmMain.fraHexEditBackground.Width
        End If
        
    ElseIf intViewWidth < (frmMain.fraHexEditBackground.Width - frmMain.vsclHexEdit.Width) And intLine >= LineMax Then
        frmMain.vsclHexEdit.Visible = True
        frmMain.hsclHexEdit.Visible = False
        frmMain.txtBlank.Width = frmMain.fraHexEditBackground.Width - intViewWidth
        intViewWidth = frmMain.fraHexEditBackground.Width
        
        intViewLine = LineMax
        
        intOriginX = 0
        If intOriginY > intLine - linemac Then
            intOriginY = lintline - LineMax
        End If
        
    Else
    
        frmMain.hsclHexEdit.Visible = True
        frmMain.vsclHexEdit.Visible = True
        frmMain.hsclHexEdit.Width = frmMain.fraHexEditBackground.Width - frmMain.vsclHexEdit.Width
        intViewLine = LineMax - 1
        If intOriginX > intViewWidth - frmMain.fraHexEditBackground.Width Then
            intOriginX = intViewWidth - frmMain.fraHexEditBackground.Width
        End If
        
        If intOriginY > intLine - LineMax + 1 Then
            intOriginY = intlin - LineMax + 1
        End If
        
    End If
    
    frmMain.txtHexEditAddress.Left = intOriginX
    frmMain.txtHexEditHex.Left = intOriginX + frmMain.txtHexEditAddress.Width * intAddressChk
    frmMain.txtHexEditASCII.Left = intOriginX + frmMain.txtHexEditAddress.Width * intAddressChr + frmMain.txtHexEditHex.Width * intHexChk
    frmMain.txtBlank.Left = intOriginX + frmMain.txtHexEditAddress.Width * intAddressChk + frmMain.txtHexEditHex.Width * intHexChk + frmMain.txtHexEditASCII.Width * intASCIIChk
    
    intStart = intOriginY * (6 + 4 * intAdd48Chk) + 1
    intLenth = intViewLine * (6 + 4 * intAdd48Chk)
    strDisplayAddress = Mid(strAddress, intStart, intLenth)
    
    intStart = intOriginY * (intHexWidth * 4 + 2) + 1
    intLenth = intViewLine * (intHexWidth * 4 + 2)
    strDisplayHex = Mid(strHex, intStart, intLenth)
    
    intStart = intOriginY * (intHexWidth + 2) + 1
    intLenth = intViewLine * (intHexWidth + 2)
    strDisplayASCII = Mid(strASCII, intStart, intLenth)
    
    '设置滚动条
    frmMain.vsclHexEdit.Max = intLine - intViewLine
    frmMain.hsclHexEdit.Max = (intViewWidth - frmMain.fraHexEditBackground.Width) \ chrWidth + 1
    
    '显示输出
    frmMain.txtHexEditHex.Text = strDisplayHex
    frmMain.txtHexEditASCII.Text = strDisplayASCII
    frmMain.txtHexEditAddress.Text = strDisplayAddress
    
    
End Sub

'文本无变化的刷新
Public Sub ScrollRedisplay()
    
    Call display

End Sub

'文本发生变化的刷新
Public Sub SlideRedisplay()
    
    Call GetDisplayText
    Call display
    
End Sub