📄 frmmian.frm
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Frmmian
Caption = "Form1"
ClientHeight = 6510
ClientLeft = 60
ClientTop = 345
ClientWidth = 7170
LinkTopic = "Form1"
ScaleHeight = 6510
ScaleWidth = 7170
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdSet
Caption = "端口设置"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 372
Left = 3000
TabIndex = 6
ToolTipText = "设置端口的波特率、校验、字长、停止位及端口号"
Top = 5760
Width = 1092
End
Begin VB.CommandButton cmdOpen
Caption = "开启端口"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 372
Left = 1680
TabIndex = 5
ToolTipText = "开启通讯端口"
Top = 5760
Width = 1092
End
Begin VB.CommandButton cmdSend
Caption = "发送！"
Default = -1 'True
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 372
Left = 360
TabIndex = 4
Tag = "将发送框中的数据发送出去"
Top = 5760
Width = 1092
End
Begin VB.CommandButton cmdClear
Caption = "清除"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 372
Left = 4320
TabIndex = 3
ToolTipText = "清除接收到的数据"
Top = 5760
Width = 1092
End
Begin VB.CommandButton cmdSwitch
Caption = "模式切换"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 372
Left = 5640
TabIndex = 2
ToolTipText = "在字符串/16进制数模式之间切换接收到的文本的显示模式"
Top = 5760
Width = 1092
End
Begin VB.TextBox txtSend
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1932
Left = 360
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 1
ToolTipText = "&Hxx:发送16进制数xx；Ctrl+回车：换行；回车键：发送。"
Top = 1200
Width = 6372
End
Begin VB.TextBox txtReceive
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1932
Left = 360
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 0
TabStop = 0 'False
Top = 3600
Width = 6372
End
Begin MSCommLib.MSComm MSComm1
Left = 0
Top = 0
_ExtentX = 794
_ExtentY = 794
_Version = 393216
CommPort = 2
DTREnable = 0 'False
InBufferSize = 20480
RThreshold = 1
InputMode = 1
End
Begin VB.Label Label1
Caption = "发送输入窗口"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 252
Left = 360
TabIndex = 9
Top = 960
Width = 1332
End
Begin VB.Label Label2
Caption = "接收数据窗口"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 252
Left = 360
TabIndex = 8
Top = 3360
Width = 1332
End
Begin VB.Label lblSetting
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 492
Left = 480
MouseIcon = "Frmmian.frx":0000
TabIndex = 7
ToolTipText = "关于本应用程序..."
Top = 360
Width = 6132
End
End
Attribute VB_Name = "Frmmian"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ReceiveBuffer() As Byte
Dim IsHexMode As Boolean
Dim IsRefreshed As Boolean
Dim HexPos As Integer
Private Sub cmdClear_Click()
ReceiveBuffer = ""
txtReceive.Text = ""
HexPos = 0
cmdSwitch.Enabled = False
End Sub
Private Sub cmdOpen_Click()
On Error GoTo ErrHandler
If MSComm1.PortOpen Then
MSComm1.PortOpen = False
cmdOpen.Caption = "开启端口"
cmdOpen.ToolTipText = "开启通讯端口"
cmdSet.Enabled = True
cmdSend.Enabled = False
Else
MSComm1.PortOpen = True
cmdOpen.Caption = "关闭端口"
cmdOpen.ToolTipText = "关闭通讯端口"
cmdSet.Enabled = False
cmdSend.Enabled = True
End If
Exit Sub
ErrHandler:
MsgBox "不能操作端口，请重新设置端口！", vbInformation, "错误"
End Sub
Private Sub cmdSend_Click()
Dim i, j As Integer
Dim TempBuf() As Byte
Dim SendBuf() As Byte
On Error GoTo ErrHandler
j = 1
Do
i = InStr(j, txtSend.Text, "&H")
If i <> 0 Then
TempBuf = StrConv(Mid(txtSend.Text, j, i - j), vbFromUnicode)
StrCat SendBuf, TempBuf
ReDim TempBuf(0)
TempBuf(0) = CByte(Mid(txtSend.Text, i, 4))
StrCat SendBuf, TempBuf
j = i + 4
Else
TempBuf = StrConv(Mid(txtSend.Text, j), vbFromUnicode)
StrCat SendBuf, TempBuf
End If
Loop While i <> 0
MSComm1.Output = SendBuf
txtSend.Text = ""
'RefreshDisplay SendBuf
Exit Sub
ErrHandler:
MsgBox "写法错误！", vbQuestion
End Sub
Private Sub cmdSet_Click()
dlgSetComm.Show
End Sub
Private Sub cmdSwitch_Click()
IsHexMode = Not IsHexMode
txtReceive.Text = ""
HexPos = 0
RefreshDisplay ReceiveBuffer
End Sub
Private Sub Form_Load()
HexPos = 0
IsHexMode = False
MSComm1.Settings = "9600,n,8,1"
Load dlgSetComm
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unload dlgSetComm
End Sub
Private Sub lblSetting_Click()
frmAbout.Show
End Sub
Private Sub MSComm1_OnComm()
Dim strTemp() As Byte
If MSComm1.CommEvent = comEvReceive Then
strTemp = MSComm1.Input
StrCat ReceiveBuffer, strTemp
If Not cmdSwitch.Enabled Then cmdSwitch.Enabled = True
RefreshDisplay strTemp
End If
End Sub
Private Sub RefreshDisplay(Buf() As Byte)
Dim i As Integer
If IsHexMode Then
For i = LBound(Buf) To UBound(Buf)
If Len(txtReceive.Text) >= 32760 Then Exit For
txtReceive.Text = txtReceive.Text + Hex(Buf(i)) + " "
HexPos = HexPos + 1
If HexPos = 16 Then
HexPos = 0
txtReceive.Text = txtReceive.Text + _
Chr(13) + Chr(10)
End If
Next i
Else
If Len(txtReceive.Text) <= 32760 Then
txtReceive.Text = txtReceive.Text + StrConv(Buf, vbUnicode)
End If
End If
End Sub
Private Sub StrCat(Str1() As Byte, Str2() As Byte)
Str1 = CStr(Str1) & CStr(Str2)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -