dlgzldztest.frm

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

                Label7.Caption = "L3L30绕组直流电阻"
            Case " 3"
                Label7.Caption = "L4L40绕组直流电阻"
            Case Else
        End Select
        Label9.Caption = "0.001275±5%"
        
    End If
    Command1.Enabled = True
End Sub

Private Sub Command4_Click()
    If ttrain = "100" Then
        Select Case tobj
            Case " 0"
                byqData(45) = Label1.Caption
                byqData(46) = Label3.Caption
            Case " 1"
                byqData(48) = Label1.Caption
                byqData(49) = Label3.Caption
            Case " 2"
                byqData(51) = Label1.Caption
                byqData(52) = Label3.Caption
            Case " 3"
                byqData(54) = Label1.Caption
                byqData(55) = Label3.Caption
            Case " 4"
                byqData(57) = Label1.Caption
                byqData(58) = Label3.Caption
            Case " 5"
                byqData(60) = Label1.Caption
                byqData(61) = Label3.Caption
            Case " 6"
                byqData(63) = Label1.Caption
                byqData(64) = Label3.Caption
            Case " 7"
                byqData(66) = Label1.Caption
                byqData(67) = Label3.Caption
            Case " 8"
                byqData(69) = Label1.Caption
                byqData(70) = Label3.Caption
            Case " 9"
                byqData(72) = Label1.Caption
                byqData(73) = Label3.Caption
            Case Else
        End Select
    
    ElseIf ttrain = "200" And ttype = "5" Then
        byqData(75) = Label13.Caption
        Select Case tobj
            Case " 0"
                byqData(45) = Label1.Caption
                byqData(46) = Label3.Caption
                byqData(47) = Label5.Caption
            Case " 1"
                byqData(48) = Label1.Caption
                byqData(49) = Label3.Caption
                byqData(50) = Label5.Caption
            Case " 2"
                byqData(51) = Label1.Caption
                byqData(52) = Label3.Caption
                byqData(53) = Label5.Caption
            Case " 3"
                byqData(54) = Label1.Caption
                byqData(55) = Label3.Caption
                byqData(56) = Label5.Caption
            Case " 4"
                byqData(57) = Label1.Caption
                byqData(58) = Label3.Caption
                byqData(59) = Label5.Caption
            Case " 5"
                byqData(60) = Label1.Caption
                byqData(61) = Label3.Caption
                byqData(62) = Label5.Caption
            Case " 6"
                byqData(63) = Label1.Caption
                byqData(64) = Label3.Caption
                byqData(65) = Label5.Caption
            Case " 7"
                byqData(66) = Label1.Caption
                byqData(67) = Label3.Caption
                byqData(68) = Label5.Caption
            Case " 8"
                byqData(69) = Label1.Caption
                byqData(70) = Label3.Caption
                byqData(71) = Label5.Caption
            Case Else
        End Select
    
    ElseIf ttrain = "200" And ttype = "15" Then
        dkqData(11) = Label13.Caption
        Select Case tobj
            Case " 0"
                dkqData(12) = Label1.Caption
                dkqData(13) = Label3.Caption
                dkqData(14) = Label5.Caption
            Case " 1"
                dkqData(15) = Label1.Caption
                dkqData(16) = Label3.Caption
                dkqData(17) = Label5.Caption
            Case " 2"
                dkqData(18) = Label1.Caption
                dkqData(19) = Label3.Caption
                dkqData(20) = Label5.Caption
            Case " 3"
                dkqData(21) = Label1.Caption
                dkqData(22) = Label3.Caption
                dkqData(23) = Label5.Caption
            Case Else
        End Select
        
    ElseIf ttrain = "200" And ttype = "21" Then
        dkqData(78) = Label13.Caption
        Select Case tobj
            Case " 0"
                dkqData(79) = Label1.Caption
                dkqData(80) = Label3.Caption
                dkqData(81) = Label5.Caption
            Case " 1"
                dkqData(82) = Label1.Caption
                dkqData(83) = Label3.Caption
                dkqData(84) = Label5.Caption
            Case " 2"
                dkqData(85) = Label1.Caption
                dkqData(86) = Label3.Caption
                dkqData(87) = Label5.Caption
            Case " 3"
                dkqData(88) = Label1.Caption
                dkqData(89) = Label3.Caption
                dkqData(90) = Label5.Caption
            Case Else
        End Select
    
    ElseIf ttrain = "500" And ttype = "5" Then
        byqData(75) = Label13.Caption
        Select Case tobj
            Case " 0"
                byqData(45) = Label1.Caption
                byqData(46) = Label3.Caption
                dkqData(47) = Label5.Caption
            Case " 1"
                byqData(48) = Label1.Caption
                byqData(49) = Label3.Caption
                dkqData(50) = Label5.Caption
            Case " 2"
                byqData(51) = Label1.Caption
                byqData(52) = Label3.Caption
                dkqData(53) = Label5.Caption
            Case " 3"
                byqData(54) = Label1.Caption
                byqData(55) = Label3.Caption
                dkqData(56) = Label5.Caption
            Case " 4"
                byqData(57) = Label1.Caption
                byqData(58) = Label3.Caption
                dkqData(59) = Label5.Caption
            Case " 5"
                byqData(60) = Label1.Caption
                byqData(61) = Label3.Caption
                dkqData(62) = Label5.Caption
            Case " 6"
                byqData(63) = Label1.Caption
                byqData(64) = Label3.Caption
                dkqData(65) = Label5.Caption
            Case " 7"
                byqData(66) = Label1.Caption
                byqData(67) = Label3.Caption
                dkqData(68) = Label5.Caption
            Case " 8"
                byqData(69) = Label1.Caption
                byqData(70) = Label3.Caption
                dkqData(71) = Label5.Caption
            Case " 9"
                byqData(72) = Label1.Caption
                byqData(73) = Label3.Caption
                dkqData(74) = Label5.Caption
            Case Else
        End Select
        
    ElseIf ttrain = "500" And ttype = "15" Then
        dkqData(11) = Label13.Caption
        Select Case tobj
            Case " 0"
                dkqData(12) = Label1.Caption
                dkqData(13) = Label3.Caption
                dkqData(14) = Label5.Caption
            Case " 1"
                dkqData(15) = Label1.Caption
                dkqData(16) = Label3.Caption
                dkqData(17) = Label5.Caption
            Case " 2"
                dkqData(18) = Label1.Caption
                dkqData(19) = Label3.Caption
                dkqData(20) = Label5.Caption
            Case " 3"
                dkqData(21) = Label1.Caption
                dkqData(22) = Label3.Caption
                dkqData(23) = Label5.Caption
            Case " 4"
                dkqData(24) = Label1.Caption
                dkqData(25) = Label3.Caption
                dkqData(26) = Label5.Caption
            Case " 5"
                dkqData(27) = Label1.Caption
                dkqData(28) = Label3.Caption
                dkqData(29) = Label5.Caption
            Case Else
        End Select
        
    ElseIf ttrain = "500" And ttype = "19" Then
        dkqData(78) = Label13.Caption
        Select Case tobj
            Case " 0"
                dkqData(79) = Label1.Caption
                dkqData(80) = Label3.Caption
                dkqData(81) = Label5.Caption
            Case " 1"
                dkqData(82) = Label1.Caption
                dkqData(83) = Label3.Caption
                dkqData(84) = Label5.Caption
            Case Else
        End Select
    
    ElseIf ttrain = "500" And ttype = "24" Then
        dkqData(145) = Label13.Caption
        Select Case tobj
            Case " 0"
                dkqData(146) = Label1.Caption
                dkqData(147) = Label3.Caption
                dkqData(148) = Label5.Caption
            Case " 1"
                dkqData(149) = Label1.Caption
                dkqData(150) = Label3.Caption
                dkqData(151) = Label5.Caption
            Case " 2"
                dkqData(152) = Label1.Caption
                dkqData(153) = Label3.Caption
                dkqData(154) = Label5.Caption
            Case " 3"
                dkqData(155) = Label1.Caption
                dkqData(156) = Label3.Caption
                dkqData(157) = Label5.Caption
            Case Else
        End Select
    
    End If
    Command2.Enabled = True
End Sub

Private Sub Form_Load()
    On Error GoTo ErrHandler
    If Not MSComm1(0).PortOpen Then
        MSComm1(0).PortOpen = True
    End If
    Timer1.Enabled = True
    If ttype = "20" Then
        Command3.Enabled = False
        Label7.Caption = "绕组直流电阻"
        Label9.Caption = "0.02062±5%"
    End If
    Exit Sub
ErrHandler:
    Select Case Err.Number
        Case Else
            MsgBox "错误号: " & Err.Number
            Err.Clear
            Exit Sub
    End Select
    Resume
End Sub

Private Sub MSComm1_OnComm(Index As Integer)
    Timer1.Enabled = False
    Dim bytInput() As Byte
    Dim intInputLen As Integer

    If strHex(0) = "AA" Then
        If Not Command1.Enabled Then
            Command3.Enabled = True
            Label11.Caption = "设备已连接"
        End If
    End If
    
    If strHex(0) <> "AA" And strHex(0) <> "FF" Then
        Recordcount = Recordcount + 1
    End If
    
    Select Case MSComm1(Index).CommEvent
        
        Case comEvReceive
                If Not MSComm1(Index).PortOpen Then
                    strSet = "9600,n,8,1"
                '    frmMain.MSComm1(Index).commPort = intPort
                    MSComm1(Index).Settings = strSet
                    MSComm1(Index).PortOpen = True
                End If
                
                '此处添加处理接收的代码
                strHex(Index) = ""
                strAscii(Index) = ""
                
                MSComm1(Index).InputMode = comInputModeBinary
                intInputLen = MSComm1(Index).InBufferCount
                ReDim bytInput(intInputLen)
                bytInput = MSComm1(Index).Input
                Call InputManage(bytInput, intInputLen)
                Call GetReceiveText(Index)
                Call InputManageTotal(bytInput, intInputLen)
                Call GetReceiveTextTotal(Index)
                
                If Index = 0 Then
                    If Recordcount > 2 Then
                        strRFinal = ""
                        Dim x As Long
                        x = InStr(1, strHexAll(0), "57", vbTextCompare)
                        If x <> 0 And x >= 14 Then
                            strRTemp = Mid(strHexAll(0), x - 14, 14)
                            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)
                            strTemp = Mid(strRTemp, 11, 2)
                            strRFinal = strRFinal + BCDtoString(strTemp, False)
                         '   strTemp = Mid(strRTemp, 13, 2)
                         '   strRFinal = strRFinal + BCDtoString(strTemp, True)
                            Label1.Caption = strRFinal
                            If Label13.Caption <> "" Then
                                Dim R75
                                Dim R
                                R75 = Round(Val(strRFinal) * 310 / (1000 * (235 + Val(Label13.Caption))), 6)
                                Label3.Caption = R75
                                If R75 >= Val(Label9.Caption) * 0.95 And R75 <= Val(Label9.Caption) * 1.05 Then
                                    Label5.Caption = "合格"
                                Else
                                    Label5.Caption = "不合格"
                                End If
                                Command4.Enabled = True
                            End If
                            Recordcount = 0
                            intReceiveLenAll = 0
                        End If
                    End If
                ElseIf Index = 1 Then
                    x = InStr(1, strHexAll(Index), "0A", vbTextCompare)
                    Dim Y As Integer
                    Dim strMonitorVal As String
                    Y = x / 2
                    If Y <> 0 And Y >= 6 Then
                        strMonitorVal = Mid(strAsciiAll(Index), Y - 7, 7)
                        Label13.Caption = Val(strMonitorVal)
                        Recordcount = 0
                        intReceiveLenAll = 0
                    End If
                End If
                
                Debug.Print Index & ":    " & strHex(Index)
                Debug.Print Index & ":    " & strAscii(Index)
    End Select
    Timer1.Enabled = True
End Sub

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(Index).PortOpen Then
             MSComm1(Index).PortOpen = True
            MSComm1(Index).Output = bytSendByte()
 '           frmMain.MSComm1(commPort).PortOpen = False
        Else
            MSComm1(Index).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(Index).commPort & "不存在，请检查！", vbOKOnly, "警告"
        Err.Clear
        Unload frmProcessing
        Exit Sub
      Case Else
        MsgBox "未知错误", vbOKOnly, "警告"
        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

Private Sub Timer1_Timer()
    Call controlCommand1("580A", 1)
End Sub