dlgyjyqdtesttype.frm

电力机车牵引变压器试验站总控程序

      Width           =   1455
   End
   Begin VB.Label Label2 
      Alignment       =   2  'Center
      Caption         =   "7"
      Height          =   255
      Index           =   7
      Left            =   6240
      TabIndex        =   3
      Top             =   4440
      Width           =   1455
   End
End
Attribute VB_Name = "dlgYJYQDTesttype"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim strRTemp As String
Dim strRFinal As String
Dim Recordcount As Integer
Dim testTimes As Integer
Dim nowtestCount As Integer
Dim strCommand As String
Option Explicit

Private Sub Command1_Click()
    Call controlCommand1(strCommand, 0)
    Dim x As Integer
    For x = 0 To 7
        Label2(x).Caption = ""
    Next
End Sub

Private Sub Command2_Click()
    Call controlCommand1("0D", 0)
End Sub

Private Sub Command3_Click()
    If MSComm1.PortOpen Then
        MSComm1.PortOpen = False
    End If
    Unload Me
End Sub

Private Sub Command4_Click()
    If ttrain = "100" And ttype = "7" Then
        byqData(107) = Label2(1).Caption
        byqData(108) = Label2(2).Caption
        byqData(109) = Label2(3).Caption
        byqData(110) = Label2(4).Caption
        byqData(111) = Label2(5).Caption
        byqData(113) = Label2(6).Caption
        byqData(114) = Label2(7).Caption
        
    ElseIf ttrain = "200" And ttype = "7" Then
        byqData(107) = Label2(1).Caption
        byqData(108) = Label2(2).Caption
        byqData(109) = Label2(3).Caption
        byqData(110) = Label2(4).Caption
        byqData(111) = Label2(5).Caption
        byqData(113) = Label2(6).Caption
        byqData(114) = Label2(7).Caption
        
    ElseIf ttrain = "500" And ttype = "7" Then
        byqData(107) = Label2(0).Caption
        byqData(108) = Label2(1).Caption
        byqData(109) = Label2(2).Caption
        byqData(110) = Label2(3).Caption
        byqData(111) = Label2(4).Caption
        byqData(112) = Label2(5).Caption
        byqData(113) = Label2(6).Caption
        byqData(114) = Label2(7).Caption
    
    End If
    
End Sub

Private Sub Form_Load()
    On Error GoTo ErrHandler
    MSComm1.PortOpen = True
    If ttrain = "100" Then
        Label2(0).Caption = byqData(107)
        Label2(1).Caption = byqData(108)
        Label2(2).Caption = byqData(109)
        Label2(3).Caption = byqData(110)
        Label2(4).Caption = byqData(111)
        Label2(5).Caption = byqData(112)
        Label2(6).Caption = byqData(113)
        Label2(7).Caption = byqData(114)
    End If
    Exit Sub
ErrHandler:
   Select Case Err.Number
      Case 8005
        MsgBox "串口3已被占用，请检查！", vbOKOnly, "警告"
        Err.Clear
        Exit Sub
      Case 8002
        MsgBox "串口3不存在，请检查！", vbOKOnly, "警告"
        Err.Clear
        Exit Sub
      Case Else
        MsgBox "未知错误", vbOKOnly, "警告"
        Err.Clear
        Exit Sub
   End Select
   Resume
End Sub

Private Sub MSComm1_OnComm()
    On Error GoTo ErrHandler
    Dim bytInput() As Byte
    Dim intInputLen As Integer
    Dim Index As Integer
    Index = 3
    Select Case MSComm1.CommEvent
        
        Case comEvReceive
                If Not MSComm1.PortOpen Then
                    strSet = "9600,n,8,1"
                '    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 strHex(Index) = "AA" Then
                    Label1.Caption = "设备已连接"
                End If
    
                If strHex(Index) <> "AA" And strHex(Index) <> "FF" Then
                    Recordcount = Recordcount + 1
                End If
                
                If strHex(Index) = "11" Then
                    Label1.Caption = "正在升压"
                ElseIf strHex(Index) = "12" Then
                    Label1.Caption = "调压器正在回复"
                ElseIf strHex(Index) = "13" Then
                    Label1.Caption = "正在静置"
                ElseIf strHex(Index) = "14" Then
                    Label1.Caption = "正在搅拌"
                ElseIf strHex(Index) = "15" Then
                    Label1.Caption = "测试完毕"
                ElseIf strHex(Index) = "16" Then
                    Label1.Caption = "过压保护"
                ElseIf strHex(Index) = "17" Then
                    Label1.Caption = "调压器已经恢复"
                ElseIf strHex(Index) = "18" Then
                    Label1.Caption = "显示电压"
                End If
                    
                If Recordcount > 2 Then
                    strRFinal = ""
                    Dim x As Long
                    Dim Y As Long
                    Y = Len(strHexAll(Index))
                    x = InStr(Y - 12, strHexAll(Index), "18", vbTextCompare)
                    If x <> 0 And Y > x + 10 Then
                        strRTemp = Mid(strHexAll(Index), x + 2, 10)
                        Dim strTemp As String
                        strTemp = Left(strRTemp, 2)
                        strRFinal = strRFinal + BCDtoString(strTemp, False)
                        strTemp = Mid(strRTemp, 3, 2)
                        strRFinal = strRFinal + BCDtoString(strTemp, False)
                        strTemp = Mid(strRTemp, 5, 2)
                        strRFinal = strRFinal + "." + BCDtoString(strTemp, False)
                        strTemp = Mid(strRTemp, 7, 2)
                        strRFinal = strRFinal + BCDtoString(strTemp, False)
                        strTemp = Mid(strRTemp, 9, 2)
                        strRFinal = strRFinal + BCDtoString(strTemp, False)
                        
                        Label2(nowtestCount).Caption = strRFinal
                        nowtestCount = nowtestCount + 1
                    End If
                    x = 0
                    x = InStr(1, strHexAll(Index), "15", vbTextCompare)
                    If x <> 0 And Y > x + 10 * (testTimes + 2) Then
                        strRTemp = Mid(strHexAll(Index), x + 2 + 10 * (testTimes + 1), 10)
                        strTemp = Left(strRTemp, 2)
                        strRFinal = strRFinal + BCDtoString(strTemp, False)
                        strTemp = Mid(strRTemp, 3, 2)
                        strRFinal = strRFinal + BCDtoString(strTemp, False)
                        strTemp = Mid(strRTemp, 5, 2)
                        strRFinal = strRFinal + BCDtoString(strTemp, False)
                        strTemp = Mid(strRTemp, 7, 2)
                        strRFinal = strRFinal + "." + BCDtoString(strTemp, False)
                        strTemp = Mid(strRTemp, 9, 2)
                        strRFinal = strRFinal + BCDtoString(strTemp, False)
                        Dim intR As Integer
                        intR = Round((Val(Label2(1).Caption) + Val(Label2(2).Caption) + Val(Label2(3).Caption) + Val(Label2(4).Caption) + Val(Label2(5).Caption)) / (testTimes - 1), 3)
                        Label2(6).Caption = intR
                        If Val(Label2(6)) > 40 Then
                            Label2(7).Caption = "合格"
                        Else
                            Label2(7).Caption = "不合格"
                        End If
                        
                        Recordcount = 0
                        intReceiveLenAll = 0
                    End If
                End If
                Debug.Print Index & ":    " & strHex(Index)
                Debug.Print Index & ":    " & strAscii(Index)
    End Select
    Exit Sub
ErrHandler:
    Select Case Err.Number
        Case Else
            MsgBox Err.Number
            Err.Clear
            Exit Sub
    End Select
Resume
End Sub

Function BCDtoString(str As String, isSign As Boolean) As String
    If Not isSign Then
        If str = "00" Then
            BCDtoString = "0"
        ElseIf str = "01" Then
            BCDtoString = "1"
        ElseIf str = "02" Then
            BCDtoString = "2"
        ElseIf str = "03" Then
            BCDtoString = "3"
        ElseIf str = "04" Then
            BCDtoString = "4"
        ElseIf str = "05" Then
            BCDtoString = "5"
        ElseIf str = "06" Then
            BCDtoString = "6"
        ElseIf str = "07" Then
            BCDtoString = "7"
        ElseIf str = "08" Then
            BCDtoString = "8"
        ElseIf str = "09" Then
            BCDtoString = "9"
        ElseIf str = "0D" Then
            BCDtoString = "."
        End If
    ElseIf isSign Then
        If str = "01" Then
            BCDtoString = "欧姆"
        ElseIf str = "02" Then
            BCDtoString = "毫欧"
        End If
    End If
End Function

Sub controlCommand1(ByVal strCommand As String, ByVal Index As Integer)
    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
        Exit Sub
      Case 8002
        MsgBox "串口" & MSComm1.commPort & "不存在，请检查！", vbOKOnly, "警告"
        Err.Clear
        Unload frmProcessing
        Exit Sub
      Case Else
        MsgBox "未知错误", vbOKOnly, "警告"
        Err.Clear
        Exit Sub
   End Select
   Resume
End Sub

Private Sub Option1_Click(Index As Integer)
    If Index = 0 Then
        strCommand = "09"
        testTimes = 6
        nowtestCount = 0
    ElseIf Index = 1 Then
        strCommand = "0A"
        testTimes = 6
        nowtestCount = 0
    ElseIf Index = 2 Then
        strCommand = "0B0203010101"
        testTimes = 2
        nowtestCount = 0
    End If
End Sub