Private Sub Option10_Click() Combo6.Enabled = True Text6.Enabled = True Text7.Enabled = True Text8.Enabled = True Label10.Enabled = True Label11.Enabled = True Label12.Enabled = True Label13.Enabled = True Option6.Enabled = False Option7.Enabled = False Option11.value = True Combo2.ListIndex = 1 Combo5.ListIndex = 1 Text1.Enabled = False Label14.Enabled = False Frame7.Visible = True End Sub
'自动发送选择
Private Sub Option2_Click()
If Option2.value = True Then Timer1.Enabled = True
Command4.Enabled = False Else
Timer1.Enabled = False Command4.Enabled = True
End If End Sub
Private Sub Option3_Click() 'Non选项 Combo6.Enabled = False Text6.Enabled = False Text7.Enabled = False Text8.Enabled = False Label10.Enabled = False Label11.Enabled = False Label12.Enabled = False Label13.Enabled = False Option6.Enabled = True Option7.Enabled = True Combo2.ListIndex = 2 Combo5.ListIndex = 0 Text1.Enabled = True Label14.Enabled = True
Frame7.Visible = False
End Sub
Private Sub Option4_Click() 'ASCII选项 Combo6.Enabled = True Text6.Enabled = True Text7.Enabled = True Text8.Enabled = True Label10.Enabled = True Label11.Enabled = True Label12.Enabled = True Label13.Enabled = True Option6.Enabled = False Option7.Enabled = False Combo2.ListIndex = 1 Combo5.ListIndex = 1 Text1.Enabled = False Label14.Enabled = False Frame7.Visible = False End Sub
Private Sub Option5_Click() 'RTU选项 Combo6.Enabled = True Text6.Enabled = True Text7.Enabled = True Text8.Enabled = True Label10.Enabled = True Label11.Enabled = True Label12.Enabled = True Label13.Enabled = True Option6.Enabled = False Option7.Enabled = False Combo2.ListIndex = 2 Combo5.ListIndex = 1 Text1.Enabled = False Label14.Enabled = False Frame7.Visible = False End Sub
'发送时间间隔调整输入 Private Sub Text5_Change() Dim number As String Dim num As Integer Dim numcyc As Integer
num = Len(Text5.Text) For numcyc = 1 To num
number = Mid(Text5.Text, numcyc, 1)
Select Case InStr(\
Case 0
MsgBox \输入时间间隔错误，请重新输入\错误信息\ Exit Sub End Select
Next
Timer1.Interval = Text5.Text End Sub
'自动发送定时器
Private Sub Timer1_Timer() If MSComm1.PortOpen Then Call sentsub End If End Sub
'状态刷新定时器
Private Sub Timer2_Timer()
StatusBar1.Panels(1).Text = \串口选择：\
StatusBar1.Panels(2).Text = \串口设置：\ StatusBar1.Panels(3).Text = \串口状态：\End Sub
'串口发送子程序
Private Sub sentsub() Dim optioncase%
If Option3.value Then optioncase = 1 If Option4.value Then optioncase = 2 If Option5.value Then optioncase = 3 If Option10.value Then optioncase = 4 Select Case optioncase Case 1
If Option6.value Then Text1text = Text1.Text Call Hexsent Else
Text1text = Text1.Text Call ASCIIsent End If Case 2
Call incorporate '将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串
Call ASCIIcheck Call ASCIIsent
Case 3
Call incorporate '将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串
Call RTUcheck
Call Hexsent Case 4
Call incorporate1 '将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串 Call deltaASCII Call ASCIIsent End Select End Sub '十六进制发送 Private Sub Hexsent()
Dim hexchrlen%, Hexchr As String, hexcyc%, hexmid As Byte, hexmiddle As String
Dim hexchrgroup() As Byte, i As Integer
hexchrlen = Len(Text1text)
For hexcyc = 1 To hexchrlen '检查Text1文本框内数值是否合适
Hexchr = Mid(Text1text, hexcyc, 1)
If InStr(\ MsgBox \无效的数值，请重新输入\错误信息\ Exit Sub
End If Next
ReDim hexchrgroup(1 To hexchrlen \\ 2) As Byte
For hexcyc = 1 To hexchrlen Step 2 '将文本框内数值分成两个、两个
i = i + 1
Hexchr = Mid(Text1text, hexcyc, 2) hexmid = Val(\ hexchrgroup(i) = hexmid
'MSComm1.Output = CStr(hexmid) Next
MSComm1.Output = hexchrgroup End Sub
'ASC码发送
Private Sub ASCIIsent()
MSComm1.Output = Text1text
End Sub
'ASC校验,此段程序计算出LRC校验值，并加上字头和字尾 Private Sub ASCIIcheck()
Dim a%, b%, chrnum%, Lrcbyte As String Dim checksum%, char%, AscLrc%, Lrc%
chrnum = Len(Text1text)
For a = 1 To chrnum Step 2
char = Val(\两个两个的取字符 checksum = checksum + char '全部加起来 Next
AscLrc = checksum Mod &H100 '取255的余数
Lrc = (&HFF - AscLrc) + 1 '取二次补
If Lrc < 16 Then '此段程序是判断Hex(lrc)是否是一位数，
Lrcbyte = \如果是的话，前面加0；否则不加零 Else
Lrcbyte = CStr(Hex(Lrc)) End If
Text1text = CStr(Chr(58)) & CStr(Text1text) & Lrcbyte & CStr(Chr(13)) & CStr(Chr(10))
End Sub
'DeltaASCII校验,此段程序计算出LRC校验值，并加上字头和字尾 Private Sub deltaASCII()
Dim a%, b%, chrnum%, Lrcbyte As String Dim checksum%, char%, Lrc%
chrnum = Len(Text1text)
For a = 1 To chrnum
char = Asc(Mid(Text1text, a, 1)) '两个两个的取字符 checksum = checksum + char '全部加起来 Next
Lrc = (checksum + &H3) Mod &H100 '取255的余数
If Lrc < 16 Then '此段程序是判断Hex(lrc)是否是一位数，
Lrcbyte = \如果是的话，前面加0；否则不加零 Else
Lrcbyte = CStr(Hex(Lrc)) End If
Text1text = CStr(Chr(2)) & CStr(Text1text) & CStr(Chr(3)) & Lrcbyte End Sub
'RTU校验
Private Sub RTUcheck() Dim CRC() As Byte Dim d(5) As Byte Dim string1 As String
Dim j As Integer, chrlength As Integer, temp As String
string1 = Text1text
chrlength = Len(string1) For j = 0 To chrlength / 2 - 1