hexedit.bas

vb编写机器人遥控程序

i = 5 * (k - 819) / 81.9
If i < 100 Then frmMain.Label31.Caption = "内温：" & Chr(10) & Trim(Format(i, "0.0")) & Chr(10) & "    ℃"
Red = 8 * (k - 1019) / 81
If Red > 255 Then Red = 255
If Red < 0 Then Red = 0
frmMain.Label31.BackColor = RGB(Red, 255 - Red, 50)
'****************瓦斯 ***********************
k = Inputdata(17) * 256 + Inputdata(18)
i = k / 126289.8 - 0.009
frmMain.Label2.Caption = "瓦斯：" & Chr(10) & Trim(Format(i, "0.0%"))
Red = k / 1262 * 50
If Red > 255 Then Red = 255
If Red < 0 Then Red = 0
frmMain.Label2.BackColor = RGB(Red, 255 - Red, 50)
'****************湿度 ***********************
k = Inputdata(23) * 256 + Inputdata(24)
i = (5 * k - 3501.225) / 12935.7
If i < 0 Then i = 0
frmMain.Label4.Caption = "湿度：" & Chr(10) & Trim(Format(i, "0.0%"))
Green = (5 * k - 3501) / 129 * 2.5 + 50
If Green > 255 Then Green = 255
If Green < 0 Then Green = 0
Red = 255 - Green - 30
If Red < 0 Then Red = 0
frmMain.Label4.BackColor = RGB(Red, Green, Green)
'**************电机状态******************
' 摆臂左
        If Inputdata(8) And 1 Then
            frmMain.Label20.BackColor = vbRed
        Else: frmMain.Label20.BackColor = vbGreen
        End If
        ' 摆臂右
        If Inputdata(8) And 2 Then
            frmMain.Label21.BackColor = vbRed
        Else: frmMain.Label21.BackColor = vbGreen
        End If
        ' 主左
        If Inputdata(8) And 4 Then
            frmMain.Label22.BackColor = vbRed
        Else: frmMain.Label22.BackColor = vbGreen
        End If
        ' 主左
        If Inputdata(8) And 8 Then
        frmMain.Label23.BackColor = vbRed
        Else: frmMain.Label23.BackColor = vbGreen
        End If

        '**********************传感器状态
        If Inputdata(8) And 16 Then
        frmMain.Label1.BackColor = vbRed
        frmMain.Label2.BackColor = vbRed
        frmMain.Label3.BackColor = vbRed
        frmMain.Label4.BackColor = vbRed
        frmMain.Shape1.BackColor = vbRed
        frmMain.Label31.BackColor = vbRed
        frmMain.Label32.BackColor = vbRed
        Else
        frmMain.Shape1.BackColor = &HFFC0C0
        frmMain.Shape3.BackColor = &HFFC0FF
 End If
 End If
    End If
   End If
    Sendout = True
   ' Check = False
'=======================启动发送============================
   If Sendout = True Then frmMain.Timer4.Enabled = True
   If intReceiveLen >= Longl Then intReceiveLen = 0
   intReceiveLen = intReceiveLen + intInputLenth
   frmMain.Label28.Caption = intReceiveLen
End Sub

'*************最后接收数据填入文本框****************8
Public Sub Chuanganqidisplay()
    Dim t As String, te As String, i%
    t = ""
    For i = 1 To Longl
    te = Hex(Inputdata(i))
    If Len(te) = 1 Then te = "0" & te
    t = t & te
    Next
   
   't = t & Hex(Inputdata(Longl))
    If frmMain.Text1 = "input data error!" Then frmMain.Text1 = ""
    frmMain.Text1 = frmMain.Text1.Text & t & Chr$(10) 'strhexc
    
    On Error GoTo outthere
    
    If Len(frmMain.Text1.Text) >= 1200 Then
    frmMain.Text1 = Mid(frmMain.Text1.Text, InStr(15, frmMain.Text1.Text, "A5"))
    End If
    If Len(frmMain.Text1.Text) >= 40 Then frmMain.Text1.SelStart = Len(frmMain.Text1) - 30
    Exit Sub
outthere:
    frmMain.Text1 = "input data error!"
    Check = False
     
End Sub

'****************16进制字符转为10进制****************************
Public Function Covertonum(tet As String, lo As Single) As Integer
Dim a As String, num!

a = Mid(tet, lo, 1)
num = Asc(a)
If Asc(a) > 64 Then
num = 10 * 16 + (Asc(a) - 65) * 16
Else
num = Val(a) * 16
End If
a = Mid(tet, lo + 1, 1)
If Asc(a) > 64 Then
num = num + Asc(a) - 65 + 10
Else
num = num + Val(a)
End If
Covertonum = num
End Function
'***************异或校验实现************************
Public Function Xorcode(ByVal tet As String) As Integer
Dim i!, j!
tet = Replace(tet, " ", "")
If Len(tet) <> 0 Then
j = Covertonum(tet, 1)
For i = 2 To Len(tet) / 2
j = j Xor Covertonum(tet, 2 * i - 1)
Next
Xorcode = j
End If
End Function
'*********CRC-CCITT校验****************************
Public Function CRC_CCITT(ByVal string1 As String) As String
    Dim CRC As Long, i As Byte, j As Integer, Data() As Byte, tem() As Byte
    Dim crch As String, temp As String, crcl As String, a As String, k!, m!, n!, sum!
    string1 = Replace(string1, " ", "")
    k = Len(string1) / 2
    If k = 10 Then
   
    ReDim Data(k) As Byte
     ReDim tem(k) As Byte
        For m = 0 To k - 1
        tem(m) = Val("&h" & Mid$(string1, m * 2 + 1, 2))
        If Val(tem(m)) > 255 Then tem(m) = "FF"
        If Val(tem(m)) < 0 Then tem(m) = "00"
        
    Next m
   
    Data(0) = tem(0)
    Data(1) = tem(1)
    sum = (Val("&H" & Mid(string1, 3, 2)) + 1)
    sum = 2 * (Val("&H" & Mid(string1, 3, 2)) + 1)
    For n = 1 To sum Step 2
    Data(n + 1) = tem(n + 2)
    Data(n + 2) = tem(n + 1)
    Next
    For n = 0 To k - 1
    
    Next
    CRC = 0
    For j = LBound(Data) To UBound(Data) - 1
        i = &H80
        While (i <> 0)
            If (CRC And &H8000) <> 0 Then
                CRC = CRC * 2
                CRC = CRC Xor &H1021
            Else
                CRC = CRC * 2
            End If
            If (Data(j) And i) <> 0 Then
                CRC = CRC Xor &H1021
            End If
            i = i / 2
            If CRC > 65536 Then
                CRC = CRC - 65536
            End If
        Wend
    Next j

    crch = Hex(Fix(CRC / 256))
    If Len(crch) = 1 Then crch = "0" & crch
        crcl = Hex(CRC Mod 256)
    If Len(crcl) = 1 Then crcl = "0" & crcl
        CRC_CCITT = crcl & " " & crch
Else
CRC_CCITT = "55 55"
End If

End Function
Public Function ctohe(i As Integer) As String
If i < 16 Then
ctohe = "0" & Hex(i)
Else: ctohe = Hex(i)
End If
End Function
' ******************************输出数据数组组织**********************
Public Sub Outdatajoin()
Dim U!
'ii = "A1 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F 10 11 12 13 14 15 16 17 18 19 1A 1B 1C 1D 1E"
ii = Model & " " & Moshi(1) & " "     '添加第二个字节
          '添加第三、第四个字节
          If Moshi(1) = "00" Then
          t = Hex(Pcanshu(1))
          If Len(t) = 1 Then t = "0" & t
          If Null = 0 Then t = "00"
          ii = ii & " " & t & " " & Moshi(2)
          Else:
          t = Hex(Vcanshu(1))
          If Len(t) = 1 Then t = "0" & t
          If Null Then t = "00"
          ii = ii & " " & t & " " & Moshi(2)
          End If
          '添加第五个字节
          If Moshi(2) = "00" Then
          t = Hex(Pcanshu(2))

          If Len(t) = 1 Then t = "0" & t
          If t = Null Then t = "00"
          ii = ii & " " & t
          Else:
          t = Hex(Vcanshu(2))
          If Len(t) = 1 Then t = "0" & t
          If t = Null Then t = "00"
          ii = ii & " " & t
          End If
          '添加第六至十五个字节
          For k = 1 To 10
          If Dianjil(k) > 255 Then Dianjil(k) = 255
          If Dianjil(k) < 0 Then Dianjil(k) = 0
          t = Hex(Dianjil(k))
          If Len(t) = 1 Then t = "0" & t
          If t = Null Then t = "00"
          ii = ii & " " & t
          Next
          '添加第十六、第十七字节
          U = Len(ii)
          ii = ii & " " & CRC_CCITT(Mid(ii, 16, 30))
          '添加第十八至二十七个字节
          For k = 1 To 10
          If Dianjir(k) > 255 Then Dianjir(k) = 255
          If Dianjir(k) < 0 Then Dianjir(k) = 0
          t = Hex(Dianjir(k))
          If Len(t) = 1 Then t = "0" & t
          If t = Null Then t = "00"
          ii = ii & " " & t
          Next
          '添加二十八、二十九字节
          ii = ii & " " & CRC_CCITT(Mid(ii, 52, 30))
          t = Hex(Xorcode(ii))
          If Len(t) = 1 Then t = "0" & t
          If t = Null Then t = 0
          ii = ii & " " & t
End Sub
'****************速度数据组织，将设定速度计算添加入数组****************
Public Sub Suduchuli()
Dim tem%
'左
If Vlt >= 0 Then
Dianjil(9) = 0
Dianjil(10) = 0
Dianjil(8) = 0
Dianjil(8) = Vlt \ 256
Dianjil(7) = Vlt - Dianjil(8) * 256
End If

If Vlt < 0 Then
Dianjil(9) = 255
Dianjil(10) = 255
Dianjil(8) = (65535 + Vlt) \ 256 '255 - (-Vlt \ 256)
If Dianjil(8) > 255 Then Dianjil(8) = 255
If Dianjil(8) < 0 Then Dianjil(8) = 0
Dianjil(7) = (65535 + Vlt) Mod 256 ' 255 + Vlt + (-Vlt \ 256) * 256
If Dianjil(7) > 255 Then Dianjil(7) = 255
If Dianjil(7) < 0 Then Dianjil(7) = 0
End If
'右
tem = -Vrt
If tem >= 0 Then
Dianjir(9) = 0
Dianjir(10) = 0
Dianjir(8) = 0
Dianjir(8) = tem \ 256
Dianjir(7) = tem - Dianjir(8) * 256
End If
If tem < 0 Then
Dianjir(9) = 255
Dianjir(10) = 255
Dianjir(8) = (65535 + tem) \ 256 ' 255- (-tem \ 256)
Dianjir(7) = (65535 + tem) Mod 256 ' 255 + tem + (-tem \ 256) * 256
End If
End Sub
'**********************************需测试里程计量程序***********************************
Public Sub Pcount()

If ((Not (Inputdata(8) And 4)) And (Not (Inputdata(8) And 8))) Then
Position = Inputdata(11) * 256 * 256 + Inputdata(12) * 256 + Inputdata(13)
Positionr = Inputdata(14) * 256 * 256 + Inputdata(15) * 256 + Inputdata(16)
If Position - Positiont < 30000 And Position - Positiont >= 0 Then Positiont2 = (Position - Positiont)
If Positiont - Position > 1000000 Then Positiont2 = 16777215 - Positiont + Position

If Positiontr - Positionr < 30000 And Positiontr - Positionr >= 0 Then Positiont2 = (Positiontr - Positionr) + Positiont2
If Positionr - Positiontr > 10000000 Then Positiont2 = 16777215 - Positionr + Positiontr + Positiont2
    Position3 = Position3 + Positiont2 \ 5
    'Position3 = Position3 \ 2.5
    Do While Position3 >= 1000
        Position3 = Position3 - 1000
        Position2 = Position2 + 1
        If Position2 >= 1000 Then
            Position2 = Position2 - 1000
            Position1 = Position1 + 1
        End If
    Loop
End If
    Positiont = Position
    Positiontr = Positionr
    Pot2 = str(Position2)
    Positiont2 = 0
    If Len(Trim(Pot2)) = 1 Then Pot2 = "00" & Trim(Pot2)
    If Len(Trim(Pot2)) = 2 Then Pot2 = "0" & Trim(Pot2)
    Pot3 = str(Position3)
    If Len(Trim(Pot3)) = 1 Then Pot3 = "00" & Trim(Pot3)
    If Len(Trim(Pot3)) = 2 Then Pot3 = "0" & Trim(Pot3)
    frmMain.Label25.Caption = Trim(str(Position1)) & " " & Trim(Pot2) & " " & Trim(Pot3)
    frmMain.Label27.Caption = "里程："
'End If
End Sub