form1.frm

开关电源监控系统 485总线远距离控制 采用VB控件编程方式 远距离

        Exit Sub
    End If
    
    If adropen = False Then
        MsgBox "你没有选择要设置的从机地址，请选择要设置的从机地址", vbOKOnly & vbInformation, "提示"
        Exit Sub
    End If
    
    If Text19.Text = "" Or Text20.Text = "" Then
        MsgBox "你没有输入调整值", vbOKOnly & vbInformation, "提示"
        Exit Sub
    End If
    
    Timer1.Enabled = False
    Timer2.Enabled = False
    Timer3.Enabled = False
    Timer4.Enabled = False
    
    Text21.Text = Format$(Val(Text19.Text) / Val(Text20.Text), "0.000")
    string1 = Hex$(Val(Text21.Text) * 1000)
    
    If Text21.Text = "" Then
        MsgBox "你没有输入调整值", vbOKOnly & vbInformation, "提示"
        Exit Sub
    End If
    
    If Len(string1) <> 3 Then
        MsgBox "你输入的调整值不符合要求，请重新输入！", vbOKOnly & vbInformation, "提示"
        Exit Sub
    End If
    x = Val("&h" & (Left$(string1, 1)))
    y = Val("&h" & (Right$(string1, 2)))
    Text22.Text = string1
    
    MSComm1.InputMode = comInputModeBinary
    First_chr(0) = &H5E
    First_chr(1) = &H10
    First_chr(2) = Val(Trim("&H" & setadr.Text))
    First_chr(3) = &HB2
    First_chr(4) = &HD0
    First_chr(5) = &H3
    
    If Combo1.Text = "请选择调整的类型" Then
        MsgBox "你没有选择调整的类型！", vbOKOnly & vbInformation, "提示"
        Exit Sub
    End If
    If Combo1.Text = "输入交流电压" Then
        First_chr(6) = &HA0
    End If
    If Combo1.Text = "输出直流电压" Then
        First_chr(6) = &HA2
    End If
    If Combo1.Text = "输出电流一路" Then
        First_chr(6) = &HA4
    End If
    If Combo1.Text = "输出电流二路" Then
        First_chr(6) = &HA6
    End If
    If Combo1.Text = "输出电流三路" Then
        First_chr(6) = &HA8
    End If
    First_chr(7) = x
    First_chr(8) = y
    
    For n = 1 To 8
        k = k + First_chr(n)
        If k > 255 Then
            k = k - 256
        End If
    Next n
    First_chr(9) = Val("&H" & Hex$(k))
    k = Not First_chr(9)
    k = k + 1
    First_chr(10) = Val("&H" & Hex$(k))
    
    First_chr(11) = &HD
    send.Text = ""
    For i = 0 To 11
    j = Hex$(First_chr(i))
    If Len(j) = 1 Then
        j = "0" & j
    End If
    send.Text = send.Text & j
    Next i
    vsend = First_chr()
    Call SendData(First_chr)
End Sub

'--------------------------------------------------------------------
'设置直流输出电压的按钮
'--------------------------------------------------------------------
Private Sub Command5_Click()
    Dim First_chr(0 To 13) As Byte
    Dim vsend   As Variant
    Dim i   As Integer
    Dim j   As String
    Dim top As String
    Dim bellow As String
    Dim top1    As String
    Dim bellow1 As String
    Dim k   As Integer
    Dim n   As Integer
    
    Timer1.Enabled = False
    Timer2.Enabled = False
    Timer3.Enabled = False
    Timer4.Enabled = False
    
    If st.Enabled = True Then
        MsgBox "串口没打开", vbOKOnly & vbInformation, "提示打开串口"
        Exit Sub
    End If
    If adropen = False Then
        MsgBox "你没有选择要设置的从机地址，请选择要设置的从机地址", vbOKOnly & vbInformation, "提示"
        Exit Sub
    End If
    If acinputb.Text = "" Then
        MsgBox "你没有选择直流电压的下限", vbOKOnly & vbInformation, "提示"
        Exit Sub
    End If
    If acinputtop.Text = "" Then
        MsgBox "你没有选择直流电压的上限", vbOKOnly & vbInformation, "提示"
        Exit Sub
    End If
    top = "0" & Left$(dcouttop.Text, 1)
    top1 = Right$(dcouttop.Text, 1) & "0"
    
    bellow = "0" & Left$(dcoutb.Text, 1)
    bellow1 = Right$(dcoutb.Text, 1) & "0"
    
    MSComm1.InputMode = comInputModeBinary
    First_chr(0) = &H5E
    First_chr(1) = &H10
    First_chr(2) = Val(Trim("&H" & setadr.Text))
    First_chr(3) = &HB2
    First_chr(4) = &HB0
    First_chr(5) = &H5
    First_chr(6) = &H8E
    First_chr(7) = Val(Trim("&H" & top))
    First_chr(8) = Val(Trim("&H" & top1))
    First_chr(9) = Val(Trim("&H" & bellow))
    First_chr(10) = Val(Trim("&H" & bellow1))
    
    For n = 1 To 10
        k = k + First_chr(n)
        If k > 255 Then
            k = k - 256
        End If
    Next n
    First_chr(11) = Val("&H" & Hex$(k))
    k = Not First_chr(11)
    k = k + 1
    First_chr(12) = Val("&H" & Hex$(k))
    
    First_chr(13) = &HD
    send.Text = ""
    For i = 0 To 13
    j = Hex$(First_chr(i))
    If Len(j) = 1 Then
        j = "0" & j
    End If
    send.Text = send & j
    Next i
    vsend = First_chr()
    Call SendData(First_chr)
End Sub

'--------------------------------------------------------------------
'清除存储参数
'--------------------------------------------------------------------
Private Sub Command6_Click()
    Dim First_chr(0 To 10) As Byte
    Dim vsend   As Variant
    Dim n As Integer
    Dim k As Integer
    Dim t As Byte
    Dim i   As Integer
    Dim j   As String

    Timer1.Enabled = False
    Timer2.Enabled = False
    Timer3.Enabled = False
    Timer4.Enabled = False
    
    If st.Enabled = True Then
        MsgBox "串口没打开", vbOKOnly & vbInformation, "提示打开串口"
        Exit Sub
    End If
    
    MSComm1.InputMode = comInputModeBinary
    First_chr(0) = &H5E
    First_chr(1) = &H10
    First_chr(2) = &H0
    First_chr(3) = &HB2
    First_chr(4) = &HF0
    First_chr(5) = &H1
    First_chr(6) = &H98
   
    For n = 1 To 6
        k = k + First_chr(n)
        If k > 255 Then
            k = k - 256
        End If
    Next n
    t = k
    First_chr(7) = Val("&H" & Hex$(k))
    Text12.Text = Hex$(Val("&H" & Hex$(k)))
    k = Not t
    k = k + 1
    First_chr(8) = Val("&H" & Hex$(k))
    Text13.Text = Hex$(Val("&H" & Hex$(k)))
    
    First_chr(9) = &HD
    send.Text = ""
    For i = 0 To 9
    j = Hex$(First_chr(i))
    If Len(j) = 1 Then
        j = "0" & j
    End If
    send.Text = send.Text & j
    Next i
    vsend = First_chr()
    Call SendData(First_chr)
End Sub

Private Sub Command7_Click()
'--------------------------------------------------------------------
'设置的新的从机波特率的按钮
'--------------------------------------------------------------------

    Dim First_chr(0 To 10) As Byte
    Dim vsend   As Variant
    Dim stringbaud  As String
    Dim i   As Integer
    Dim j   As String
    
    Dim k   As Integer
    Dim n   As Integer
    If st.Enabled = True Then
        MsgBox "串口没打开", vbOKOnly & vbInformation, "提示打开串口"
        Exit Sub
    End If
    
    If adropen = False Then
        MsgBox "你没有选择要设置的从机地址，请选择要设置的从机地址", vbOKOnly & vbInformation, "提示"
        Exit Sub
    End If
    
    If newbaud.Text = "" Then
        MsgBox "你没有选择新波特率", vbOKOnly & vbInformation, "提示"
        Exit Sub
    End If
     
    If newbaud.Text = "2400" Then
        stringbaud = "01"
    End If
    
    If newbaud.Text = "4800" Then
        stringbaud = "02"
    End If
    
    If newbaud.Text = "9600" Then
        stringbaud = "03"
    End If
    
    If newbaud.Text = "19200" Then
        stringbaud = "04"
    End If
     
    MSComm1.InputMode = comInputModeBinary
    First_chr(0) = &H5E
    First_chr(1) = &H10
    First_chr(2) = Val(Trim("&H" & setadr.Text))
    First_chr(3) = &HB2
    First_chr(4) = &HE0
    First_chr(5) = &H2
    First_chr(6) = &HA
    First_chr(7) = Val(Trim("&H" & stringbaud))
    
    
    For n = 1 To 7
        k = k + First_chr(n)
        If k > 255 Then
            k = k - 256
        End If
    Next n
    First_chr(8) = Val("&H" & Hex$(k))
    k = Not First_chr(8)
    k = k + 1
    First_chr(9) = Val("&H" & Hex$(k))
    
    
    First_chr(10) = &HD
    
    send.Text = ""
    For i = 0 To 10
    j = Hex$(First_chr(i))
    If Len(j) = 1 Then
        j = "0" & j
    End If
    send.Text = send.Text & j
    Next i
    
    vsend = First_chr()
    Call SendData(First_chr)

End Sub






Private Sub Command8_Click()
Dim First_chr(0 To 10) As Byte
    Dim vsend   As Variant
    Dim i   As Integer
    Dim j   As String
    
    Dim k   As Integer
    Dim n   As Integer
    If st.Enabled = True Then
        MsgBox "串口没打开", vbOKOnly & vbInformation, "提示打开串口"
        Exit Sub
    End If
    
    If adropen = False Then
        MsgBox "你没有选择要设置的从机地址，请选择要设置的从机地址", vbOKOnly & vbInformation, "提示"
        Exit Sub
    End If
    
    If newadr.Text = "" Then
        MsgBox "你没有选择新的地址号", vbOKOnly & vbInformation, "提示"
        Exit Sub
    End If
     
    MSComm1.InputMode = comInputModeBinary
    First_chr(0) = &H5E
    First_chr(1) = &H10
    First_chr(2) = Val(Trim("&H" & setadr.Text))
    First_chr(3) = &HB2
    First_chr(4) = &HE0
    First_chr(5) = &H2
    First_chr(6) = &H4
    First_chr(7) = Val(Trim("&H" & newadr.Text))
    
    
    
    For n = 1 To 7
        k = k + First_chr(n)
        If k > 255 Then
            k = k - 256
        End If
    Next n
    First_chr(8) = Val("&H" & Hex$(k))
    k = Not First_chr(8)
    k = k + 1
    First_chr(9) = Val("&H" & Hex$(k))
    
    
    First_chr(10) = &HD
    
    send.Text = ""
    For i = 0 To 10
    j = Hex$(First_chr(i))
    If Len(j) = 1 Then
        j = "0" & j
    End If
    send.Text = send.Text & j
    Next i
    
    vsend = First_chr()
    Call SendData(First_chr)
End Sub

'--------------------------------------------------------------------
'程序的初始化
'--------------------------------------------------------------------
Private Sub Form_Load()
    Dim k As Integer
    Dim z As Integer
    Dim a As Integer
    Dim b As Integer
    Dim n As Integer
    Dim m As Integer
    
    
    Text22.Visible = False
    Text13.Visible = False
    Text12.Visible = False
    
    Combo1.Text = "请选择调整的类型"
    Combo1.AddItem "输入交流电压"
    Combo1.AddItem "输出直流电压"
    Combo1.AddItem "输出电流一路"
    Combo1.AddItem "输出电流二路"
    Combo1.AddItem "输出电流三路"
    
    Combo11.Text = "Com1"
    baudrate.Text = "9600"
    baudrate.AddItem (2400)
    baudrate.AddItem (4800)
    baudrate.AddItem (9600)
    baudrate.AddItem (19200)
    
    newbaud.Text = "9600"
    newbaud.AddItem (2400)
    newbaud.AddItem (4800)
    newbaud.AddItem (9600)
    newbaud.AddItem (19200)
    
    aouttop.Text = "41.5"
    aouttop.AddItem (41.5)
    aouttop.AddItem (40.5)
    aouttop.AddItem (39.5)
    aouttop.AddItem (38.5)
    aouttop.AddItem (37.5)
    aouttop.AddItem (36.5)
    
    acinputb.Text = "180"
    For k = 180 To 190
        acinputb.AddItem Trim$(Str$(k))
    Next
    
    acinputtop.Text = "250"
    For n = 250 To 230 Step -1
        acinputtop.AddItem Trim$(Str$(n))
    Next
    
    dcouttop.Text = "64"
    For a = 64 To 55 Step -1
        dcouttop.AddItem Trim$(Str$(a))
    Next
    
    dcoutb.Text = "00"
    dcoutb.AddItem "01"
    dcoutb.AddItem "02"
    dcoutb.AddItem "03"
    dcoutb.AddItem "04"
    dcoutb.AddItem "05"
    dcoutb.AddItem "06"
    dcoutb.AddItem "07"
    dcoutb.AddItem "08"
    dcoutb.AddItem "09"
    For b = 10 To 44
        dcoutb.AddItem Trim$(Str$(b))
    Next
    
    setadr = "0"
    For m = 0 To 50
        setadr.AddItem Trim$(Str$(m))
    Next
    
    adr.Text = "0"
    For k = 0 To 20
        adr.AddItem Trim$(Str$(k))
    Next
    
    newadr.Text = "0"
    For m = 0 To 20
        newadr.AddItem Trim$(Str$(m))
    Next

    MSComm1.InputMode = comInputModeBinary      '二进制接收方式
    Text1.Text = ""
    stopcom.Enabled = False
End Sub
'--------------------------------------------------------------------
'发送函数（以2进制方式发送）
'--------------------------------------------------------------------
Public Function SendData(ByRef bytData() As Byte) As Long
    MSComm1.InputMode = comInputModeBinary
    MSComm1.Output = bytData                       '发送数据
    Do
        DoEvents
    Loop Until MSComm1.OutBufferCount = 0          '等待，直到数据发送完毕
    SendData = 0
    Exit Function
End Function
'--------------------------------------------------------------------
'清空按钮：清空TEXT1中的内容
'--------------------------------------------------------------------
Private Sub cls_Click()