📄 dlgbbzbtest.frm
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form dlgBBZBTest
BorderStyle = 3 'Fixed Dialog
Caption = "Dialog Caption"
ClientHeight = 4005
ClientLeft = 2760
ClientTop = 3750
ClientWidth = 7380
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4005
ScaleWidth = 7380
ShowInTaskbar = 0 'False
Begin VB.Timer Timer2
Enabled = 0 'False
Interval = 800
Left = 0
Top = 1080
End
Begin VB.CommandButton Command6
Caption = "退 出"
Height = 495
Left = 4440
TabIndex = 15
Top = 3000
Width = 1215
End
Begin VB.CommandButton Command5
Caption = "保存数据"
Enabled = 0 'False
Height = 495
Left = 3000
TabIndex = 13
Top = 3000
Width = 1215
End
Begin VB.CommandButton Command4
Caption = "试验序号选择"
Enabled = 0 'False
Height = 495
Left = 1560
TabIndex = 12
Top = 3000
Width = 1215
End
Begin VB.Timer Timer1
Interval = 50
Left = 0
Top = 600
End
Begin MSCommLib.MSComm MSComm1
Left = 0
Top = 0
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
CommPort = 8
DTREnable = -1 'True
RThreshold = 64
InputMode = 1
End
Begin VB.CommandButton Command3
Caption = "断开设备"
Enabled = 0 'False
Height = 495
Left = 4440
TabIndex = 2
Top = 2280
Width = 1215
End
Begin VB.CommandButton Command2
Caption = "变比测试"
Enabled = 0 'False
Height = 495
Left = 3000
TabIndex = 1
Top = 2280
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "连接设备"
Enabled = 0 'False
Height = 495
Left = 1560
TabIndex = 0
Top = 2280
Width = 1215
End
Begin VB.Label Label3
Caption = "状态: "
Height = 375
Left = 840
TabIndex = 14
Top = 240
Width = 495
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "Label2"
Height = 195
Index = 7
Left = 5880
TabIndex = 11
Top = 1440
Width = 480
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "Label2"
Height = 195
Index = 6
Left = 4080
TabIndex = 10
Top = 1440
Width = 480
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "Label2"
Height = 195
Index = 5
Left = 2400
TabIndex = 9
Top = 1440
Width = 480
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "Label2"
Height = 195
Index = 4
Left = 840
TabIndex = 8
Top = 1440
Width = 480
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "结 果"
Height = 195
Index = 3
Left = 5880
TabIndex = 7
Top = 840
Width = 585
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "实 测"
Height = 195
Index = 2
Left = 4320
TabIndex = 6
Top = 840
Width = 585
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "质 量 标 准"
Height = 195
Index = 1
Left = 2400
TabIndex = 5
Top = 840
Width = 1035
End
Begin VB.Line Line4
X1 = 5520
X2 = 5520
Y1 = 720
Y2 = 1800
End
Begin VB.Line Line3
X1 = 3720
X2 = 3720
Y1 = 720
Y2 = 1800
End
Begin VB.Line Line2
X1 = 2040
X2 = 2040
Y1 = 720
Y2 = 1800
End
Begin VB.Line Line1
X1 = 600
X2 = 6960
Y1 = 1200
Y2 = 1200
End
Begin VB.Shape Shape1
Height = 1095
Left = 600
Top = 720
Width = 6375
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "检 查 项 目"
Height = 195
Index = 0
Left = 840
TabIndex = 4
Top = 840
Width = 990
End
Begin VB.Label Label1
Height = 375
Left = 1320
TabIndex = 3
Top = 240
Width = 2055
End
End
Attribute VB_Name = "dlgBBZBTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Recordcount As Integer
Dim strCommand As String
Option Explicit
Private Sub Command1_Click()
strCommand = "7EE7030060000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002D03E77E"
Timer1.Enabled = True
End Sub
Sub controlCommand1(ByVal strCommand As String)
On Error GoTo ErrorHandler
Dim strTemp As String
strTemp = strCommand
Dim longth As Integer
longth = strHexToByteArray(strTemp, bytSendByte())
If longth <> 0 Then
If Not MSComm1.PortOpen Then
MSComm1.PortOpen = True
MSComm1.Output = bytSendByte()
' frmMain.MSComm1(commPort).PortOpen = False
Else
MSComm1.Output = bytSendByte()
' frmMain.MSComm1(commPort).PortOpen = False
End If
End If
Exit Sub
ErrorHandler:
Select Case Err.Number
Case 8005
MsgBox "串口3已被占用，请检查！", vbOKOnly, "警告"
Err.Clear
Timer1.Enabled = False
Exit Sub
Case 8002
MsgBox "串口" & MSComm1.commPort & "不存在，请检查！", vbOKOnly, "警告"
Err.Clear
Timer1.Enabled = False
Exit Sub
Case Else
MsgBox "未知错误", vbOKOnly, "警告"
Err.Clear
Exit Sub
End Select
Resume
End Sub
Function HextoAscii(str As String) As String
Dim length As Integer
Dim strTemp As String
length = Len(str)
Dim i As Integer
For i = 1 To length - 2 Step 2
strTemp = Mid(str, i, 2)
Select Case strTemp
Case "30"
HextoAscii = HextoAscii + "0"
Case "31"
HextoAscii = HextoAscii + "1"
Case "32"
HextoAscii = HextoAscii + "2"
Case "33"
HextoAscii = HextoAscii + "3"
Case "34"
HextoAscii = HextoAscii + "4"
Case "35"
HextoAscii = HextoAscii + "5"
Case "36"
HextoAscii = HextoAscii + "6"
Case "37"
HextoAscii = HextoAscii + "7"
Case "38"
HextoAscii = HextoAscii + "8"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -