📄 vi.frm
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1
Caption = "USBPORT"
ClientHeight = 3270
ClientLeft = 60
ClientTop = 345
ClientWidth = 4815
FillColor = &H00008000&
FillStyle = 0 'Solid
LinkTopic = "Form1"
ScaleHeight = 3270
ScaleWidth = 4815
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command3
Caption = "Reset"
Height = 375
Left = 3360
TabIndex = 2
Top = 1920
Width = 975
End
Begin VB.CommandButton Command2
Caption = "Auto"
Height = 375
Left = 1920
TabIndex = 1
Top = 1920
Width = 975
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 500
Left = 0
Top = 2280
End
Begin VB.CommandButton Command1
Caption = "SendData"
Height = 375
Left = 480
TabIndex = 0
Top = 1920
Width = 975
End
Begin MSCommLib.MSComm MSComm1
Left = 0
Top = 2760
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
InputLen = 2
RThreshold = 2
End
Begin VB.Label Label3
Caption = "eait.cqit.edu.cn"
BeginProperty Font
Name = "华文新魏"
Size = 12
Charset = 134
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 255
Left = 2640
TabIndex = 5
Top = 2880
Width = 3495
End
Begin VB.Label Label2
Caption = "检测与控制技术实验中心"
BeginProperty Font
Name = "华文新魏"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 255
Left = 2160
TabIndex = 4
Top = 2520
Width = 3495
End
Begin VB.Label Label1
Caption = "Data Aquisition System Of UsbPort"
BeginProperty Font
Name = "Times New Roman"
Size = 15
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 615
Left = 120
TabIndex = 3
Top = 360
Width = 4575
End
Begin VB.Shape Shape4
FillColor = &H0000FF00&
FillStyle = 0 'Solid
Height = 495
Left = 3480
Shape = 3 'Circle
Top = 1080
Width = 495
End
Begin VB.Shape Shape3
FillColor = &H0000FF00&
FillStyle = 0 'Solid
Height = 495
Left = 2520
Shape = 3 'Circle
Top = 1080
Width = 495
End
Begin VB.Shape Shape2
FillColor = &H0000FF00&
FillStyle = 0 'Solid
Height = 495
Left = 1560
Shape = 3 'Circle
Top = 1080
Width = 495
End
Begin VB.Shape Shape1
FillColor = &H0000FF00&
FillStyle = 0 'Solid
Height = 495
Left = 600
Shape = 3 'Circle
Top = 1080
Width = 495
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Timer_NUM As Integer
Dim COM1_Inbuffer() As Byte
Dim i As Integer
Dim To_USB(0 To 1) As Byte
Dim Receive_Data(1 To 10) As Integer
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 Sub Command1_Click()
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
End If '如通信端口关闭则打开
i = i + 1
Timer1.Enabled = False
Select Case i:
Case 1:
Shape1.FillColor = vbRed
Shape2.FillColor = vbGreen
Shape3.FillColor = vbGreen
Shape4.FillColor = vbGreen
To_USB(0) = &HFF
To_USB(1) = &H1
MSComm1.Output = To_USB
Case 2:
Shape2.FillColor = vbRed
Shape1.FillColor = vbGreen
Shape3.FillColor = vbGreen
Shape4.FillColor = vbGreen
To_USB(0) = &HFF
To_USB(1) = &H2
MSComm1.Output = To_USB
Case 3:
Shape3.FillColor = vbRed
Shape1.FillColor = vbGreen
Shape2.FillColor = vbGreen
Shape4.FillColor = vbGreen
To_USB(0) = &HFF
To_USB(1) = &H3
MSComm1.Output = To_USB
Case 4:
Shape4.FillColor = vbRed
Shape1.FillColor = vbGreen
Shape2.FillColor = vbGreen
Shape3.FillColor = vbGreen
To_USB(0) = &HFF
To_USB(1) = &H4
MSComm1.Output = To_USB
i = 0
End Select
'MSComm1.Output = To_USB
End Sub
Private Sub Command2_Click()
Timer1.Enabled = True
End Sub
Private Sub Command3_Click()
Shape1.FillColor = vbGreen
Shape2.FillColor = vbGreen
Shape3.FillColor = vbGreen
Shape4.FillColor = vbGreen
Timer1.Enabled = False
Timer_NUM = 0
i = 0
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
End If
To_USB(0) = &HFF
To_USB(1) = &HF0
MSComm1.Output = To_USB
End Sub
Private Sub Form_Load()
MSComm1.CommPort = 1 '通信参数设置
MSComm1.Settings = "9600,N,8,1"
MSComm1.InputLen = 1
MSComm1.InBufferSize = 10240
MSComm1.OutBufferSize = 10
MSComm1.InBufferCount = 0
MSComm1.OutBufferCount = 0
MSComm1.RThreshold = 2
MSComm1.InputMode = comInputModeBinary
MSComm1.PortOpen = True
End Sub
Private Sub Label3_Click()
Call ShellExecute(Form1.hwnd, "open", "http://eait.cqit.edu.cn", vbNullString, vbNullString, &H0)
End Sub
Private Sub MSComm1_OnComm()
Select Case MSComm1.CommEvent
Case comEventOverrun
Case comEvReceive
For i = 1 To 2
COM1_Inbuffer = MSComm1.Input '读取缓冲区数据
Receive_Data(i) = COM1_Inbuffer(0)
Next i
If Receive_Data(1) <> 255 Then Exit Sub
Select Case Receive_Data(2)
Case 1:
Shape1.FillColor = vbRed
Shape2.FillColor = vbGreen
Shape3.FillColor = vbGreen
Shape4.FillColor = vbGreen
Case 2:
Shape1.FillColor = vbGreen
Shape2.FillColor = vbRed
Shape3.FillColor = vbGreen
Shape4.FillColor = vbGreen
Case 3:
Shape1.FillColor = vbGreen
Shape2.FillColor = vbGreen
Shape3.FillColor = vbRed
Shape4.FillColor = vbGreen
Case 4:
Shape1.FillColor = vbGreen
Shape2.FillColor = vbGreen
Shape3.FillColor = vbGreen
Shape4.FillColor = vbRed
End Select
End Select
End Sub
Private Sub Timer1_Timer()
MSComm1.OutBufferCount = 0
Timer_NUM = Timer_NUM + 1
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
End If '如通信端口关闭则打开
Select Case Timer_NUM
Case 1:
Shape1.FillColor = vbRed
Shape2.FillColor = vbGreen
Shape3.FillColor = vbGreen
Shape4.FillColor = vbGreen
To_USB(0) = &HFF
To_USB(1) = &H1
MSComm1.Output = To_USB
Case 2:
Shape2.FillColor = vbRed
Shape1.FillColor = vbGreen
Shape3.FillColor = vbGreen
Shape4.FillColor = vbGreen
To_USB(0) = &HFF
To_USB(1) = &H2
MSComm1.Output = To_USB
Case 3:
Shape3.FillColor = vbRed
Shape1.FillColor = vbGreen
Shape2.FillColor = vbGreen
Shape4.FillColor = vbGreen
To_USB(0) = &HFF
To_USB(1) = &H3
MSComm1.Output = To_USB
Case 4:
Shape4.FillColor = vbRed
Shape1.FillColor = vbGreen
Shape2.FillColor = vbGreen
Shape3.FillColor = vbGreen
To_USB(0) = &HFF
To_USB(1) = &H4
MSComm1.Output = To_USB
Timer_NUM = 0
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -