xiugai.frm

来自「vb程序（整体处理）.rar」· FRM 代码 · 共 1,238 行 · 第 1/3 页

      Width           =   1095
   End
   Begin VB.Label Label3 
      Alignment       =   2  'Center
      Caption         =   "IH"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2520
      TabIndex        =   5
      Top             =   1320
      Width           =   1095
   End
   Begin VB.Label Label2 
      Alignment       =   2  'Center
      Caption         =   "IL"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1440
      TabIndex        =   3
      Top             =   1320
      Width           =   1095
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Caption         =   "para"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   360
      TabIndex        =   1
      Top             =   1320
      Width           =   1095
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)  '延时

Private Sub jiance(str As String)   '检测返回码部分
Dim i As Integer
Dim strr(70) As String
Dim buffer() As Byte
If MSComm1.InBufferCount < 1 Then
  Sleep 100
End If
buffer = MSComm1.Input
   If MSComm1.InBufferCount >= 0 Then
   
   
   For i = LBound(buffer) To UBound(buffer)
   strr(i) = buffer(i)
   Next
   str = strr(0)
   
   MSComm1.InBufferCount = 0
   End If

End Sub

Private Sub jiee(str As String)   '接收部分子程序
Dim i As Integer
Dim strr(70) As String
Dim buffer() As Byte
Dim shushu(9) As Single
If MSComm1.InBufferCount < 1 Then
  Sleep 1000
End If
buffer = MSComm1.Input
   If MSComm1.InBufferCount >= 0 Then
   
   
   For i = LBound(buffer) To UBound(buffer)
   strr(i) = buffer(i)
   Next
   If Val(strr(0)) = &HCC Then
   Text13.Text = Val(strr(2)) * 256 + Val(strr(1))      '先入高位，后入低位
   Text14.Text = Val(strr(4)) * 256 + Val(strr(3))
   Text15.Text = Val(strr(6)) * 256 + Val(strr(5))
   Text16.Text = Val(strr(8)) * 256 + Val(strr(7))
   Text17.Text = Val(strr(9))
   Text18.Text = Val(strr(10))
   Text19.Text = Val(strr(11))
   Text20.Text = (Val(strr(15)) * 256 + Val(strr(14))) + (Val(strr(13)) * 256 + Val(strr(12))) / 1000
   Text21.Text = (Val(strr(19)) * 256 + Val(strr(18))) + (Val(strr(17)) * 256 + Val(strr(16))) / 1000
   Text22.Text = (Val(strr(23)) * 256 + Val(strr(22))) + (Val(strr(21)) * 256 + Val(strr(20))) / 1000
   Else
   Text13.Text = 0
   Text14.Text = 0
   Text15.Text = 0
   Text16.Text = 0
   Text17.Text = 0
   Text18.Text = 0
   Text19.Text = 0
   Text20.Text = 0
   Text21.Text = 0
   Text22.Text = 0
   End If

   MSComm1.InBufferCount = 0
   End If

End Sub


Private Sub CHAIFEN(ss As Integer, s As Integer, fudianshu As Single)    '把浮点数拆成两部分
ss = Int(fudianshu)                     '整数部分
s = Int((fudianshu - ss) * 1000)            '小数部分
End Sub

Private Sub send_2B(send_data_1 As Byte, send_data_2 As Byte, tti As Integer)  '发送2字节数据子程序
Dim send_data(1) As Byte
Dim aa As Byte
Dim bb As Byte
aa = Int(tti / 256)
bb = tti And &HFF
send_data_1 = bb
send_data_2 = aa
End Sub

Private Sub send_1B(send_dd As Byte, oneB As String)  '发送1字节数据子程序
send_dd = oneB
End Sub

Private Sub send_4B(send_4b_1 As Byte, send_4b_2 As Byte, send_4b_3 As Byte, send_4b_4 As Byte, fuu As Single) '发送浮点数子程序
Dim i As Integer
Dim s As Integer
Dim ss As Integer
Dim fudianshu As Single
Dim send_data_1(1) As Byte
Dim send_data_2(1) As Byte
Dim tti(1) As Integer
fudianshu = fuu
Call CHAIFEN(ss, s, fudianshu)
tti(0) = s                  '小数部分
tti(1) = ss                '整数部分
For i = 0 To 1
Call send_2B(send_data_1(i), send_data_2(i), tti(i))
Next
send_4b_1 = send_data_1(0) '小数低位
send_4b_2 = send_data_2(0) '小数高位
send_4b_3 = send_data_1(1)  '整数低位
send_4b_4 = send_data_2(1)  '整数高位
End Sub

Private Sub Command1_Click()     '双击发送

Select Case Combo1.Text
            Case Is = "4800"
                    MSComm1.Settings = "4800,n,8,1"
            Case Is = "9600"
                    MSComm1.Settings = "9600,n,8,1"
            Case Is = "14400"
                    MSComm1.Settings = "14400,n,8,1"
            Case Is = "19200"
                    MSComm1.Settings = "19200,n,8,1"
            Case Is = "115200"
                    MSComm1.Settings = "115200,n,8,1"
 End Select
 
 Select Case Combo2.Text
            Case Is = "com1"
                    MSComm1.CommPort = 1
            Case Is = "com2"
                    MSComm1.CommPort = 2
            Case Is = "com3"
                    MSComm1.CommPort = 3
            Case Is = "com4"
                    MSComm1.CommPort = 4
            Case Is = "com5"
                    MSComm1.CommPort = 5
 End Select


Dim m As Integer
Dim i As Integer
Dim n As Integer
Dim k As Integer
Dim tti(4) As Integer
Dim oneB(3) As String
Dim str As String
Dim fuu(3) As Single
Dim head_data(30) As Byte
Dim send_data_1(4) As Byte        '整型低位
Dim send_data_2(4) As Byte        '整型高位
Dim send_4b_1(3) As Byte          '小数低位
Dim send_4b_2(3) As Byte          '小数高位
Dim send_4b_3(3) As Byte          '整数低位
Dim send_4b_4(3) As Byte          '整数高位
Dim send_dd(3) As Byte
MSComm1.InputMode = comInputModeBinary
MSComm1.InBufferSize = 1024
MSComm1.OutBufferSize = 1024

  
 tti(0) = CInt(Val(Text1.Text))
 tti(1) = CInt(Val(Text2.Text))
 tti(2) = CInt(Val(Text3.Text))
 tti(3) = CInt(Val(Text4.Text))
 tti(4) = CInt(Val(Text5.Text))
 oneB(0) = Val(Text6.Text)
 oneB(1) = Val(Text7.Text)
 oneB(2) = Val(Text8.Text)
 oneB(3) = Val(Text9.Text)
 fuu(0) = CSng(Val(Text10.Text))
 fuu(1) = CSng(Val(Text11.Text))
 fuu(2) = CSng(Val(Text12.Text))
 fuu(3) = CSng(Val(Text23.Text))

 
   
     
     For n = 0 To 4                         '发5个整型
     Call send_2B(send_data_1(n), send_data_2(n), tti(n))
     Next n
     For m = 0 To 3                         '发4个字符
     Call send_1B(send_dd(m), oneB(m))
     Next m
     For k = 0 To 3                         '发4个浮点
     Call send_4B(send_4b_1(k), send_4b_2(k), send_4b_3(k), send_4b_4(k), fuu(k))
     Next k
     '整体赋值
     head_data(0) = &HFF
     head_data(1) = send_data_1(0)
     head_data(2) = send_data_2(0)
     head_data(3) = send_data_1(1)
     head_data(4) = send_data_2(1)
     head_data(5) = send_data_1(2)
     head_data(6) = send_data_2(2)
     head_data(7) = send_data_1(3)
     head_data(8) = send_data_2(3)
     head_data(9) = send_data_1(4)
     head_data(10) = send_data_2(4)
     head_data(11) = send_dd(0)
     head_data(12) = send_dd(1)
     head_data(13) = send_dd(2)
     head_data(14) = send_dd(3)
     head_data(15) = send_4b_1(0)
     head_data(16) = send_4b_2(0)
     head_data(17) = send_4b_3(0)
     head_data(18) = send_4b_4(0)
     head_data(19) = send_4b_1(1)
     head_data(20) = send_4b_2(1)
     head_data(21) = send_4b_3(1)
     head_data(22) = send_4b_4(1)
     head_data(23) = send_4b_1(2)
     head_data(24) = send_4b_2(2)
     head_data(25) = send_4b_3(2)
     head_data(26) = send_4b_4(2)
     head_data(27) = send_4b_1(3)
     head_data(28) = send_4b_2(3)
     head_data(29) = send_4b_3(3)
     head_data(30) = send_4b_4(3)
     MSComm1.PortOpen = True       '打开串口
     For i = 0 To 9                '发送10次
     MSComm1.Output = head_data
     Sleep 200
     Call jiance(str)               '等待200ms检测一次返回值
     If Val(str) = &H6F Then
     GoTo jieshou
jieshou:
     MsgBox "发送成功"
     End If
     Next
   
     MsgBox "wancheng"
     MSComm1.PortOpen = False

End Sub

Private Sub Command2_Click()
Dim ss As Integer
Dim s As Integer
Dim fudianshu As Single
fudianshu = Val(Text1.Text)
Call CHAIFEN(ss, s, fudianshu)
Text2.Text = ss
Text3.Text = s
End Sub

Private Sub Command3_Click()     '双击接收

Select Case Combo1.Text
            Case Is = "4800"
                    MSComm1.Settings = "4800,n,8,1"
            Case Is = "9600"
                    MSComm1.Settings = "9600,n,8,1"
            Case Is = "14400"
                    MSComm1.Settings = "14400,n,8,1"
            Case Is = "19200"
                    MSComm1.Settings = "19200,n,8,1"
            Case Is = "115200"
                    MSComm1.Settings = "115200,n,8,1"
 End Select
 
 Select Case Combo2.Text
            Case Is = "com1"
                    MSComm1.CommPort = 1
            Case Is = "com2"
                    MSComm1.CommPort = 2
            Case Is = "com3"
                    MSComm1.CommPort = 3
            Case Is = "com4"
                    MSComm1.CommPort = 4
            Case Is = "com5"
                    MSComm1.CommPort = 5
 End Select

Dim i As Integer
Dim l As Integer
Dim r As Integer
Dim shuju(2) As Single
Dim qingqiu(0) As Byte
Dim send_end(0) As Byte
Dim str As String
Dim ssjj(6) As Integer
qingqiu(0) = &HCC
send_end(0) = &H7C
MSComm1.InputMode = comInputModeBinary
MSComm1.InBufferSize = 1024
MSComm1.PortOpen = True
For i = 0 To 3
MSComm1.Output = qingqiu
Sleep 300
Next
Call jiee(str)

MSComm1.Output = send_end
Sleep 10
MSComm1.Output = send_end
Sleep 10
MSComm1.Output = send_end
Sleep 10
MSComm1.Output = send_end
Sleep 10
MSComm1.Output = send_end
Sleep 10
MSComm1.PortOpen = False
End Sub




Private Sub inshuju1(ssjj As Integer)    '接收整型
Dim i As Integer
Dim buffer() As Byte
Dim insj As String
Dim tww As Integer
Dim Y As String
Dim diwei As Integer
Dim gaowei As Integer
If MSComm1.InBufferCount < 1 Then
End If
buffer = MSComm1.Input
    If MSComm1.InBufferCount >= 0 Then
    
    For i = LBound(buffer) To UBound(buffer)
    insj = buffer(i)
    Next
    Y = insj
    diwei = Val(Y)
    buffer = MSComm1.Input
    For i = LBound(buffer) To UBound(buffer)
    
    insj = buffer(i)
    Next
    Y = insj
    gaowei = Val(Y)
    End If
 ssjj = gaowei * 256 + diwei

End Sub

Private Sub inshuju2(shuju As Single)     '接收浮点
Dim i As Integer
Dim ssjj(1) As Integer
For i = 0 To 1
Call inshuju1(ssjj(i))
Next
shuju = CSng(ssjj(0) / 1000) + CSng(ssjj(1))
End Sub

Private Sub Command4_Click()
End
End Sub