📄 mainform.frm
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1
Caption = "状态显示信号灯"
ClientHeight = 4845
ClientLeft = 1215
ClientTop = 585
ClientWidth = 7605
LinkTopic = "Form1"
ScaleHeight = 4845
ScaleWidth = 7605
Begin VB.CommandButton Command2
Caption = "连续读取"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 924
Left = 840
Picture = "Mainform.frx":0000
Style = 1 'Graphical
TabIndex = 12
Top = 3435
Width = 2460
End
Begin VB.Timer Timer1
Left = 120
Top = 30
End
Begin VB.CommandButton Command1
Caption = "清除接收区"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 924
Left = 4200
Picture = "Mainform.frx":0442
Style = 1 'Graphical
TabIndex = 5
Top = 2085
Width = 2412
End
Begin MSCommLib.MSComm Comm1
Left = 30
Top = 510
_ExtentX = 794
_ExtentY = 794
_Version = 393216
CommPort = 2
DTREnable = -1 'True
RThreshold = 1
End
Begin VB.CommandButton CmdExit
Cancel = -1 'True
Caption = "结束"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 876
Left = 4200
Picture = "Mainform.frx":0884
Style = 1 'Graphical
TabIndex = 4
Top = 3435
Width = 2460
End
Begin VB.CommandButton CmdSend
Caption = "发送字符串"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 924
Left = 840
Picture = "Mainform.frx":0CC6
Style = 1 'Graphical
TabIndex = 3
Top = 2130
Width = 2460
End
Begin VB.TextBox txtSend
BeginProperty Font
Name = "Times New Roman"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1500
Left = 705
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Text = "Mainform.frx":0FD0
Top = 360
Width = 2940
End
Begin VB.Label Label2
Caption = "状态-6"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 5
Left = 6360
TabIndex = 11
Top = 1125
Width = 735
End
Begin VB.Label Label2
Caption = "状态-5"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 4
Left = 5310
TabIndex = 10
Top = 1125
Width = 735
End
Begin VB.Label Label2
Caption = "状态-4"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 3
Left = 4440
TabIndex = 9
Top = 1125
Width = 735
End
Begin VB.Label Label2
Caption = "状态-3"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 2
Left = 6420
TabIndex = 8
Top = 360
Width = 735
End
Begin VB.Label Label2
Caption = "状态-2"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 1
Left = 5355
TabIndex = 7
Top = 360
Width = 735
End
Begin VB.Label Label2
Caption = "状态-1"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 0
Left = 4500
TabIndex = 6
Top = 360
Width = 735
End
Begin VB.Shape Shape1
FillStyle = 0 'Solid
Height = 450
Index = 5
Left = 6360
Shape = 3 'Circle
Top = 1365
Width = 630
End
Begin VB.Shape Shape1
FillStyle = 0 'Solid
Height = 450
Index = 4
Left = 5400
Shape = 3 'Circle
Top = 1365
Width = 630
End
Begin VB.Shape Shape1
FillStyle = 0 'Solid
Height = 450
Index = 3
Left = 4395
Shape = 3 'Circle
Top = 1365
Width = 630
End
Begin VB.Shape Shape1
FillStyle = 0 'Solid
Height = 450
Index = 2
Left = 6360
Shape = 3 'Circle
Top = 600
Width = 630
End
Begin VB.Shape Shape1
FillStyle = 0 'Solid
Height = 450
Index = 1
Left = 5355
Shape = 3 'Circle
Top = 600
Width = 630
End
Begin VB.Shape Shape1
FillStyle = 0 'Solid
Height = 450
Index = 0
Left = 4440
Shape = 3 'Circle
Top = 600
Width = 630
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "**状态区**"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Index = 1
Left = 4110
TabIndex = 2
Top = 30
Width = 1200
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "**命令区**"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Index = 0
Left = 795
TabIndex = 1
Top = 75
Width = 1200
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''
'声明一个字符串变量及单精度变量数组
'字符串变量用以存储接收到的字符串
'数组则用以存储处理后的数值数据
''''''''''''''''''''''''''''''''''''''
Dim ReceiveStr$, ReceiveData!(21)
''''''''''''''''''''''''''''''''''''''
'使用命令按钮
'结束系统
'若未执行关闭通信端口的动作，则
'系统结束时，同时也会关闭串行通信端口
''''''''''''''''''''''''''''''''''''''
Private Sub CmdExit_Click()
End
End Sub
''''''''''''''''''''''''''''''''''''''
'使用命令按钮
'将欲发送的字符串利用Output属性送去
''''''''''''''''''''''''''''''''''''''
Private Sub CmdSend_Click()
Comm1.Output = Trim(txtSend.Text)
End Sub
''''''''''''''''''''''''''''''''''''''
'MSComm的OnComm事件程序
'由CommEvent属性值的不同，将各别的程序代码写入
'相关的子程序中。
'在此例中，只要RThresold中的设置字符数到达时
'便会使得CommEvent属性值变成comEvReceive
'因此接收的子程序便被执行；并进行数据的撷取
'再将数据放入数组中，随即将信号灯显示出来
''''''''''''''''''''''''''''''''''''''
Private Sub Comm1_OnComm()
Dim buf$, StrPos%, i%, j%, TempSng!
Select Case Comm1.CommEvent
' 借着取代底下每一个 case 语句来处理每个事件与错误
' 事件
Case comEvCD ' CD 线的状态发生变化.
Case comEvCTS ' CTS 线的状态发生变化.
Case comEvDSR ' DSR 线的状态发生变化.
Case comEvRing ' Ring Indicator 变化.
Case comEvReceive ' 收到 RThreshold # of
buf = Trim(Comm1.Input)
If InStr(1, buf, "!") < 1 Then
ReceiveStr = ReceiveStr + buf
Else
i = 0
Do
StrPos = InStr(1, ReceiveStr, ",")
If StrPos = 0 Then Exit Do
ReceiveData(i) = Val(Left(ReceiveStr, StrPos - 1))
ReceiveStr = Right(ReceiveStr, Len(ReceiveStr) - InStr(1, ReceiveStr, ","))
i = i + 1
Loop
ReceiveStr = ""
End If
j = 0
For i = 0 To 15 Step 3
TempSng = ReceiveData(i) + ReceiveData(i + 1) + ReceiveData(i + 2)
If TempSng > 15# Then
Shape1(j).FillColor = RGB(255, 0, 0)
ElseIf TempSng > 10! Then
Shape1(j).FillColor = RGB(128, 128, 128)
Else
Shape1(j).FillColor = RGB(0, 255, 0)
End If
j = j + 1
Next i
Case comEvSend ' 传输缓冲区有 Sthreshold 个字符 '
End Select
End Sub
''''''''''''''''''''''''''''''''''''''
'使用命令按钮
'不同的数值可以显示出不同的信号灯
'在此是将信号灯全部变成黑色
''''''''''''''''''''''''''''''''''''''
Private Sub Command1_Click()
Dim i%
For i = 0 To 5
Shape1(i).FillColor = RGB(0, 0, 0)
Next i
End Sub
''''''''''''''''''''''''''''''''''''''
'使用命令按钮
'判断用户输入的字符串是否为正确的
'若不正确则跳出此子程序；若正确，则启动定时器
'亦在此子程序设置定时器的间隔及Enabled属性
''''''''''''''''''''''''''''''''''''''
Private Sub Command2_Click()
Dim StrPos%
StrPos = InStr(1, txtSend.Text, "%%")
If StrPos < 1 Then Exit Sub
If UCase(Right(txtSend.Text, Len(txtSend.Text) - StrPos - 1)) <> "DATA" Then Exit Sub
Timer1.Interval = 1000
Timer1.Enabled = True
End Sub
''''''''''''''''''''''''''''''''''''''
'窗体的加载事件
'在此做打开通信端口的动作
'在打开之前，我们也可以将通信参数先行指定后
'然后再打开通信端口
''''''''''''''''''''''''''''''''''''''
Private Sub Form_Load()
Comm1.PortOpen = True
End Sub
''''''''''''''''''''''''''''''''''''''
'定时器的Timer事件
'此事件会在每一个Interval属性的周期被执行一次
'CmdSend_Click事件程序会在每一次Timer事件中被执行
''''''''''''''''''''''''''''''''''''''
Private Sub Timer1_Timer()
CmdSend_Click
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -