📄 串口调试助手.frm
字号:
Top = 1740
Width = 870
End
Begin VB.Image ImgSwitchon
Height = 420
Left = 120
Picture = "串口调试助手.frx":87E4
Top = 1680
Width = 450
End
Begin VB.Image ImgSwitchoff
Height = 420
Left = 120
Picture = "串口调试助手.frx":C281
Top = 1680
Width = 450
End
Begin VB.Label Label8
Alignment = 2 'Center
BackColor = &H0091CACA&
Caption = "停止位"
Height = 255
Left = 50
TabIndex = 33
Top = 1400
Width = 600
End
Begin VB.Label Label7
Alignment = 2 'Center
BackColor = &H0091CACA&
Caption = "数据位"
Height = 255
Left = 50
TabIndex = 32
Top = 1080
Width = 600
End
Begin VB.Label Label6
Alignment = 2 'Center
BackColor = &H0091CACA&
Caption = "校验位"
Height = 255
Left = 50
TabIndex = 31
Top = 760
Width = 600
End
Begin VB.Label Label5
Alignment = 2 'Center
BackColor = &H0091CACA&
Caption = "波特率"
Height = 255
Left = 50
TabIndex = 30
Top = 470
Width = 600
End
Begin VB.Label Label4
Alignment = 2 'Center
BackColor = &H0091CACA&
Caption = "串口"
Height = 255
Left = 50
TabIndex = 29
Top = 160
Width = 600
End
End
Begin VB.TextBox TxtReceive
Height = 4035
Left = 1800
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Top = 6
Width = 7185
End
Begin VB.Image ImgClose
Height = 225
Left = 0
Picture = "串口调试助手.frx":F9C7
Top = 5400
Visible = 0 'False
Width = 240
End
Begin VB.Image ImgOpen
Height = 225
Left = 0
Picture = "串口调试助手.frx":FCD7
Top = 5400
Width = 240
End
Begin VB.Label LblWeb
BackColor = &H0091CACA&
Caption = "WEB"
ForeColor = &H008A7839&
Height = 225
Left = 7200
MouseIcon = "串口调试助手.frx":FFE3
TabIndex = 41
Top = 5040
Width = 300
End
Begin VB.Label Label14
BackColor = &H0091CACA&
Caption = "毫秒"
Height = 255
Left = 2040
TabIndex = 39
Top = 5000
Width = 450
End
Begin VB.Label LblArtoSendCyc
BackColor = &H0091CACA&
Caption = "自动发送周期："
Height = 195
Left = 120
TabIndex = 37
Top = 5000
Width = 1275
End
Begin VB.Label Label11
Alignment = 2 'Center
BackColor = &H0091CACA&
Height = 195
Left = 240
TabIndex = 36
Top = 4440
Width = 1200
End
Begin VB.Label LblSend
BackColor = &H0091CACA&
BorderStyle = 1 'Fixed Single
Caption = "发送的字符/数据"
Height = 270
Left = 1100
TabIndex = 28
Top = 4100
Width = 1420
End
Begin VB.Label LblReceive
BackColor = &H0091CACA&
BorderStyle = 1 'Fixed Single
Caption = "接收区"
Height = 255
Left = 1130
TabIndex = 27
Top = 2180
Width = 595
End
End
Attribute VB_Name = "串口调试软件"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'=====================================================================================
' 变量定义
'=====================================================================================
Option Explicit ' 强制显式声明
Dim ComSwitch As Boolean ' 串口开关状态判断
Dim FileData As String ' 要发送的文件暂存
Dim SendCount As Long ' 发送数据字节计数器
Dim ReceiveCount As Long ' 接收数据字节计数器
Dim InputSignal As String ' 接收缓冲暂存
Dim OutputSignal As String ' 发送数据暂存
Dim DisplaySwitch As Boolean ' 显示开关
Dim ModeSend As Boolean ' 发送方式判断
Dim Savetime As Single ' 时间数据暂存 延时用
Dim SaveTextPath As String ' 保存文本路径
Const HWND_TOPMOST = -1
' 网页超链接申明
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
' 锁最前面函数申明
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
'====================================================================================
' 自动发送选择
'=====================================================================================
Private Sub ChkAutoSend_Click()
On Error GoTo Err
If ChkAutoSend.Value = 1 Then ' 如果有效则，自动发送
If MSComm.PortOpen = True Then ' 串口状态判断
TmrAutoSend.Interval = Val(TxtAutoSendTime) ' 设置自动发送时间
TmrAutoSend.Enabled = True ' 打开自动发送定时器
Else
ChkAutoSend.Value = 0 ' 串口没有打开去掉自动发送
MsgBox "串口没有打开，请打开串口", 48, "串口调试助手" ' 如果串口没有被打开，提示打开串口
End If
ElseIf ChkAutoSend.Value = 0 Then ' 如果无效，不发送
TmrAutoSend.Enabled = False ' 关闭自动发送定时器
End If
Err:
End Sub
'=====================================================================================
' 关闭锁最前面显示图标
'=====================================================================================
Private Sub ImgClose_Click()
On Error GoTo Err
ImgClose.Visible = False ' 去掉最前面显示的锁
SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, 3 ' 关闭最前面显示
Err:
End Sub
'=====================================================================================
' 开最前面显示锁图标
'=====================================================================================
Private Sub ImgOpen_Click()
On Error GoTo Err
ImgClose.Visible = True ' 开最前面的锁显示
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, 3 ' 窗口置前
Err:
End Sub
'=====================================================================================
' 超链接我的博客
'=====================================================================================
Private Sub LblWeb_Click() ' 单击打开网站
ShellExecute Me.hwnd, "open", "http://blog.163.com/zhaojun_xf/", "", "", 5 ' 要打开的网站
End Sub
' 鼠标移入 WEB 区
Private Sub LblWeb_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
LblWeb.ForeColor = &H8A7839 ' 鼠标移入WEB时的颜色
LblWeb.MousePointer = 99 ' 鼠标移入WEB时的鼠标的现状 ,小手型
'LblWeb.MouseIcon = LoadPicture("f:\我的VB\串口调试软件\图片\mouse.cur") ' 鼠标形状图片
End Sub
' 鼠标移出 WEB 区
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
LblWeb.ForeColor = vbBlue ' 鼠标移出WEB时的颜色
Me.MousePointer = vbDefault ' 鼠标移出WEB时的鼠标的现状 即Me.MousePointer = 0
End Sub
'=====================================================================================
' 自动发送定时器
'=====================================================================================
Private Sub TmrAutoSend_Timer() ' 定时器
On Error GoTo Err
If TxtSend.Text = "" Then ' 判断发送数据是否为空
ChkAutoSend.Value = 0 ' 关闭自动发送
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
Err:
End Sub
'=====================================================================================
' 窗体载入
'=====================================================================================
Private Sub Form_Load() ' 载入窗体
On Error GoTo Err
LblWeb.FontUnderline = True ' WEB上加下划线
LblWeb.ForeColor = vbBlue ' 蓝色显示WEB
ImgClose.Visible = False ' 不显示锁定最前面图标
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -