📄
字号:
Private Sub Form_Load() ' 载入窗体
On Error GoTo Err
LblWeb.FontUnderline = True ' WEB上加下划线
LblWeb.ForeColor = vbBlue ' 蓝色显示WEB
TxtSend.Text = "http://blog.163.com/zhaojun_xf/" ' 载入发送信息
If MSComm.PortOpen = True Then MSComm.PortOpen = False ' 先判断串口是否打开，如果打开则先关闭
' 初始化串口
Call Comm_initial(Val(Mid(CboCom.Text, 4, 1)), CboBaudrate.Text, Left(CboParitybit.Text, 1), CboDatabit.Text, CboStopbit.Text)
Err:
End Sub
'=====================================================================================
' 保存接收文本
'=====================================================================================
Private Sub CmdSaveDisp_Click() ' 保存显示数据
On Error GoTo Err ' 错误处理
SaveTextPath = TxtSavePath ' 路径暂存
Open TxtSavePath & "\1.txt" For Output As #1 ' 打开文件
' 不存在的话 会创建文件,如已存在 会覆盖
' output 改为append 为追加
' 改为input 则只读
Print #1, Year(Date) & "年" & Month(Date) & "月" & Day(Date) & _
"日" & Hour(Time) & "时" & Minute(Time) & "分" & Second(Time) & _
"秒" & vbCrLf & TxtReceive.Text + vbCrLf ' 把接收区的文本保存 文本前加上保存时间 （0000年00月00日00时00分00秒）
' vbcrlf 为回车换行
Close #1 ' 关闭文件
TxtSavePath = "OK,1.txt Save" ' 提示保存成功
CmdSaveDisp.Enabled = False
Savetime = Timer ' 记下开始的时间
While Timer < Savetime + 5 ' 循环等待 5 - 要延时的时间
DoEvents ' 转让控制权，以便让操作系统处理其它的事件。
Wend
TxtSavePath = SaveTextPath ' 显示保存路径
CmdSaveDisp.Enabled = True
Err:
End Sub
'=====================================================================================
' 停止显示
'=====================================================================================
Private Sub CmdStopdisp_Click()
On Error GoTo Err
If DisplaySwitch = False Then
DisplaySwitch = True ' 关闭显示
CmdStopdisp.Caption = "继续显示"
Else
DisplaySwitch = False ' 开启显示
CmdStopdisp.Caption = "停止显示"
End If
Err:
End Sub
'=====================================================================================
' 计数器清零
'=====================================================================================
Private Sub CmdClearCounter_Click() ' 清除计数器
On Error GoTo Err
SendCount = 0 ' 发送计数器清零
ReceiveCount = 0 ' 接收计数器清零
TxtRXCount.Text = "RX:" & 0 ' 接收计数
TxtTXCount.Text = "TX:" & 0 ' 发送计数
Err:
End Sub
'=====================================================================================
' 更改保存显示数据的目录
'=====================================================================================
Private Sub CmdAmend_Click() '更改
Dim spShell As Object ' 定义存放引用对象的变量
Dim spFolder As Object ' 定义存放引用对象的变量
Dim spFolderItem As Object ' 定义存放引用对象的变量
Dim spPath As String ' 定义存放的变量
On Error GoTo Err ' 错误处理，防止取消打开文件夹时报错
Const WINDOW_HANDLE = 0
Const NO_OPTIONS = 0
Set spShell = CreateObject("Shell.Application")
Set spFolder = spShell.BrowseForFolder(WINDOW_HANDLE, "选择目录:", NO_OPTIONS, "C:\Scripts")
Set spFolderItem = spFolder.Self
spPath = spFolderItem.Path
spPath = Replace(spPath, "\", "\") ' Replace函数的返回值是一个字符串
TxtSavePath.Text = spPath ' 把文件夹路径显示在标签上
SaveTextPath = TxtSavePath.Text ' 路径暂存
Err:
End Sub
'=====================================================================================
' 串口设置
'=====================================================================================
Private Sub CboBaudrate_Click() ' 修改波特率
Call Comm_reSet(Val(Mid(CboCom.Text, 4, 2)), CboBaudrate.Text, Left(CboParitybit.Text, 1), CboDatabit.Text, CboStopbit.Text) '串口设置
End Sub
Private Sub CboCom_Click() ' 修改串口
Call Comm_reSet(Val(Mid(CboCom.Text, 4, 2)), CboBaudrate.Text, Left(CboParitybit.Text, 1), CboDatabit.Text, CboStopbit.Text) '串口设置
End Sub
Private Sub CboDatabit_Click() ' 修改数据位
Call Comm_reSet(Val(Mid(CboCom.Text, 4, 2)), CboBaudrate.Text, Left(CboParitybit.Text, 1), CboDatabit.Text, CboStopbit.Text) '串口设置
End Sub
Private Sub CboParitybit_Click() ' 修改校验位
Call Comm_reSet(Val(Mid(CboCom.Text, 4, 2)), CboBaudrate.Text, Left(CboParitybit.Text, 1), CboDatabit.Text, CboStopbit.Text) '串口设置
End Sub
Private Sub CboStopbit_Click() ' 修改停止位
Call Comm_reSet(Val(Mid(CboCom.Text, 4, 2)), CboBaudrate.Text, Left(CboParitybit.Text, 1), CboDatabit.Text, CboStopbit.Text) '串口设置
End Sub
'=====================================================================================
' 清空数据
'=====================================================================================
Private Sub CmdClearSend_Click() ' 清除发送区
TxtSend.Text = ""
End Sub
Private Sub CmdClearReceive_Click() ' 清空接收区
TxtReceive.Text = ""
End Sub
'=====================================================================================
' 选择要发送的文件并放入内存中
'=====================================================================================
Private Sub CmdSelectFile_Click() ' 选择要发送的文件
On Error GoTo Err ' 错误处理
CommonDialog1.Flags = cdlCFBoth
CommonDialog1.ShowOpen
TxtSendPath.Text = CommonDialog1.FileName ' 把打开的文件名给于TxtSendPath
Open TxtSendPath.Text For Input As 1 ' 打开选择的文件
FileData = StrConv(InputB$(LOF(1), 1), vbUnicode) ' 显示打开的文件
Close 1 ' 关闭文件
Err:
End Sub
'=====================================================================================
' 文件数据发送
'=====================================================================================
Private Sub CmdSendFile_Click() '发送文件
On Error GoTo Err
If MSComm.PortOpen = True Then ' 如果串口打开了，则可以发送数据
If FileData = "" Then ' 判断发送数据是否为空
MsgBox "发送的文件为空", 16, "串口调试助手" ' 发送数据为空则提示
Else
If ChkHexReceive.Value = 1 Then ' 如果按十六进制接收时，按二进制发送，否则按文本发送
MSComm.InputMode = comInputModeBinary ' 二进制发送
Else
MSComm.InputMode = comInputModeText ' 文本发送
End If
MSComm.Output = Trim(FileData) ' 发送数据
ModeSend = True ' 设置文本发送方式
End If
Else
MsgBox "串口没有打开，请打开串口", 48, "串口调试助手" ' 如果串口没有被打开，提示打开串口
End If
Err:
End Sub
'====================================================================================
' 发送文本数据
'====================================================================================
Private Sub CmdSend_Click() ' 发送按钮
On Error GoTo Err
If MSComm.PortOpen = True Then ' 如果串口打开了，则可以发送数据
If TxtSend.Text = "" Then ' 判断发送数据是否为空
MsgBox "发送数据不能为空", 16, "串口调试助手" ' 发送数据为空则提示
Else
If ChkHexSend.Value = 1 Then ' 发送方式判断
MSComm.InputMode = comInputModeBinary ' 二进制发送
Call hexSend ' 发送十六进制数据
Else ' 按十六进制接收文本方式发送的数据时，文本也要按二进制发送发送
If ChkHexReceive.Value = 1 Then
MSComm.InputMode = comInputModeBinary ' 二进制发送
Else
MSComm.InputMode = comInputModeText ' 文本发送
End If
MSComm.Output = Trim(TxtSend.Text) ' 发送数据
ModeSend = False ' 设置文本发送方式
End If
End If
Else
MsgBox "串口没有打开，请打开串口", 48, "串口调试助手" ' 如果串口没有被打开，提示打开串口
End If
Err:
End Sub
'====================================================================================
' 通信触发事件
'====================================================================================
Private Sub MSComm_OnComm() ' 设置oncomm事件，读取片机内存的值
On Error GoTo Err
Select Case MSComm.CommEvent ' 每接收1个数就触发一次
Case comEvReceive
If ChkHexReceive.Value = 1 Then
Call hexReceive ' 十六进制接收
Else
Call textReceive ' 文本接收
End If
Case comEvSend ' 每发送1个数就触发一次
If ChkHexSend.Value = 1 Then
Else
Call textSend ' 文本发送
End If
Case Else
End Select
Err:
End Sub
'====================================================================================
' 文本接收
'====================================================================================
Private Sub textReceive()
On Error GoTo Err
InputSignal = MSComm.Input
ReceiveCount = ReceiveCount + LenB(StrConv(InputSignal, vbFromUnicode)) ' 计算总接收数据
If DisplaySwitch = False Then ' 显示接收文本
TxtReceive.Text = TxtReceive.Text & InputSignal ' 单片机内存的值用TextReceive显示出
TxtReceive.SelStart = Len(TxtReceive.Text) ' 显示光标位置
End If
TxtRXCount.Text = "RX:" & ReceiveCount ' 接收字节数显示
If ChkAutoClear.Value = 1 Then ' 自动清空判断
If ReceiveCount >= 65535 Then
TxtReceive.Text = ""
End If
End If
Err:
End Sub
'====================================================================================
' 文本发送
'====================================================================================
Private Sub textSend()
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -