📄 dlgqybtest.frm
字号:
Begin VB.Label Label1
Caption = "制造厂家："
Height = 255
Index = 13
Left = 6840
TabIndex = 21
Top = 5040
Width = 1215
End
Begin VB.Label Label1
Caption = "潜油泵编号："
Height = 255
Index = 12
Left = 6840
TabIndex = 20
Top = 4560
Width = 1215
End
Begin VB.Label Label1
Caption = "潜油泵"
Height = 255
Index = 11
Left = 5400
TabIndex = 19
Top = 5280
Width = 615
End
Begin VB.Label Label1
Caption = "制造厂家："
Height = 255
Index = 10
Left = 6840
TabIndex = 18
Top = 3120
Width = 1215
End
Begin VB.Label Label1
Caption = "通风机编号："
Height = 255
Index = 9
Left = 6840
TabIndex = 17
Top = 2640
Width = 1215
End
Begin VB.Label Label1
Caption = "风机转向正确,运转10min,工作应正常"
Height = 255
Index = 8
Left = 6840
TabIndex = 16
Top = 2160
Width = 3015
End
Begin VB.Label Label1
Caption = "通风机"
Height = 255
Index = 7
Left = 5400
TabIndex = 15
Top = 2640
Width = 615
End
Begin VB.Label Label1
Caption = "油流继电器作用良好"
Height = 255
Index = 6
Left = 6840
TabIndex = 14
Top = 1680
Width = 3135
End
Begin VB.Label Label1
Caption = "油流继电器作用情况"
Height = 255
Index = 5
Left = 4920
TabIndex = 13
Top = 1680
Width = 1695
End
Begin VB.Label Label1
Caption = "起动油泵1小时,各密封部位无渗油现象,转向符合泵体上的指示标记"
Height = 435
Index = 4
Left = 6840
TabIndex = 12
Top = 1080
Width = 3300
End
Begin VB.Label Label1
Caption = "运行要求"
Height = 255
Index = 3
Left = 5280
TabIndex = 11
Top = 1200
Width = 735
End
Begin VB.Label Label1
Caption = "结 果"
Height = 255
Index = 2
Left = 10680
TabIndex = 10
Top = 600
Width = 495
End
Begin VB.Line Line11
X1 = 10200
X2 = 10200
Y1 = 480
Y2 = 2520
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "质 量 标 准"
Height = 195
Index = 1
Left = 8040
TabIndex = 9
Top = 600
Width = 1035
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "检 查 项 目"
Height = 195
Index = 0
Left = 5280
TabIndex = 8
Top = 600
Width = 990
End
Begin VB.Line Line10
X1 = 6720
X2 = 6720
Y1 = 480
Y2 = 6360
End
Begin VB.Line Line9
X1 = 6720
X2 = 11640
Y1 = 5880
Y2 = 5880
End
Begin VB.Line Line8
X1 = 6720
X2 = 11640
Y1 = 5400
Y2 = 5400
End
Begin VB.Line Line7
X1 = 6720
X2 = 11640
Y1 = 4920
Y2 = 4920
End
Begin VB.Line Line6
X1 = 4800
X2 = 11640
Y1 = 3480
Y2 = 3480
End
Begin VB.Line Line5
X1 = 6720
X2 = 11640
Y1 = 3000
Y2 = 3000
End
Begin VB.Line Line4
X1 = 6720
X2 = 11640
Y1 = 2520
Y2 = 2520
End
Begin VB.Line Line3
X1 = 4800
X2 = 11640
Y1 = 2040
Y2 = 2040
End
Begin VB.Line Line2
X1 = 4800
X2 = 11640
Y1 = 1560
Y2 = 1560
End
Begin VB.Line Line1
X1 = 4800
X2 = 11640
Y1 = 960
Y2 = 960
End
Begin VB.Shape Shape1
Height = 5895
Left = 4800
Top = 480
Width = 6855
End
End
Attribute VB_Name = "dlgQYBtest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim strMonitorVal As String
Dim strNowDevice As String
Dim nowDevice As Integer
Dim Recordcount As Integer
Option Explicit
Private Sub Command1_Click()
Call controlCommand(QYB_ROLL, 0)
Command2.Enabled = False
Command1.Enabled = False
nowDevice = 0
strNowDevice = strInstrument(nowDevice)
Timer1.Interval = 100
Timer1.Enabled = True
End Sub
Private Sub Command2_Click()
Call controlCommand(QYB_VICE_ROLL, 0)
Command2.Enabled = False
Command1.Enabled = False
nowDevice = 0
strNowDevice = strInstrument(nowDevice)
Timer1.Interval = 100
Timer1.Enabled = True
End Sub
Private Sub Command3_Click()
Call controlCommand(QYB_STOP, 0)
Command2.Enabled = True
Command1.Enabled = True
Timer1.Interval = 100
Timer1.Enabled = True
End Sub
Private Sub Command4_Click()
If ttrain = "100" Then
Dim x As Integer
For x = 0 To 2
If Check1(x) = 1 Then
byqData(145 + x) = "合格"
ElseIf Check1(x) = 0 Then
byqData(145 + x) = "不合格"
Else
byqData(145 + x) = ""
End If
Next
byqData(148) = Text1(0).Text
byqData(149) = Text1(1).Text
byqData(152) = Text1(2).Text
byqData(153) = Text1(3).Text
byqData(154) = Label2(0).Caption
byqData(155) = Label2(1).Caption
ElseIf ttrain = "200" Then
For x = 0 To 1
If Check1(x) = 1 Then
byqData(145 + x) = "合格"
ElseIf Check1(x) = 0 Then
byqData(145 + x) = "不合格"
Else
byqData(145 + x) = ""
End If
Next
byqData(147) = Text1(0).Text
byqData(148) = Text1(1).Text
byqData(150) = Text1(4).Text
byqData(151) = Text1(5).Text
byqData(152) = Text1(2).Text
byqData(153) = Text1(3).Text
byqData(154) = Label2(0).Caption
byqData(155) = Label2(1).Caption
End If
End Sub
Private Sub Command5_Click()
Unload Me
End Sub
Private Sub Form_Load()
strInstrument(0) = QYB_CURRENT_A
strInstrument(1) = QYB_CURRENT_B
strInstrument(2) = QYB_CURRENT_C
strInstrument(3) = QYB_POWER
If ttrain = "100" Then
Text1(4).Enabled = False
Text1(5).Enabled = False
ElseIf ttrain = "200" Then
Check1(2).Enabled = False
End If
End Sub
Private Sub MSComm1_OnComm()
Timer1.Enabled = False
Dim bytInput() As Byte
Dim intInputLen As Integer
Dim Index As Integer
Index = 3
Recordcount = Recordcount + 1
Select Case MSComm1.CommEvent
Case comEvReceive
If Not MSComm1.PortOpen Then
strSet = "4800,n,8,2"
' frmMain.MSComm1(Index).commPort = intPort
MSComm1.Settings = strSet
MSComm1.PortOpen = True
End If
'此处添加处理接收的代码
strHex(Index) = ""
strAscii(Index) = ""
MSComm1.InputMode = comInputModeBinary
intInputLen = MSComm1.InBufferCount
ReDim bytInput(intInputLen)
bytInput = MSComm1.Input
Call InputManage(bytInput, intInputLen)
Call GetReceiveText(Index)
Call InputManageTotal(bytInput, intInputLen)
Call GetReceiveTextTotal(Index)
If Recordcount > 0 Then
strMonitorVal = ""
Dim n As Integer
n = InStr(1, strHexAll(3), "0A", vbTextCompare)
Dim y As Integer
y = Int(n / 2) + 1
If y > 7 Then
strMonitorVal = Mid(strAsciiAll(3), y - 7, 7)
Recordcount = 0
intReceiveLenAll = 0
Else
strMonitorVal = Mid(strAsciiAll(3), y + 1, y + 7)
intReceiveLenAll = 0
Recordcount = 0
End If
End If
If strMonitorVal <> "" And strHex(Index) <> "202020202020200A" Then
If Abs(Val(strMonitorVal)) <= ProgressBar1(nowDevice).Max Then
ProgressBar1(nowDevice).Value = Abs(Val(strMonitorVal))
End If
Label4(nowDevice).Caption = numPatternChange(ProgressBar1(nowDevice).Value)
If Label4(0).Caption <> "" And Label4(1).Caption <> "" And Label4(2).Caption <> "" And Label4(3).Caption <> "" Then
Label2(0).Caption = numPatternChange(Round((Val(Label4(0).Caption) + Val(Label4(1).Caption) + Val(Label4(2).Caption)) / 3, 3))
Label2(1).Caption = numPatternChange(Label4(3).Caption)
End If
If nowDevice = 3 Then
nowDevice = 0
Else
nowDevice = nowDevice + 1
End If
strNowDevice = strInstrument(nowDevice)
End If
strMonitorVal = ""
strMonitorVal = ""
Debug.Print Index & ": " & strAscii(Index)
Debug.Print Index & ": " & strHex(Index)
Debug.Print Index & ": " & strMonitorVal
End Select
Timer1.Enabled = True
End Sub
Private Sub Timer1_Timer()
Call controlCommand1(strNowDevice)
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -