mainbgkfrm.frm

一个汉字转换工具,对单片机开发人员可能有点帮助.

  
End Sub

Private Sub Command2_Click()
 Dim aaa(1) As Byte
 Dim i As Long, str As String, strc As String
 aaa(0) = &H4E
 aaa(1) = 0
 str = ""
 For i = 1 To Len(Text5)
    If Mid(Text5, i, 1) <> " " Then
       str = str & Mid(Text5, i, 1)
    End If
 Next i
 strc = ""
 For i = 1 To Len(str) Step 4
    strc = strc & ChrW(Val("&h" & Mid(str, i, 4)))
 Next i
 Text6 = strc
 

End Sub

Private Sub Command3_Click()
'7E 01 06 01 0E 2B 38 36 31 33 35 37 30 38 37 36 37 35 38
'13 32 30 30 34 2F 31 32 2F 32 32 20 31 36 3A 31 31
'8b 4E 00 53 17 65 B9 75 37 4E BA 53 BB 53 57 65 B9 75 28 99
'10 00 2C 75 37 00 3A 99 8D 99 8D 59 1A 5C 11 94 B1 00 3F 59 73 62
'DB 5F 85 00 3A 64 78 64 78 4E 94 53 41 00 2E 75 37 00 3A 4E 0B 97
'62 54 62 00 3F 59 73 00 3A 4E 00 76 1B 65 00 2E 75 37 61 24 71 36 00
'3A 6C 34 99 7A 54 62 00 3F 59 73 00 3A 77 61 89 C9 4E 8C 76 1B 65 00
'2C 75 37 89 C9 4E 0D 53 EF 60 1D 8B AE 00 2C 8F DE 58 F0 53 EB 52 30 00
'3A 9E D1 5E 97 9E D1 5E 97 00 00 7E
Dim str As String, i As Long, aa As String, check As Long, xorcheck As Long
str = ""
For i = 1 To Len(Text7.Text)
   aa = Mid(Text7.Text, i, 1)
   If aa <> " " Then str = str & aa
Next i
str = Trim$(str)
check = 0
xorcheck = 0
For i = 1 To Len(str)
    aa = Mid(str, i, 2)
    check = check + CInt("&H" & aa)
    xorcheck = xorcheck Xor CInt("&H" & aa)
    i = i + 1
Next i
Text8 = Hex(CLng(check))
Text9 = Hex(CLng(xorcheck))
End Sub

Private Sub Command4_Click()
 Dim aaa(1) As Byte
 Dim i As Long, str As String, strc As String
 aaa(0) = &H4E
 aaa(1) = 0
 str = ""
 If Len(Text5) > 2 Then
    Text5 = Mid(Text5, 2)
    For i = 1 To Len(Text5)
       If Mid(Text5, i, 1) <> " " Then
          str = str & Mid(Text5, i, 1)
       End If
    Next i
    strc = ""
    For i = 1 To Len(str) Step 4
       strc = strc & ChrW(Val("&h" & Mid(str, i, 4)))
    Next i
    Text6 = strc
 End If
End Sub

Private Sub Command5_Click()
    Dim str As String, i As Long
    str = ""
    For i = 1 To Len(Text10)
        str = str & Chr("&h" & Mid$(Text10, i, 2))
        i = i + 1
    Next
    Text11 = str
End Sub

Private Sub Command6_Click()
  Dim i As Long, l As Long, ii As Long
  Dim aa As Byte, bb As Byte
  Dim str As String, str1 As String
  Dim xxx(8) As Byte, yyy(8) As Byte
  str = ""
  xxx(3) = &HF8
  xxx(2) = &HFC
  xxx(1) = &HFE
  
  
  yyy(7) = &H1
  yyy(6) = &H3
  yyy(5) = &H7
  yyy(4) = &HF
  yyy(3) = &H1F
  yyy(2) = &H3F
  yyy(1) = &H7F
  
  l = 0
  i = Len(Text10) / 2
  ReDim temparr(i + 1) As Byte
  For i = 1 To Len(Text10) Step 2
      l = l + 1
      temparr(l) = "&h" & Mid(Text10, i, 2)
  Next i
  If l < 8 Then
     For i = l To 2 Step -1
         aa = LL(temparr(i) And yyy(i), i - 1) '<<
         bb = RR(temparr(i - 1), 9 - i) '>>
         temparr(i) = aa Or bb
     Next i
         temparr(1) = temparr(1) And &H7F
  End If
  str1 = ""
  For i = 1 To l
      If temparr(i) < &H1F Then
        str = str & CRstr(temparr(i))
      Else
        str = str & Chr$(temparr(i))
      End If
      If temparr(i) < 16 Then str1 = str1 & "0"
      str1 = str1 & Hex(temparr(i)) & "H "
  Next i
  Text11.Text = str & "(" & str1 & ")"
End Sub
Private Function CRstr(x As Byte) As String
        Select Case x
               Case 0: CRstr = "^@"
               Case 1: CRstr = "^A"
               Case 2: CRstr = "^B"
               Case 3: CRstr = "^C"
               Case 4: CRstr = "^D"
               Case 5: CRstr = "^E"
               Case 6: CRstr = "^F"
               Case 7: CRstr = "^G"
               Case 8: CRstr = "^H"
               Case 9: CRstr = "^I"
               Case 10: CRstr = "^J"
               Case 11: CRstr = "^K"
               Case 12: CRstr = "^L"
               Case 13: CRstr = "^M"
               Case 14: CRstr = "^N"
               Case 15: CRstr = "^O"
               Case 16: CRstr = "^P"
               Case 17: CRstr = "^Q"
               Case 18: CRstr = "^R"
               Case 19: CRstr = "^S"
               Case 20: CRstr = "^T"
               Case 21: CRstr = "^U"
               Case 22: CRstr = "^V"
               Case 23: CRstr = "^W"
               Case 24: CRstr = "^X"
               Case 25: CRstr = "^Y"
               Case 26: CRstr = "^Z"
               Case 27: CRstr = "^["
               Case 28: CRstr = "^\"
               Case 29: CRstr = "^]"
               Case 30: CRstr = "^^"
               Case 31: CRstr = "^_"
               Case Else
        End Select
End Function
Private Function RR(x As Byte, count As Long) As Byte  '>>
        Dim y As Byte
        Select Case count
               Case 1:
                     If (x And &H2) <> 0 Then y = y Or &H1
                     If (x And &H4) <> 0 Then y = y Or &H2
                     If (x And &H8) <> 0 Then y = y Or &H4
                     If (x And &H10) <> 0 Then y = y Or &H8
                     If (x And &H20) <> 0 Then y = y Or &H10
                     If (x And &H40) <> 0 Then y = y Or &H20
                     If (x And &H80) <> 0 Then y = y Or &H40
               Case 2:
                     If (x And &H4) <> 0 Then y = y Or &H1
                     If (x And &H8) <> 0 Then y = y Or &H2
                     If (x And &H10) <> 0 Then y = y Or &H4
                     If (x And &H20) <> 0 Then y = y Or &H8
                     If (x And &H40) <> 0 Then y = y Or &H10
                     If (x And &H80) <> 0 Then y = y Or &H20
               Case 3:
                     If (x And &H8) <> 0 Then y = y Or &H1
                     If (x And &H10) <> 0 Then y = y Or &H2
                     If (x And &H20) <> 0 Then y = y Or &H4
                     If (x And &H40) <> 0 Then y = y Or &H8
                     If (x And &H80) <> 0 Then y = y Or &H10
               Case 4:
                     If (x And &H10) <> 0 Then y = y Or &H1
                     If (x And &H20) <> 0 Then y = y Or &H2
                     If (x And &H40) <> 0 Then y = y Or &H4
                     If (x And &H80) <> 0 Then y = y Or &H8
               Case 5:
                     If (x And &H20) <> 0 Then y = y Or &H1
                     If (x And &H40) <> 0 Then y = y Or &H2
                     If (x And &H80) <> 0 Then y = y Or &H4
               Case 6:
                     If (x And &H40) <> 0 Then y = y Or &H1
                     If (x And &H80) <> 0 Then y = y Or &H2
               Case 7:
                    If (x And &H80) <> 0 Then y = y Or &H1
               Case Else
        End Select
        RR = y
End Function
Private Function LL(x As Byte, count As Long) As Byte  '<<
       Dim y As Byte
        Select Case count
               Case 1:
                     If (x And &H1) <> 0 Then y = y Or &H2
                     If (x And &H2) <> 0 Then y = y Or &H4
                     If (x And &H4) <> 0 Then y = y Or &H8
                     If (x And &H8) <> 0 Then y = y Or &H10
                     If (x And &H10) <> 0 Then y = y Or &H20
                     If (x And &H20) <> 0 Then y = y Or &H40
                     If (x And &H40) <> 0 Then y = y Or &H80
               Case 2:
                     If (x And &H1) <> 0 Then y = y Or &H4
                     If (x And &H2) <> 0 Then y = y Or &H8
                     If (x And &H4) <> 0 Then y = y Or &H10
                     If (x And &H8) <> 0 Then y = y Or &H20
                     If (x And &H10) <> 0 Then y = y Or &H40
                     If (x And &H20) <> 0 Then y = y Or &H80
               Case 3:
                     If (x And &H1) <> 0 Then y = y Or &H8
                     If (x And &H2) <> 0 Then y = y Or &H10
                     If (x And &H4) <> 0 Then y = y Or &H20
                     If (x And &H8) <> 0 Then y = y Or &H40
                     If (x And &H10) <> 0 Then y = y Or &H80
               Case 4:
                     If (x And &H1) <> 0 Then y = y Or &H10
                     If (x And &H2) <> 0 Then y = y Or &H20
                     If (x And &H4) <> 0 Then y = y Or &H40
                     If (x And &H8) <> 0 Then y = y Or &H80
               Case 5:
                     If (x And &H1) <> 0 Then y = y Or &H20
                     If (x And &H2) <> 0 Then y = y Or &H40
                     If (x And &H4) <> 0 Then y = y Or &H80
               Case 6:
                     If (x And &H1) <> 0 Then y = y Or &H40
                     If (x And &H2) <> 0 Then y = y Or &H80
               Case 7:
                    If (x And &H1) <> 0 Then y = y Or &H80
               Case Else
        End Select
        LL = y
End Function

Private Sub Command7_Click()
  Dim i As Long
  Dim ss As String, ss1 As String
  ss = ""
  For i = 1 To Len(Text1)
    If Mid(Text1, i, 1) <> " " Then ss = ss & Mid(Text1, i, 1)
    
  Next i
  ss1 = ""
  For i = 1 To Len(ss)
     ss1 = ss1 & Chr("&h" & Mid(ss, i, 2))
     i = i + 1
  Next i
  MsgBox ss1
  Text1 = ss1
End Sub

Private Sub Form_Load()
  
   Text2.ForeColor = vbBlack
   Text3.ForeColor = vbBlack
   Text4.ForeColor = vbBlack
   Text4 = ""
   Text3 = ""
   Text2 = ""
   Text1 = ""
   Text5 = ""
   Text6 = ""
   Text7 = ""
   Text8 = ""
End Sub