?? main.frm
字號:
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -