Standard module:
Option explicit
Public financial information as financial information
The common target _ Wei Zhi (10) is an integer.
Public dizhi 1 is String * 2.
Public main_i is an integer.
Public I in integer form
Common j as an integer
Public fashion _ SJ (10,5) is a string.
Public xh in integer form
As the common base of an integer
Public SJ _ BM (10,5) is Single.
Public number in byte form.
The public setting is mixed (10) into a string * 16.
A public alame in the form of String * 1 (10)
Public record_jm(5) As Single
Common a is double precision.
Public PRINT_Cs( 14) as a string.
Public PRINT_WzCs( 12) as a string.
The common delay is a string.
The common delay time is a string.
Public shiyan_sj(4) As String
Public print_fg As Byte
Option explicit
Dim sum _zs
Dim Xu Hao _zs as string * 2
Represent I as bytes
Dim j As byte
Dim ccl(2) as string * 1
Dim blL As String * 2
Dim bl As String * 1
Display cclL(2) as a string * 4.
Dim bl_dm As String * 4
Dim zt_dm 1 as string * 8
Dim header _sj As String * 6
Snacks in byte form
Dim sum 1 as bytes
Dim Xu Hao as a string * 2
Display fa0 as a string * 2
Dim HexStr 1 as string * 20
basic settings
Slogans of "Dedicated Input Port as Integer"
Private strSet As String' protocol settings
Private intTime As Integer' sending interval
Send and receive flags
Private blnautosendflag as Boolean "Send Flag"
Private blnautosendflag1asbule' send flag
Private blnReceiveFlag as Boolean "Receiving Flag"
Sending module
Private intOutMode As Integer' sending mode
"Private strSendText As String" sends text data.
Private bytSendByte() As Byte' sends binary data.
Display sign
Private intHexChk As Integer' Hexadecimal Coding Flag
"private int ascii chkas integer" ascii code flag
"Private intAddressChk As Integer" address flag
Private in add 48 chkasinteger' 4/8 bit address flag
Receiving module
Private bytReceiveByte () of Byte' bytes has been received.
Number of bytes received by Private intReceiveLen as an integer.
Private string as a string
display module
Address information as a private address of a string.
Private strHex as string' hexadecimal encoding
Private strAscii As String 'ASCII code
"Private intHexWidth As Integer" displays the number of columns.
'
Private intOriginX As Long' horizontal origin (pixels)
Private intOriginY As Integer' vertical origin (line)
The total number of private intLine as integers.
'
Mark m as an integer
Dim blnChakanFlag is a boolean value.
Display constant
Private constant ChrWidth = 105' unit width
Private const chrheight = 2 * chrwidth' unit height.
Private constant boundary width = 2 10' Reserved boundary
Private Const LineMax = 16' shows the maximum number of lines.
input processing
The received byte stream is processed and stored in a global variable.
bytReceiveRyte()
Private sub input manager (byteinput () is a byte, and intInputLenth is an integer).
Dim n As Integer' defines variables and initializes them.
ReDim reserved bytes receive bytes (intReceiveLen+intInputLenth)
For n = 1 to step 1
bytreeceivebyte(intReceiveLen+n- 1)= byteinput(n- 1)
Next n
intReceiveLen = intReceiveLen+intInputLenth
End joint
Prepare the output text.
Save in global variables
strText
strHex
strAddress
The total number of rows is stored in intLine.
Private Sub GetDisplayText ()
Represent n as an integer
Dim intValue is an integer.
Dim intHighHex is an integer.
Dim intLowHex is an integer.
dim strSingleChr As String * 1
Dim intAddress is an integer.
Dimintaddressary (8) is an integer.
Diminthighdress as an integer
Dim HexStr as a string
Go to abc when an error occurs.
StrAscii = ""'Set the initial value.
strHex = " "
strAddress = " "
Gets the string of 16 hexadecimal code and ASCII code.
For n = 1 to intReceiveLen
int value = bytreeceivebyte(n- 1)
If intValue & lt32 or intValue & gt 128 then' process illegal characters'
StrSingleChr = Chr(46)' For ASCII codes that cannot be displayed,
"Else" is represented by "."
strSingleChr = Chr(intValue)
If ... it will be over.
strAscii = strAscii + strSingleChr
inthighex = int value \ 16
intlow hex = int value-in thighhex * 16
If intHighHex & lt, then 10
inthighex = inthighex+48
other
inthighex = inthighex+55
If ... it will be over.
If intLowHex & lt then 10
intLowHex = intLowHex + 48
other
intLowHex = intLowHex + 55
If ... it will be over.
HexStr = HexStr & ampChr$ (inch high hexadecimal) and ampChr$ (integer hexadecimal)
Hexstr 1 = Hexstr65438' transmits data.
strHex = strHex+" "+Chr $(inthighex)+Chr $(intlow hex)+" "
If (n Mod intHexWidth) = 0, then' set the line break.
stras CII = stras CII+Chr $( 13)+Chr $( 10)
strHex = strHex+Chr $( 13)+Chr $( 10)
other
If ... it will be over.
Next n
Get address string
int line = intReceiveLen \ intHexWidth
If (intreceivelen-inthexwidth * intline) > then 0
intLine = intLine + 1
If ... it will be over.
For n = 1 to intLine
in address =(n- 1)* in thix width
If intad48chk =1,then
intHighAddress = 8
other
intHighAddress = 4
If ... it will be over.
intAddressArray(0) = intAddress
For high address of m = 1 to in
intAddressArray(m)= intAddressArray(m- 1)\ 16
The next m
For high address of m = 1 to in
int address array(m- 1)= int address array(m- 1)-int address array(m)* 16
The next m
For high address of m = 1 to in
if in address array(in high address-m)& lt； So 10
int address array(in high address-m)= int address array(in high address-m)+Asc(" 0 ")
other
int address array(in high address-m)= int address array(in high address-m)+Asc(" A ")- 10
If ... it will be over.
stra address = stra address+Chr $(in address array(in high address-m))
The next m
Straddress = straddress+chr $ (13)+chr $ (10)' sets the line break.
Next n
Text 1 = "ok"
outlet connection
abc:
Text 1 = "Error "
biographical notes
End joint
Display output
Private sub-display ()
Set intViewWidth to Long' horizontal width (pixels)
Display intViewLine as integer' vertical width (line)
Dimstrdislayaddress as a string.
Dim strDisplayHex as a string
Dim strDisplayAscii is a string.
strDisplayAddress = " "
strDisplayHex = " "
strDisplayAscii = " "
Dim intStart is an integer.
Dim integer as integer
Resize the displayed page and set the width of the scroll position.
If intad48chk =1,then
frmmain . txthexeditaddress . width = 8 * chr width+border width
other
frmmain . txthexeditaddress . width = 4 * chr width+border width
If ... it will be over.
frmmain . txthexedithex . width = intHexWidth * 4 * chr width+border width
frmmain . txthexedittext . width = intHexWidth * chr width+border width
frmmain . txt blank . width = border width
intview width = frm main . txthexeditaddress . width * intAddressChk+frm main . txthexedithex . width * intHexChk+frm main . txthexedittext . width * intAsciiChk
If intviewwidth < = frmmain. frahexiditbackground. width and intline <; Then the maximum line
frmmain . txt blank . width = frmmain . frahexeditbackground . width-intview width
frmmain . hsclhexedit . visible = False
frmmain . vsclhexedit . visible = False
intview width = frmmain . frahexeditbackground . width
intViewLine = intLine
intOriginX = 0
intOriginY = 0
Else if intviewwidth & gt frmmain.frahexiditbackground.width and intline < then LineMax-1
frmmain . hsclhexedit . visible = True
frmmain . vsclhexedit . visible = False
frmmain . hsclhexedit . width = frmmain . frahexeditbackground . width
intViewLine = intLine
intOriginY = 0
If intoriginx & gtintviewwidth-frmmain. frahexiditbackground.width then
intOriginX = intview width-frmmain . frahexeditbackground . width
If ... it will be over.
Else if intviewwidth & lt (frmmain.frahexiditbackground.width-frmmain.vschlexedit.width) and intLine & gt= LineMax, and then
frmmain . vsclhexedit . visible = True
frmmain . hsclhexedit . visible = False
frmmain . txt blank . width = frmmain . frahexeditbackground . width-intview width
intview width = frmmain . frahexeditbackground . width
intViewLine = LineMax
intOriginX = 0
If intOriginY & gtintLine-LineMax and then
intOriginY = intLine - LineMax
If ... it will be over.
other
frmmain . hsclhexedit . visible = True
frmmain . vsclhexedit . visible = True
frmmain . hsclhexedit . width = frmmain . frahexeditbackground . width-frmmain . vsclhexedit . width
intViewLine = LineMax - 1
If intoriginx & gtintviewwidth-frmmain. frahexiditbackground.width then
intOriginX = intview width-frmmain . frahexeditbackground . width
If ... it will be over.
If intoriginy & gtinline-linemax+1then
into originy = int line-line max+ 1
If ... it will be over.
If ... it will be over.
frmmain . txthexeditaddress . left = intOriginX
frmmain . txthexedithex . left = intOriginX+frmmain . txthexeditaddress . width * int address chk
frmmain . txthexedittext . left = intOriginX+frmmain . txthexeditaddress . width * intAddressChk+frmmain . txthexedithex . width * intHexChk
frmmain . txt blank . left = intOriginX+frmmain . txthexeditaddress . width * intAddressChk+frmmain . txthexedithex . width * intHexChk+frmmain . txthexedittext . width * intAsciiChk
int start = intOriginY *(6+4 * int add 48 chk)+ 1
intLenth = intViewLine *(6+4 * int add 48 chk)
strDisplayAddress = Mid(strAddress，intStart，intLenth)
int start = intOriginY *(int hex width * 4+2)+ 1
intLenth = intViewLine *(int hex width * 4+2)
strDisplayHex = Mid(strHex，intStart，intLenth)
int start = intOriginY *(int hex width+2)+ 1
intLenth = intViewLine *(int hex width+2)
strDisplayAscii = Mid(strAscii，intStart，intLenth)
Set scroll bar
frmmain . vsclhexedit . max = int line-int viewline
frmmain . hsclhexedit . max =(intview width-frmmain . frahexeditbackground . width)\ chr width+ 1
Display output
frmmain . txthexedithex . text = strDisplayHex
frmmain . txthexedittext . text = strdisplay ascii
frmmain . txthexeditaddress . text = strDisplayAddress
End joint
Unchanged text refresh
Private sub-scrolling redisplay ()
Call display
End joint
Refresh when text changes
Private sub-slideshow ()
Call GetDisplayText
Call display
End joint
Hexadecimal numbers represented by' characters are converted into corresponding integers, and returning-1 indicates an error.
The function converts xchr(String As String) to an integer.
Dim test in integer form
Test = Asc(str)
If test & gt= Asc("0 ") and test & lt= Asc("9") Then
test = test - Asc("0 ")
ElseIf test & gt= Asc("a ") and test & lt= Asc("f") Then
test = test - Asc("a") + 10
ElseIf test & gt= Asc("A ") and test & lt= Asc("F") Then
test = test - Asc("A") + 10
other
"Test =-1" error message
If ... it will be over.
ConvertHexChr = test
End function
Hexadecimal data represented by string is converted into corresponding byte string, and the number of converted bytes is returned.
The function strHexToByteArray(strText is a string and bytByte () is a byte) is an integer.
Dim HexData As Integer' hexadecimal (binary) data byte corresponding value.
Dim hstr As String * 1' high-order characters
Dimlstra as the low-order character of string * 1'
Dimhighexdata is integer' high value'
Dimlowdata as integer' low value
Dim HexDataLen is an integer byte.
Dim StringLen As Integer' string length
Dim account is an integer.
Dim n As Long
count
StrTestn = ""'Set initial value
HexDataLen = 0
strHexToByteArray = 0
StringLen = Len(strText)
Account = StringLen \ 2
ReDim bytes (account)
For n = 1 to StringLen
Clear spaces
hstr = Mid(strText，n， 1)
n = n + 1
If (n-1) > Sterling, then.
HexDataLen = HexDataLen - 1
Quit for ...
If ... it will be over.
Cycle when hstr = ""
do
lstr = Mid(strText，n， 1)
n = n + 1
If (n-1) > Sterling, then.
HexDataLen = HexDataLen - 1
Quit for ...
If ... it will be over.
Loop when lstr = ""
n = n - 1
If n>, then Sterling.
HexDataLen = HexDataLen - 1
Quit for ...
If ... it will be over.
highexdata = ConvertHexChr(hstr)
LowHexData = ConvertHexChr(lstr)
If highexdata =- 1 or lowxdata =- 1,' illegal character interrupt conversion is encountered.
HexDataLen = HexDataLen - 1
Quit for ...
other
HexData = high HexData * 16+low hexdata.
bytByte(HexDataLen) = HexData
HexDataLen = HexDataLen + 1
If ... it will be over.
Next n
If hexdatalen > "0 then" corrects the value changed in the last cycle.
HexDataLen = HexDataLen - 1
ReDim reserved bytes (HexDataLen)
other
ReDim reserved bytes (0)
If ... it will be over.
If StringLen = 0 Then' If it is an empty string, it will not enter the loop body.
strHexToByteArray = 0
other
strHexToByteArray = HexDataLen+ 1
If ... it will be over.
End function
Common function Hex_bin ()
Output port status identification
For i = 1 to 2
ccl(i) = Mid(blL，I， 1)
If ccl(i)>= Chr(48) and ccl (I) <: = Chr(57) or ccl(i)>= Chr(65) and ccl (I) <; = Chr(70) then
Copper clad laminate (I) = copper clad laminate (I)
other
"Exit function" exits the process function.
ccl(i) = "0 "
If ... it will be over.
Next, I
For j = 1 to 2
bl = ccl(j)
If bl = "F ",then
bl _ DM = " 1 1 1 1 "
ElseIf bl = "E "and then
bl_dm = " 1 1 10 "
ElseIf bl = "D "and then
bl_dm = " 1 10 1 "
ElseIf bl = "C "and then
bl_dm = " 1 100 "
ElseIf bl = "B "and then
bl_dm = " 10 1 1 "
ElseIf bl = "A "and then
bl_dm = " 10 10 "
ElseIf bl = "9 "So
bl_dm = " 100 1 "
ElseIf bl = "8 "So
bl_dm = " 1000 "
ElseIf bl = "7 "So
bl_dm = "0 1 1 1 "
ElseIf bl = "6 "and then
bl_dm = "0 1 10 "
ElseIf bl = "5 "and then
bl_dm = "0 10 1 "
ElseIf bl = "4 "So
bl_dm = "0 100 "
ElseIf bl = "3 "So
bl_dm = "00 1 1 "
ElseIf bl = "2 "and then
bl_dm = "00 10 "
ElseIf bl = "1" and then
bl_dm = "000 1 "
ElseIf bl = "0 "and then
bl_dm = "0000 "
Otherwise:
bl_dm = " "
If ... it will be over.
cclL(j) = bl_dm
Next J.
ZT _ DM 1 = cclL( 1)+cclL(2)
For i = 1 to 8
zt_dm(i) = Mid$(zt_dm 1，I， 1)
Next, I
End function
Private Sub cboHexAscii_Click ()
If frmMain.cboHexAscii.Text = "According to Ascii code", then
intOutMode = 0
other
intOutMode = 1
If ... it will be over.
End joint
Private Sub chkAddress_Click()
If chkAddress. Then the value = 0
intAddressChk = 0
other
intAddressChk = 1
If ... it will be over.
Call scrolling display
End joint
Private Sub chkAddress48_Click()
If chkAddress48. Then the value = 1
intAdd48Chk = 1
other
intAdd48Chk = 0
If ... it will be over.
Call SlideRedisplay
End joint
Private Sub chkAscii_Click()
If chkAscii. Then the value = 1
intAsciiChk = 1
other
intAsciiChk = 0
If ... it will be over.
Call scrolling display
End joint
Private Sub chkHex_Click()
If chkHex. Then the value = 0
intHexChk = 0
other
intHexChk = 1
If ... it will be over.
Call scrolling display
End joint
Private Sub cmdAutoSend_Click ()
If blnAutoSendFlag, then
frmMain.ctrTimer.Enabled = False
If it is not blnReceiveFlag, then
frmmain . CTR MSComm . port open = False
If ... it will be over.
FrmMain.cmdAutoSend.Caption = "automatic addressing"
other
If it is not frmMain.ctrMSComm.PortOpen, then
frmmain . CTR MSComm . com mport = int port
frmmain . CTR MSComm . settings = strSet
frmmain . CTR MSComm . port open = True
If ... it will be over.
frmmain . CTR timer . interval = int time
frmMain.ctrTimer.Enabled = True
FrmMain.cmdAutoSend.Caption = "Stop addressing"
If ... it will be over.
blnAutoSendFlag = Not blnAutoSendFlag
End joint
private Sub cmdautosend 1 _ Click()
Used to set parameters.
If blnAutoSendFlag 1
Call cmdAutoSend_Click.
frmMain.ctrTimer 1。 Enabled = False
Furman cmdesend 1。 Caption = "Automatic setting"
other
If it is not frmMain.ctrMSComm.PortOpen, then
frmmain . CTR MSComm . com mport = int port
frmmain . CTR MSComm . settings = strSet
frmmain . CTR MSComm . port open = True
If ... it will be over.
Call cmdAutoSend_Click.
Furman cmdesend 1。 Caption = "Stop setting"
frmMain.ctrTimer 1。 Enabled = true
If ... it will be over.
blnautosendflag 1 = Not blnautosendflag 1
End joint
Private Sub cmdChakan_Click()
If blnChakanFlag, then
FrmMain.cmdChakan.Caption = "View"
Furman Height = 2800
other
frmmain . cmdchakan . caption = " Restore "
Furman Height = 6700
If ... it will be over.
blnChakanFlag = Not blnChakanFlag
End joint
Private Sub cmdClear_Click()
Dim bytTemp(0) is bytes.
ReDim Byte Receive Byte (0)
intReceiveLen = 0
Call InputManage(bytTemp, 0)
Call GetDisplayText
Call display
End joint
Private Sub cmdManualSend_Click()
If it is not frmMain.ctrMSComm.PortOpen, then
frmmain . CTR MSComm . com mport = int port
frmmain . CTR MSComm . settings = strSet
frmmain . CTR MSComm . port open = True
If ... it will be over.
Call ctrTimer_Timer.
If it is not blnAutoSendFlag, then
frmmain . CTR MSComm . port open = False
If ... it will be over.
End joint
Private Sub cmdReceive_Click ()
If blnReceiveFlag, then
If it is not blnAutoSendFlag and blnReceiveFlag, then
frmmain . CTR MSComm . port open = False
If ... it will be over.
FrmMain.cmdReceive.Caption = "Start receiving"
other
If it is not frmMain.ctrMSComm.PortOpen, then
frmmain . CTR MSComm . com mport = int port
frmmain . CTR MSComm . settings = strSet
frmmain . CTR MSComm . port open = True
If ... it will be over.
frmMain.ctrMSComm.InputLen = 0
frmMain.ctrMSComm.InputMode = 0
frmmain . CTR MSComm . inbuffercount = 0
frmmain . CTR MSComm . rthreshold = 10
FrmMain.cmdReceive.Caption = "Stop receiving"
If ... it will be over.
blnReceiveFlag = Not blnReceiveFlag
End joint
As the length exceeds 10000 words, please ask another question to add.