原创 vb编写的人型机器人控制程序（PC与AVR单片机通讯）

Dim a As Integer, l As Boolean, p As Boolean, a1 As Integer, a2 As Integer, r As Boolean
Dim datio(21) As Byte
Dim d As Integer
Dim i As Integer
Sub sendarray()
Text_se.Text = Trim(Text_se.Text)
      datio(0) = Val("&h" & Mid(Text_se.Text, 1, 3))
       datio(1) = Val("&h" & Mid(Text_se.Text, 4, 3))
        datio(2) = Val("&h" & Mid(Text_se.Text, 7, 3))
         datio(3) = Val("&h" & Mid(Text_se.Text, 10, 3))
     datio(4) = Val("&h" & Mid(Text_se.Text, 13, 3))
     datio(5) = Val("&h" & Mid(Text_se.Text, 16, 3))
     datio(6) = Val("&h" & Mid(Text_se.Text, 19, 3))
     datio(7) = Val("&h" & Mid(Text_se.Text, 22, 3))
     datio(8) = Val("&h" & Mid(Text_se.Text, 25, 3))
     datio(9) = Val("&h" & Mid(Text_se.Text, 28, 3))
     datio(10) = Val("&h" & Mid(Text_se.Text, 31, 3))
     datio(11) = Val("&h" & Mid(Text_se.Text, 34, 3))
     datio(12) = Val("&h" & Mid(Text_se.Text, 37, 3))
     datio(13) = Val("&h" & Mid(Text_se.Text, 40, 3))
     datio(14) = Val("&h" & Mid(Text_se.Text, 43, 3))
     datio(15) = Val("&h" & Mid(Text_se.Text, 46, 3))
     datio(16) = Val("&h" & Mid(Text_se.Text, 49, 3))
     datio(17) = Val("&h" & Mid(Text_se.Text, 52, 3))
     datio(18) = Val("&h" & Mid(Text_se.Text, 55, 3))
     datio(19) = Val("&h" & Mid(Text_se.Text, 58, 3))
     datio(20) = Val("&h" & Mid(Text_se.Text, 61, 3))
     datio(21) = Val("&h" & Mid(Text_se.Text, 64, 3))
     MSComm1.Output = datio()
   End Sub
'Dim b()
Sub kkk()                        '发送子程序
   Dim X As String, q As String, w As Integer
   'w = j
  ' Static s As Integer
'    If Not l Then
'      i = 1
'      l = True
'    End If
'Static i As Integer
i = List1.ListCount + 1
Dim str  As String, pp As String, jj As String
If Not MSComm1.PortOpen Then
   MSComm1.PortOpen = True
End If
If Text1(0).Text = "" Then
    MsgBox " 1号BOX没有输入"
    Exit Sub
End If
Text_se.Text = ""                       '发送数据
     'Text_se.Text = Text1(0).Text + Space(2) + Text2(0).Text + Space(2) + _
                    Text3(0).Text + Space(2) + Text4(0).Text + Space(2) + _
                    Text5(0).Text + Space(2) + Text6(0).Text + Space(2) + _
                    Text7(0).Text + Space(2) + Text8(0).Text + Space(2) + _
                    Text9(0).Text + Space(2) + Text10(0).Text + Space(2) + _
                    Text11(0).Text + Space(2) + Text12(0).Text + Space(2) + _
                    Text13(0).Text + Space(2) + Text14(0).Text + Space(2) + _
                    Text15(0).Text + Space(2) + Text16(0).Text + Space(2) + _
                    Text17(0).Text + Space(2) + Text18(0).Text + Space(2) + _
                    Text19(0).Text + Space(2) + Text20.Text + Space(2) + _
                    Text21.Text + Space(2) + Text22.Text
                     
     Dim sstr(21) As String
     Dim dat(21) As Byte
    
     Dim h As Byte
    
     h = 0
     dat(0) = Val(Text1(0).Text)
     'Text_se.Text = dat(0)
     dat(1) = Val(Text2(0).Text)
     dat(2) = Val(Text3(0).Text)
     dat(3) = Val(Text4(0).Text)
     dat(4) = Val(Text5(0).Text)
     dat(5) = Val(Text6(0).Text)
     dat(6) = Val(Text7(0).Text)
     dat(7) = Val(Text8(0).Text)
     dat(8) = Val(Text9(0).Text)
     dat(9) = Val(Text10(0).Text)
     dat(10) = Val(Text11(0).Text)
     dat(11) = Val(Text12(0).Text)
     dat(12) = Val(Text13(0).Text)
     dat(13) = Val(Text14(0).Text)
     dat(14) = Val(Text15(0).Text)
     dat(15) = Val(Text16(0).Text)
     dat(16) = Val(Text17(0).Text)
     dat(17) = Val(Text18(0).Text)
     dat(18) = Val(Text19(0).Text)
     dat(19) = Val(Text20.Text)
     dat(20) = Val(Text21.Text)
     dat(21) = Val(Text22.Text)
     While h < 22
      sstr(h) = dat(h)
      h = h + 1
      Wend
      h = 0
      While h < 22
      If dat(h) < 16 Then
      sstr(h) = "0" & Hex(dat(h))
      End If
      If dat(h) >= 16 Then
      sstr(h) = Hex(dat(h))
      End If
      h = h + 1
      Wend
      h = 0
      While h < 22
      Text_se.Text = Text_se.Text & sstr(h) & Space(1)
      h = h + 1
      Wend

 
     Call sendarray
    
     pp = i & Space(2) & Text_se.Text
     i = i + 1
     jj = Trim(Text_se.Text)
    str = Text_se.Text
  If jj = "" Then
   X = MsgBox("发送不能为空", 16)
  Exit Sub
  End If

If Check1.Value = False Then                        ' 是否保存
    Dim file As Integer
    file = FreeFile
    Open "D:\zhu.txt" For Append As #file
    Print #file, pp
    Close #file
    List1.AddItem pp
End If

'发送
TimeDelay

'If Check3.Value = 1 Then                            '等待接收
''   Do
''   Timer1.Enabled = True                           '启动计数器
''      q = MSComm1.Input                            '接收
''   If aa = 5 Then                                  '五秒强制退出
''      Timer1.Enabled = False
''      Exit Do
''   End If
''
''   Loop Until q = "cf"                            '若接收为CF，退出
'      If j = 1 Then
'                 VScroll1.Value = VScroll1.Value + VScroll1.SmallChange  '滚动条值加一
'                 Text1(0).Text = VScroll1.Value
'                 Label23.BackColor = vbGreen
'                ' Text23.Text = Text1(0).Text
'               '  Call kkk(1)
'      End If
'
'End If
End Sub

Private Sub Command10_Click()
Dim str As String
    ' Static r As Integer
     d = List1.ListIndex
     str = Mid(List1.List(d), 4, 70)
     Text_se.Text = str
End Sub

Private Sub Command11_Click()
Call sendarray
End Sub

Private Sub Command12_Click()
  Call Command10_Click
     Text_se.Text = Trim(Text_se.Text)
      datio(0) = Val("&h" & Mid(Text_se.Text, 1, 3))
       datio(1) = Val("&h" & Mid(Text_se.Text, 4, 3))
        datio(2) = Val("&h" & Mid(Text_se.Text, 7, 3))
         datio(3) = Val("&h" & Mid(Text_se.Text, 10, 3))
     datio(4) = Val("&h" & Mid(Text_se.Text, 13, 3))
     datio(5) = Val("&h" & Mid(Text_se.Text, 16, 3))
     datio(6) = Val("&h" & Mid(Text_se.Text, 19, 3))
     datio(7) = Val("&h" & Mid(Text_se.Text, 22, 3))
     datio(8) = Val("&h" & Mid(Text_se.Text, 25, 3))
     datio(9) = Val("&h" & Mid(Text_se.Text, 28, 3))
     datio(10) = Val("&h" & Mid(Text_se.Text, 31, 3))
     datio(11) = Val("&h" & Mid(Text_se.Text, 34, 3))
     datio(12) = Val("&h" & Mid(Text_se.Text, 37, 3))
     datio(13) = Val("&h" & Mid(Text_se.Text, 40, 3))
     datio(14) = Val("&h" & Mid(Text_se.Text, 43, 3))
     datio(15) = Val("&h" & Mid(Text_se.Text, 46, 3))
     datio(16) = Val("&h" & Mid(Text_se.Text, 49, 3))
     datio(17) = Val("&h" & Mid(Text_se.Text, 52, 3))
     datio(18) = Val("&h" & Mid(Text_se.Text, 55, 3))
     datio(19) = Val("&h" & Mid(Text_se.Text, 58, 3))
     datio(20) = Val("&h" & Mid(Text_se.Text, 61, 3))
     datio(21) = Val("&h" & Mid(Text_se.Text, 64, 3))
     Text1(0).Text = Val(datio(0))
     Text2(0).Text = datio(1)
     Text3(0).Text = datio(2)
     Text4(0).Text = datio(3)
     Text5(0).Text = datio(4)
     Text6(0).Text = datio(5)
     Text7(0).Text = datio(6)
     Text8(0).Text = datio(7)
     Text9(0).Text = datio(8)
     Text10(0).Text = datio(9)
    Text11(0).Text = datio(10)
    Text12(0).Text = datio(11)
    Text13(0).Text = datio(12)
    Text14(0).Text = datio(13)
    Text15(0).Text = datio(14)
    Text16(0).Text = datio(15)
    Text17(0).Text = datio(16)
    Text18(0).Text = datio(17)
    Text19(0).Text = datio(18)
    Text20.Text = datio(19)
    Text21.Text = datio(20)
    Text22.Text = datio(21)
    

End Sub

Private Sub Command8_Click()
     Dim str As String
    ' Static r As Integer
     If Not r Then
     d = List1.ListIndex
     r = True
     End If
     str = Mid(List1.List(d), 4, 70)
     Text_se.Text = str
     d = d + 1
     If d >= i - 1 Then
     d = 0
     End If
End Sub

Private Sub Timer1_Timer()
  a1 = a1 + 1
  If a1 = 5 Then
    Call kkk
   ' Label23.BackColor = vbGreen
    VScroll1.Value = VScroll1.Value + VScroll1.SmallChange
    Text1(0).Text = VScroll1.Value
  End If
End Sub

Private Sub Timer10_Timer()
    Call kkk
         'Label23.BackColor = vbRed
         VScroll10.Value = VScroll10.Value + VScroll10.SmallChange
         Text10(0).Text = VScroll10.Value
End Sub

Private Sub Timer11_Timer()
           Call kkk
         'Label23.BackColor = vbRed
         VScroll11.Value = VScroll11.Value + VScroll11.SmallChange
         Text11(0).Text = VScroll11.Value
End Sub

Private Sub Timer12_Timer()
    Call kkk
         'Label23.BackColor = vbRed
         VScroll12.Value = VScroll12.Value + VScroll12.SmallChange
         Text12(0).Text = VScroll12.Value
End Sub

Private Sub Timer13_Timer()
    Call kkk
         'Label23.BackColor = vbRed
         VScroll13.Value = VScroll13.Value + VScroll13.SmallChange
         Text13(0).Text = VScroll13.Value
End Sub

Private Sub Timer14_Timer()
    Call kkk
         'Label23.BackColor = vbRed
         VScroll14.Value = VScroll14.Value + VScroll14.SmallChange
         Text14(0).Text = VScroll14.Value
End Sub

Private Sub Timer15_Timer()
    Call kkk
         'Label23.BackColor = vbRed
         VScroll15.Value = VScroll15.Value + VScroll15.SmallChange
         Text15(0).Text = VScroll15.Value
End Sub

Private Sub Timer16_Timer()
    Call kkk
         'Label23.BackColor = vbRed
         VScroll16.Value = VScroll16.Value + VScroll16.SmallChange
         Text16(0).Text = VScroll16.Value
End Sub

Private Sub Timer17_Timer()
    Call kkk
         'Label23.BackColor = vbRed
         VScroll17.Value = VScroll17.Value + VScroll17.SmallChange
         Text17(0).Text = VScroll17.Value
End Sub

Private Sub Timer18_Timer()
   Call kkk
         'Label23.BackColor = vbRed
         VScroll18.Value = VScroll18.Value + VScroll18.SmallChange
         Text18(0).Text = VScroll18.Value
End Sub

Private Sub Timer19_Timer()
    Call kkk
         'Label23.BackColor = vbRed
         VScroll19.Value = VScroll19.Value + VScroll19.SmallChange
         Text19(0).Text = VScroll19.Value
End Sub

Private Sub Timer2_Timer()
    a2 = a2 + 1
    If a2 = 5 Then
         Call kkk
         Label23.BackColor = vbRed
         VScroll2.Value = VScroll2.Value + VScroll2.SmallChange
         Text2(0).Text = VScroll2.Value
    End If
End Sub

Private Sub Timer3_Timer()
         Call kkk
         'Label23.BackColor = vbRed
         VScroll3.Value = VScroll3.Value + VScroll3.SmallChange
         Text3(0).Text = VScroll3.Value
End Sub

Private Sub Timer4_Timer()
         Call kkk
         'Label23.BackColor = vbRed
         VScroll4.Value = VScroll4.Value + VScroll4.SmallChange
         Text4(0).Text = VScroll4.Value
End Sub

Private Sub Timer5_Timer()
        Call kkk
         'Label23.BackColor = vbRed
         VScroll5.Value = VScroll5.Value + VScroll5.SmallChange
         Text5(0).Text = VScroll5.Value
End Sub

Private Sub Timer6_Timer()
     Call kkk
         'Label23.BackColor = vbRed
         VScroll6.Value = VScroll6.Value + VScroll6.SmallChange
         Text6(0).Text = VScroll6.Value
End Sub

Private Sub Timer7_Timer()
    Call kkk
         'Label23.BackColor = vbRed
         VScroll7.Value = VScroll7.Value + VScroll7.SmallChange
         Text7(0).Text = VScroll7.Value
End Sub

Private Sub Timer8_Timer()
    Call kkk
         'Label23.BackColor = vbRed
         VScroll8.Value = VScroll8.Value + VScroll8.SmallChange
         Text8(0).Text = VScroll8.Value
End Sub

Private Sub Timer9_Timer()
    Call kkk
         'Label23.BackColor = vbRed
         VScroll9.Value = VScroll9.Value + VScroll9.SmallChange
         Text9(0).Text = VScroll9.Value
End Sub

Private Sub VScroll1_Change()                     '滚动条触发
    Text1(0).Text = VScroll1.Value
    If Text1(0).Text = "" Then                    '文本框为空时
       VScroll1.Value = 0
    End If
   If Check2.Value = 1 Then                       '调试
      Call kkk
   End If                                         '调用发送子程序
      If Check3.Value = 1 Then
      'Call kkk
         Timer1.Enabled = True
         If Check4.Value = 1 Then
            Timer1.Enabled = False
         End If
         'VScroll1.Value = VScroll1.Value + VScroll1.SmallChange  '滚动条值加一
         'Text1(0).Text = VScroll1.Value
        ' Label23.BackColor = vbGreen
         'Text23.Text = Text1(0).Text
                'Call kkk
      End If
    a1 = 0
End Sub
Private Sub VScroll2_Change()
    Text2(0).Text = VScroll2.Value
    If Text2(0).Text = "" Then                    '文本框为空时
       VScroll2.Value = 0
    End If
    If Check2.Value = 1 Then
       Call kkk
    End If
     If Check3.Value = 1 Then
         Timer2.Enabled = True
         If Check4.Value = 1 Then
            Timer2.Enabled = False
         End If
     End If
     a2 = 0
End Sub

Private Sub Command1_Click()                      '发送
   Call kkk
End Sub

Private Sub Command2_Click()                       '列表框添加
  Dim t As String
  t = List1.List(List1.ListIndex)
  List1.AddItem t
 
End Sub

Private Sub Command3_Click() '    连续发送
       Call Command8_Click
       Call sendarray
End Sub
Public Sub send()
    Static k As Integer, t As String
    If Not p Then
   'k = 0
   k = List1.ListIndex
   p = True
   End If

   t = List1.List(k)
   t = Mid(t, 4)
   Text_se.Text = t
   t = Val(t)
   k = k + 1
   If Not MSComm1.PortOpen Then
   MSComm1.PortOpen = True
End If
   MSComm1.Output = t + Chr$(13)
'   For j = 1 To 20000000
'   Next
   TimeDelay
   If k = List1.ListCount Then
      k = 0
   End If
End Sub

Private Sub Command4_Click()                          '列表框删除
  Dim t As String
 List1.RemoveItem (List1.ListIndex)
' Dim j As Integer, k As Integer, t As String, s As Integer, r As String
' j = List1.ListCount - 2
' t = List1.List
' k = Val(Left(t, 1))
'
' For s = k To j
'   s = List1(List1.Index)
'   s = Replace(s, , k + 1, 1, 1)
'   List1.ListIndex.List = s
' Next
 
End Sub

Private Sub Command5_Click()                         ' 加载
  Dim t As String
Dim file1 As Integer, X As String
  file1 = FreeFile
  Open "D:\zhu.txt" For Input As #file1
  Do While Not EOF(file1)
     Line Input #file1, X
     List1.AddItem X
  Loop
  Close #file1
End Sub

Private Sub Command6_Click()
    End
End Sub

Private Sub Command7_Click()
   List1.Clear
End Sub

Private Sub Form_Load()
  MSComm1.CommPort = 1                                   ' 串口初始化
  MSComm1.Settings = "9600,N,8,1"
  MSComm1.InputLen = 0
  MSComm1.InBufferSize = 1024
  MSComm1.OutBufferSize = 512
  MSComm1.PortOpen = True
  MSComm1.SThreshold = 0
  MSComm1.RThreshold = 1
  MSComm1.InBufferCount = 0
  MSComm1.OutBufferCount = 0
  Text_se.Text = ""
  Frame2.BackColor = vbBlue
  Label1.ForeColor = vbRed
  Label2.ForeColor = vbRed
  Label3.ForeColor = vbRed
  Label4.ForeColor = vbRed
  Label5.ForeColor = vbRed
  Label6.ForeColor = vbRed
  Label7.ForeColor = vbRed
  Label8.ForeColor = vbRed
  Label9.ForeColor = vbRed
  Label10.ForeColor = vbRed
  Label11.ForeColor = vbRed
  Label12.ForeColor = vbRed
  Label13.ForeColor = vbRed
  Label14.ForeColor = vbRed
  Label15.ForeColor = vbRed
  Label16.ForeColor = vbRed
  Label17.ForeColor = vbRed
  Label18.ForeColor = vbRed
  Label19.ForeColor = vbRed
  Label7.BackColor = vbBlue
  Label15.BackColor = vbBlue
  Label14.BackColor = vbBlue
  Label6.BackColor = vbBlue
'  Dim file1 As Integer, X As String
'  file1 = FreeFile
'  Open "D:\zhu.txt" For Input As #file1
'  Do While Not EOF(file1)
'     Line Input #file1, X
'     List1.AddItem X
'  Loop
'  Close #file1
  Text1(0).Text = &H22
  Text2(0).Text = &H32
  Text3(0).Text = &HF
  Text4(0).Text = &H2A
  Text5(0).Text = &H3B
  Text6(0).Text = &H2A
  Text7(0).Text = &H12
  Text8(0).Text = &H4F
  Text9(0).Text = &H4E
  Text10(0).Text = &H55
  Text11(0).Text = &H35
  Text12(0).Text = &H47
  Text13(0).Text = &H1F
  Text14(0).Text = &H43
  Text15(0).Text = &H48
  Text16(0).Text = &H15
  Text17(0).Text = &H3C
  Text18(0).Text = &H17
  Text19(0).Text = &H30
  Text20.Text = 1
  Text21.Text = 0
   Text22.Text = 207
 
  Label1.FontSize = 10
End Sub

Public Sub TimeDelay()                             ' 延时
Dim n As Integer
Do While n <= 1000
n = n + 1
Loop
End Sub

Private Sub MSComm1_OnComm()
    Select Case MSComm1.CommEvent
        Case comEventOverrun
            Text_se.Text = ""
            Text_re.Text = ""
            Text_se.SetFocus
            Exit Sub
        Case comEventRxOver
            Text_se.Text = ""
            Text_re.Text = ""
            Text_se.SetFocus
            Exit Sub
        Case comEventTxFull
            Text_se.Text = ""
            Text_re.Text = ""
            Text_se.SetFocus
            Exit Sub
        Case comEvReceive
            Dim X1 As Variant
            Dim x2(0) As Byte
            Dim x3 As Byte
            X1 = MSComm1.Input
            x2(0) = AscB(X1)
            x3 = x2(0)
            Text23.Text = Hex(x2(0))
            If Check5.Value = ture Then
           
             If (x3 = &HCF Or x3 = &HEF) Then
              Call Command3_Click
              End If
            End If
              ' Call Command8_Click
               'Call sendarray
          
    End Select
End Sub

Private Sub Text1_Change(Index As Integer)
    VScroll1.Value = Text1(0).Text
    If Text1(0).Text = "" Then
       VScroll1.Value = 0
       MsgBox "  FKSJFKLSJ"
    End If
    If Text1(0).Text > 200 Or Text1(0).Text < 0 Then
       MsgBox "输入超出范围,请重新输入"
       Text1(0).SetFocus
       Text1(0).SelStart = 0
       Text1(0).SelLength = Len(Text1(0))
    End If
   
End Sub

Private Sub Text10_Change(Index As Integer)
    VScroll10.Value = Text10(0).Text
    If Text10(0).Text = "" Then
       VScroll10.Value = 0
    End If
    If Text10(0).Text > 200 Or Text10(0).Text < 0 Then
       MsgBox "输入超出范围,请重新输入"
       Text10(0).SetFocus
       Text10(0).SelStart = 0
       Text10(0).SelLength = Len(Text10(0))
    End If
End Sub

Private Sub Text11_Change(Index As Integer)
    VScroll11.Value = Text11(0).Text
    If Text11(0).Text = "" Then
       VScroll11.Value = 0
    End If
    If Text11(0).Text > 200 Or Text11(0).Text < 0 Then
       MsgBox "输入超出范围,请重新输入"
       Text11(0).SetFocus
       Text11(0).SelStart = 0
       Text11(0).SelLength = Len(Text11(0))
    End If
End Sub

Private Sub Text12_Change(Index As Integer)
    VScroll12.Value = Text12(0).Text
    If Text12(0).Text = "" Then
       VScroll12.Value = 0
    End If
    If Text12(0).Text > 200 Or Text12(0).Text < 0 Then
       MsgBox "输入超出范围,请重新输入"
       Text12(0).SetFocus
       Text12(0).SelStart = 0
       Text12(0).SelLength = Len(Text12(0))
    End If
End Sub

Private Sub Text13_Change(Index As Integer)
    VScroll13.Value = Text13(0).Text
    If Text13(0).Text = "" Then
       VScroll13.Value = 0
    End If
    If Text13(0).Text > 200 Or Text13(0).Text < 0 Then
       MsgBox "输入超出范围,请重新输入"
       Text13(0).SetFocus
       Text13(0).SelStart = 0
       Text13(0).SelLength = Len(Text13(0))
    End If
End Sub

Private Sub Text14_Change(Index As Integer)
    VScroll14.Value = Text14(0).Text
    If Text14(0).Text = "" Then
       VScroll14.Value = 0
    End If
    If Text14(0).Text > 200 Or Text14(0).Text < 0 Then
       MsgBox "输入超出范围,请重新输入"
       Text14(0).SetFocus
       Text14(0).SelStart = 0
       Text14(0).SelLength = Len(Text14(0))
    End If
End Sub

Private Sub Text15_Change(Index As Integer)
    VScroll15.Value = Text15(0).Text
    If Text15(0).Text = "" Then
       VScroll15.Value = 0
    End If
    If Text15(0).Text > 200 Or Text15(0).Text < 0 Then
       MsgBox "输入超出范围,请重新输入"
       Text15(0).SetFocus
       Text15(0).SelStart = 0
       Text15(0).SelLength = Len(Text15(0))
    End If
End Sub

Private Sub Text16_Change(Index As Integer)
   VScroll16.Value = Text16(0).Text
   If Text16(0).Text = "" Then
       VScroll16.Value = 0
    End If
    If Text16(0).Text > 200 Or Text16(0).Text < 0 Then
       MsgBox "输入超出范围,请重新输入"
       Text16(0).SetFocus
       Text16(0).SelStart = 0
       Text16(0).SelLength = Len(Text16(0))
    End If
End Sub

Private Sub Text17_Change(Index As Integer)
   VScroll17.Value = Text17(0).Text
   If Text17(0).Text = "" Then
       VScroll17.Value = 0
    End If
    If Text17(0).Text > 200 Or Text17(0).Text < 0 Then
       MsgBox "输入超出范围,请重新输入"
       Text17(0).SetFocus
       Text17(0).SelStart = 0
       Text17(0).SelLength = Len(Text17(0))
    End If
End Sub

Private Sub Text18_Change(Index As Integer)
   VScroll18.Value = Text18(0).Text
   If Text18(0).Text = "" Then
       VScroll18.Value = 0
    End If
    If Text18(0).Text > 200 Or Text18(0).Text < 0 Then
       MsgBox "输入超出范围,请重新输入"
       Text18(0).SetFocus
       Text18(0).SelStart = 0
       Text18(0).SelLength = Len(Text18(0))
    End If
End Sub

Private Sub Text19_Change(Index As Integer)
   VScroll19.Value = Text19(0).Text
   If Text19(0).Text = "" Then
       VScroll19.Value = 0
    End If
    If Text19(0).Text > 200 Or Text19(0).Text < 0 Then
       MsgBox "输入超出范围,请重新输入"
       Text19(0).SetFocus
       Text19(0).SelStart = 0
       Text19(0).SelLength = Len(Text19(0))
    End If
End Sub

Private Sub Text2_Change(Index As Integer)
    VScroll2.Value = Text2(0).Text
    If Text2(0).Text = "" Then
       VScroll2.Value = 0
    End If
    If Text2(0).Text > 200 Or Text2(0).Text < 0 Then
       MsgBox "输入超出范围,请重新输入"
       Text2(0).SetFocus
       Text2(0).SelStart = 0
       Text2(0).SelLength = Len(Text2(0))
    End If
End Sub

Private Sub Text3_Change(Index As Integer)
    VScroll3.Value = Text3(0).Text
    If Text3(0).Text = "" Then
       VScroll3.Value = 0
    End If
    If Text3(0).Text > 200 Or Text3(0).Text < 0 Then
       MsgBox "输入超出范围,请重新输入"
       Text3(0).SetFocus
       Text3(0).SelStart = 0
       Text3(0).SelLength = Len(Text3(0))
    End If
End Sub

Private Sub Text4_Change(Index As Integer)
    VScroll4.Value = Text4(0).Text
    If Text4(0).Text = "" Then
       VScroll4.Value = 0
    End If
    If Text4(0).Text > 200 Or Text4(0).Text < 0 Then
       MsgBox "输入超出范围,请重新输入"
       Text4(0).SetFocus
       Text4(0).SelStart = 0
       Text4(0).SelLength = Len(Text4(0))
    End If
End Sub

Private Sub Text5_Change(Index As Integer)
    VScroll5.Value = Text5(0).Text
    If Text5(0).Text = "" Then
       VScroll5.Value = 0
    End If
    If Text5(0).Text > 200 Or Text5(0).Text < 0 Then
       MsgBox "输入超出范围,请重新输入"
       Text5(0).SetFocus
       Text5(0).SelStart = 0
       Text5(0).SelLength = Len(Text5(0))
    End If
End Sub

Private Sub Text6_Change(Index As Integer)
   VScroll6.Value = Text6(0).Text
   If Text6(0).Text = "" Then
       VScroll6.Value = 0
    End If
    If Text6(0).Text > 200 Or Text6(0).Text < 0 Then
       MsgBox "输入超出范围,请重新输入"
       Text6(0).SetFocus
       Text6(0).SelStart = 0
       Text6(0).SelLength = Len(Text6(0))
    End If
End Sub

Private Sub Text7_Change(Index As Integer)
   VScroll7.Value = Text7(0).Text
   If Text7(0).Text = "" Then
       VScroll7.Value = 0
    End If
    If Text7(0).Text > 200 Or Text7(0).Text < 0 Then
       MsgBox "输入超出范围,请重新输入"
       Text7(0).SetFocus
       Text7(0).SelStart = 0
       Text7(0).SelLength = Len(Text7(0))
    End If
End Sub

Private Sub Text8_Change(Index As Integer)
   VScroll8.Value = Text8(0).Text
   If Text8(0).Text = "" Then
       VScroll8.Value = 0
    End If
    If Text8(0).Text > 200 Or Text8(0).Text < 0 Then
       MsgBox "输入超出范围,请重新输入"
       Text8(0).SetFocus
       Text8(0).SelStart = 0
       Text8(0).SelLength = Len(Text8(0))
    End If
End Sub

Private Sub Text9_Change(Index As Integer)
   VScroll9.Value = Text9(0).Text
   If Text9(0).Text = "" Then
       VScroll9.Value = 0
    End If
    If Text9(0).Text > 200 Or Text9(0).Text < 0 Then
       MsgBox "输入超出范围,请重新输入"
       Text9(0).SetFocus
       Text9(0).SelStart = 0
       Text9(0).SelLength = Len(Text9(0))
    End If
End Sub

Private Sub VScroll10_Change()
    Text10(0).Text = VScroll10.Value
     If Check2.Value = 1 Then
      Call kkk
    End If
       If Check3.Value = 1 Then
         Timer10.Enabled = True
         If Check4.Value = 1 Then
            Timer10.Enabled = False
         End If
     End If
   
End Sub

Private Sub VScroll11_Change()
    Text11(0).Text = VScroll11.Value
     If Check2.Value = 1 Then
      Call kkk
   End If
      If Check3.Value = 1 Then
         Timer11.Enabled = True
         If Check4.Value = 1 Then
            Timer11.Enabled = False
         End If
     End If
End Sub
'
Private Sub VScroll12_Change()
    Text12(0).Text = VScroll12.Value
   If Check2.Value = 1 Then
      Call kkk
   End If
      If Check3.Value = 1 Then
         Timer12.Enabled = True
         If Check4.Value = 1 Then
            Timer12.Enabled = False
         End If
     End If
End Sub

Private Sub VScroll13_Change()
    Text13(0).Text = VScroll13.Value
    If Check2.Value = 1 Then
       Call kkk
    End If
       If Check3.Value = 1 Then
         Timer13.Enabled = True
         If Check4.Value = 1 Then
            Timer13.Enabled = False
         End If
     End If
 
End Sub

Private Sub VScroll14_Change()
    Text14(0).Text = VScroll14.Value
    If Check2.Value = 1 Then
       Call kkk
    End If
       If Check3.Value = 1 Then
         Timer14.Enabled = True
         If Check4.Value = 1 Then
            Timer14.Enabled = False
         End If
     End If
End Sub

Private Sub VScroll15_Change()
    Text15(0).Text = VScroll15.Value
    If Check2.Value = 1 Then
       Call kkk
    End If
       If Check3.Value = 1 Then
         Timer15.Enabled = True
         If Check4.Value = 1 Then
            Timer15.Enabled = False
         End If
     End If
End Sub

Private Sub VScroll16_Change()
    Text16(0).Text = VScroll16.Value
    If Check2.Value = 1 Then
       Call kkk
    End If
       If Check3.Value = 1 Then
         Timer16.Enabled = True
         If Check4.Value = 1 Then
            Timer16.Enabled = False
         End If
     End If
End Sub

Private Sub VScroll17_Change()
    Text17(0).Text = VScroll17.Value
    If Check2.Value = 1 Then
       Call kkk
    End If
       If Check3.Value = 1 Then
         Timer17.Enabled = True
         If Check4.Value = 1 Then
            Timer17.Enabled = False
         End If
     End If
End Sub

Private Sub VScroll18_Change()
    Text18(0).Text = VScroll18.Value
    If Check2.Value = 1 Then
       Call kkk
    End If
       If Check3.Value = 1 Then
         Timer18.Enabled = True
         If Check4.Value = 1 Then
            Timer18.Enabled = False
         End If
     End If
End Sub

Private Sub VScroll19_Change()
    Text19(0).Text = VScroll19.Value
    If Check2.Value = 1 Then
       Call kkk
    End If
       If Check3.Value = 1 Then
         Timer19.Enabled = True
         If Check4.Value = 1 Then
            Timer19.Enabled = False
         End If
     End If
End Sub

Private Sub VScroll3_Change()
    Text3(0).Text = VScroll3.Value
    If Check2.Value = 1 Then
       Call kkk
    End If
       If Check3.Value = 1 Then
         Timer3.Enabled = True
         If Check4.Value = 1 Then
            Timer3.Enabled = False
         End If
     End If
End Sub

Private Sub VScroll4_Change()
    Text4(0).Text = VScroll4.Value
    If Check2.Value = 1 Then
       Call kkk
    End If
       If Check3.Value = 1 Then
         Timer4.Enabled = True
         If Check4.Value = 1 Then
            Timer4.Enabled = False
         End If
     End If
End Sub

Private Sub VScroll5_Change()
    Text5(0).Text = VScroll5.Value
    If Check2.Value = 1 Then
       Call kkk
    End If
       If Check3.Value = 1 Then
         Timer5.Enabled = True
         If Check4.Value = 1 Then
            Timer5.Enabled = False
         End If
     End If
End Sub

Private Sub VScroll6_Change()
    Text6(0).Text = VScroll6.Value
    If Check2.Value = 1 Then
       Call kkk
    End If
       If Check3.Value = 1 Then
         Timer6.Enabled = True
         If Check4.Value = 1 Then
            Timer6.Enabled = False
         End If
     End If
End Sub

Private Sub VScroll7_Change()
    Text7(0).Text = VScroll7.Value
    If Check2.Value = 1 Then
       Call kkk
    End If
       If Check3.Value = 1 Then
         Timer7.Enabled = True
         If Check4.Value = 1 Then
            Timer7.Enabled = False
         End If
     End If
End Sub

Private Sub VScroll8_Change()
    Text8(0).Text = VScroll8.Value
    If Check2.Value = 1 Then
       Call kkk
    End If
       If Check3.Value = 1 Then
         Timer8.Enabled = True
         If Check4.Value = 1 Then
            Timer8.Enabled = False
         End If
     End If
End Sub

Private Sub VScroll9_Change()
    Text9(0).Text = VScroll9.Value
    If Check2.Value = 1 Then
       Call kkk
    End If
       If Check3.Value = 1 Then
         Timer9.Enabled = True
         If Check4.Value = 1 Then
            Timer9.Enabled = False
         End If
     End If
End Sub

程序还是有点乱，如果需要只是简单的VB和单片机通讯的程序的可以在BLOG里留言！

谢谢大家支持！