📄 串口通迅v0.1.frm
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form RS232_VB
Caption = " ---- 串口调试器----"
ClientHeight = 5190
ClientLeft = 60
ClientTop = 450
ClientWidth = 8280
Icon = "串口通迅V0.1.frx":0000
LinkTopic = "Form1"
ScaleHeight = 5190
ScaleWidth = 8280
StartUpPosition = 2 '屏幕中心
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 1
Left = 300
Top = 3990
End
Begin MSComctlLib.ProgressBar PR
Height = 180
Left = 3510
TabIndex = 23
Top = 3345
Width = 4515
_ExtentX = 7964
_ExtentY = 318
_Version = 393216
Appearance = 1
End
Begin VB.CheckBox Check2
Caption = "Check1"
Height = 195
Left = 4875
TabIndex = 22
Top = 3000
Width = 240
End
Begin VB.CheckBox Check1
Caption = "Check1"
Height = 195
Left = 5235
TabIndex = 20
Top = 4785
Width = 240
End
Begin VB.ComboBox CblUart
BackColor = &H00E0E0E0&
Height = 300
ItemData = "串口通迅V0.1.frx":030A
Left = 825
List = "串口通迅V0.1.frx":0320
TabIndex = 18
Text = "com1"
Top = 2265
Width = 1320
End
Begin VB.CommandButton CmdOpen
BackColor = &H000000FF&
Cancel = -1 'True
Caption = "打开串口"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 600
Left = 255
Style = 1 'Graphical
TabIndex = 16
Top = 2880
Width = 1770
End
Begin VB.ComboBox CblCk
BackColor = &H00E0E0E0&
Height = 300
ItemData = "串口通迅V0.1.frx":0348
Left = 825
List = "串口通迅V0.1.frx":035B
TabIndex = 15
Text = "None"
Top = 1830
Width = 1320
End
Begin VB.ComboBox CblSb
BackColor = &H00E0E0E0&
Height = 300
ItemData = "串口通迅V0.1.frx":037D
Left = 855
List = "串口通迅V0.1.frx":038A
TabIndex = 13
Text = "1.5"
Top = 1380
Width = 1290
End
Begin VB.ComboBox CblDb
BackColor = &H00E0E0E0&
Height = 300
ItemData = "串口通迅V0.1.frx":0399
Left = 855
List = "串口通迅V0.1.frx":03A9
TabIndex = 11
Text = "8"
Top = 915
Width = 1305
End
Begin VB.ComboBox CblBr
BackColor = &H00E0E0E0&
Height = 300
IMEMode = 3 'DISABLE
ItemData = "串口通迅V0.1.frx":03B9
Left = 840
List = "串口通迅V0.1.frx":03EA
TabIndex = 8
Text = "4800"
Top = 405
Width = 1335
End
Begin MSCommLib.MSComm MSComm
Left = 7560
Top = 4665
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin VB.CommandButton Button_RECV_C
Caption = "清空接收文本框"
Height = 375
Left = 5880
TabIndex = 6
Top = 2985
Width = 1575
End
Begin VB.CommandButton Button_SEND_C
Caption = "清空发送数据"
Height = 375
Left = 5985
TabIndex = 5
Top = 4695
Width = 1335
End
Begin VB.CommandButton Button_SEND
Caption = "发送数据"
Height = 375
Left = 2520
TabIndex = 4
Top = 4650
Width = 1215
End
Begin VB.TextBox Text_RECV
BackColor = &H8000000B&
Height = 2655
Left = 2535
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 1
Top = 240
Width = 5535
End
Begin VB.TextBox Text_SEND
Height = 975
Left = 2520
TabIndex = 0
Top = 3600
Width = 5535
End
Begin VB.Label Label10
AutoSize = -1 'True
Caption = "十六进制显示数据"
Height = 180
Left = 3420
TabIndex = 21
Top = 3000
Width = 1440
End
Begin VB.Label Label9
AutoSize = -1 'True
Caption = "十六进制发送数据"
Height = 180
Left = 3780
TabIndex = 19
Top = 4785
Width = 1440
End
Begin VB.Label Label8
AutoSize = -1 'True
Caption = "串 口"
Height = 180
Left = 255
TabIndex = 17
Top = 2295
Width = 450
End
Begin VB.Label Label7
AutoSize = -1 'True
Caption = "效验位"
Height = 180
Left = 210
TabIndex = 14
Top = 1830
Width = 540
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "停止位"
Height = 180
Left = 210
TabIndex = 12
Top = 1425
Width = 540
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "数据位"
Height = 180
Left = 210
TabIndex = 10
Top = 945
Width = 540
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "波特率"
Height = 255
Left = 195
TabIndex = 9
Top = 450
Width = 615
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "作者：zjz868@163.com"
Height = 180
Left = 150
TabIndex = 7
Top = 4935
Width = 1800
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "接收数据"
Height = 180
Left = 2520
TabIndex = 3
Top = 3000
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "发送数据"
Height = 180
Left = 2520
TabIndex = 2
Top = 3360
Width = 720
End
End
Attribute VB_Name = "RS232_VB"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Button_RECV_C_Click()
Text_RECV.Text = ""
Text_SEND.SetFocus
End Sub
Private Sub Button_SEND_C_Click()
Text_SEND.Text = ""
Text_SEND.SetFocus
End Sub
Private Sub Button_SEND_Click() ' 发送数据
Dim x As String
If CmdOpen.Caption = "打开串口" Then
x = MsgBox("串口末打开！", 16)
Exit Sub
End If
If Text_SEND.Text = "" Then '发送不能为空
x = MsgBox("发送数据不能为空", 16)
Exit Sub
End If
If Not MSComm.PortOpen Then
MSComm.PortOpen = True
End If
'朋友我的十六进制数转换暂时还没有做好!
MSComm.Output = Hex(Text_SEND.Text) + Chr$(13) '发送数据
For i = 1 To 2000000 '延时
Next
PR.Visible = True
Timer1.Enabled = True
End Sub
Private Sub CblBr_Change()
If MSComm.PortOpen = True Then
MSComm.PortOpen = False
MSComm.SThreshold = 0 '不触发事件
MSComm.RThreshold = 0 '每一个字符到接收缓冲区都触发接收事件
CmdOpen.Caption = "打开串口"
CmdOpen.BackColor = 85002
End If
End Sub
Private Sub CblBr_Click()
If MSComm.PortOpen = True Then
MSComm.PortOpen = False
MSComm.SThreshold = 0 '不触发事件
MSComm.RThreshold = 0 '每一个字符到接收缓冲区都触发接收事件
CmdOpen.Caption = "打开串口"
CmdOpen.BackColor = 85002
End If
End Sub
Private Sub CblDb_Click()
Call CblBr_Click
End Sub
Private Sub CblSb_Click()
Call CblBr_Click
End Sub
Private Sub CblCk_Click()
Call CblBr_Click
End Sub
Private Sub CblUart_Click()
Call CblBr_Click
End Sub
Private Sub CmdOpen_Click()
If MSComm.PortOpen = False Then '打开串口
MSComm.PortOpen = True
MSComm.SThreshold = 0 '不触发事件
MSComm.RThreshold = 1 '每一个字符到接收缓冲区都触发接收事件
CmdOpen.BackColor = 12021
MSComm.SThreshold = 0 '不触发事件
MSComm.RThreshold = 1 '每一个字符到接收缓冲区都触发接收事件
CmdOpen.BackColor = 12021
CmdOpen.Caption = "关闭串口"
Call PortSet
ElseIf MSComm.PortOpen = True Then
MSComm.PortOpen = False
MSComm.SThreshold = 0 '不触发事件
MSComm.RThreshold = 0 '每一个字符到接收缓冲区都触发接收事件
CmdOpen.Caption = "打开串口"
CmdOpen.BackColor = 85002
End If
End Sub
Private Sub Command1_Click()
FrmJBmsg.Show
End Sub
Private Sub Form_Load()
'MSComm.CommPort = 1 '设置串口1
'MSComm.Settings = "9600,n,8,1" '波特率9600bit/s,无效验，8位数据，1位停止位
Call PortSet
MSComm.InputLen = 0 '读取接收缓冲区的所有字符
MSComm.InBufferSize = 1024 '设置接收缓冲区为1024字节
MSComm.OutBufferSize = 512 '设置发送缓冲区为512字节
'MSComm.PortOpen = True '打开串口
'If MSComm.PortOpen = False Then '打开串口
MSComm.PortOpen = True
CmdOpen.Caption = "关闭串口"
MSComm.SThreshold = 0 '不触发事件
MSComm.RThreshold = 1 '每一个字符到接收缓冲区都触发接收事件
'End If
MSComm.InBufferCount = 0 '清除发送区的数据
MSComm.OutBufferCount = 0 '清除接收区的缓冲区数据
Text_SEND.Text = "" '清空发送文本
Text_RECV.Text = "" '清空接收文本
End Sub
Private Sub MSComm_OnComm()
Select Case MSComm.CommEvent '检验串口事件
'错误处理
Case comEventOverrun ' 数据丢失
Text_SEND.Text = "" '清空发送缓冲区
Text_RECV.Text = "" '清空接收缓冲区
Text_SEND.SetFocus
Exit Sub
Case comEventRxOver '接收缓冲区溢出
Text_SEND.Text = "" '清空发送缓冲区
Text_RECV.Text = "" '清空接收缓冲区
Text_SEND.SetFocus
Exit Sub '事件处理
Case comEventTxFull '发送缓冲区已满
Text_SEND.Text = "" '清空发送缓冲区
Text_RECV.Text = "" '清空接收缓冲区
Text_SEND.SetFocus
Exit Sub '事件处理
Case comEvReceive '接收缓冲区有数据
Dim Str As String
Str = MSComm.Input '从接收队列中读入字符串
MsgBox Asc(Str)
'Str = Str + 48
' MsgBox Hex(Str)
Text_RECV.Text = Text_RECV.Text + Str '读出字符串送显
Timer1.Enabled = True
PR.Visible = True
End Select
End Sub
Sub PortSet()
Dim PortSetCk As String
Dim PortSetUart As String
Select Case CblCk.Text
Case None '
PortSetCk = "N"
Exit Sub
Case Odd
PortSetCk = "O"
Exit Sub
Case Even
PortSetCk = "E"
Exit Sub
Case Mark
Dim Str As String
PortSetCk = "M"
Exit Sub
'Case Space
'Dim Str As String
' PortSetCk = "S"
'Exit Sub
End Select
Select Case CblUart.Text
Case com1 '
PortSetUart = "1"
Exit Sub
Case com2 '
PortSetUart = "2"
Exit Sub
Case com3 '
PortSetUart = "3"
Exit Sub
Case com4 '
PortSetUart = "4"
Exit Sub
Case com5 '
PortSetUart = "5"
Exit Sub
Case com6 '
PortSetUart = "6"
Exit Sub
End Select
'MSComm.CommPort = (PortSetUart)
'MSComm.Settings = CblBr.Text&&PortSetCk&","&cbldb.Text&","&cblsb.Text
End Sub
Public Function Byte2Hex(ByVal Byte2 As String, ByVal Lens As String, ByVal Str As String) As String
On Error GoTo on_queryerr
Set g_tblrct = Nothing
Call g_tblrct.Open(strsql, g_dbcon, adOpenDynamic, adLockOptimistic, -1)
queryempinfo = True
Exit Function
on_queryerr:
MsgBox "错误代码:" & Err.Number & vbCrLf & _
"错误描述:" & Err.Description, vbCritical + vbOKOnly, "错误"
'queryempinfo = False
End Function
Private Sub Timer1_Timer()
Dim a As Integer
a = Val(PR.Value)
a = a + 1
PR.Value = a
If PR.Value = 100 Then
PR.Value = 0
PR.Visible = False
Timer1.Enabled = False
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -