0914.txt

196kc作为下微机

Private Declare Function GetTickCount Lib "kernel32" _
() As Long
Public Sub TimeDelay(DT As Long)
  Dim tt As Long
  tt = GetTickCount()
  Do
    DoEvents
  Loop Until GetTickCount - tt >= DT
  
End Sub
Public Sub Send_Data(hh As Integer)
Dim mysend() As Byte
Dim sendbyte(1)  As Byte
Dim tempstr As String
Dim in_num As Integer

tempstr = Text1.Text
in_num = Len(tempstr)
ReDim mysend(1 To in_num) As Byte
For i = 1 To in_num
mysend(i) = Asc(Mid(tempstr, i, 1))
Next i


For ii = 1 To in_num
    sendbyte(0) = mysend(ii)
    MSComm1.Output = sendbyte '一个字节一发送    'mysend一串发'
    'TimeDelay (1)
    Shape1.FillColor = vbGreen
Next ii
    Shape1.FillColor = vbWhite
    
Text2.Text = Val(Text2.Text) + in_num

If Val(Text2.Text) > 100 Then
    Timer1.Enabled = False
    Text1.Text = "单片机存储超量,程序自动停止发送,请手动复位单片机"
    Shape1.FillColor = vbRed
    SendOverFg = True
End If

End Sub

Private Sub Check1_Click()
Dim sendhead(1) As Byte
If Check1.Value = 1 Then
    Timer1.Enabled = True
    Timer1.Interval = Val(Text3.Text) * 20
    
Else
    Timer1.Enabled = False
    
End If
End Sub

Private Sub Command3_Click() '已复位按钮

If SendOverFg = True Then
   Text2.Text = ""
   Text1.Text = InitialStr
   Shape1.FillColor = vbGreen
   SendOverFg = False
End If
   

End Sub

Private Sub Timer1_Timer()
Dim sendhead(1) As Byte
   'Dim timer1Fg As Boolean
   'If timer1Fg = False Then
   '   timer1Fg = True
   'End If
   'If timer1Fg = True Then
  
   sendhead(0) = 97 'a
    MSComm1.Output = sendhead
    TimeDelay (10)     '延时等待单片机执行完8个周期
    Send_Data (1)
 'End If
'Text2.Text = Val(Text2.Text) + Val(Text3.Text)'发送的字节数

End Sub


Private Sub Command1_Click()  'Private
Dim sendhead(1) As Byte
sendhead(0) = 97 'a
MSComm1.Output = sendhead
TimeDelay (500)     '延时等待单片机执行完8个周期
Send_Data (1)

End Sub

Private Sub Command2_Click()
Text_r.Text = ""
End Sub

Private Sub Form_Load() 'Private

MSComm1.Settings = "9600,n,8,1"
MSComm1.InputLen = 0
MSComm1.InBufferSize = 512
MSComm1.InBufferCount = 0
MSComm1.OutBufferSize = 512
MSComm1.OutBufferCount = 0
MSComm1.RThreshold = 1
MSComm1.SThreshold = 0
MSComm1.PortOpen = True

SendOverFg = False
InitialStr = "123456789z"

Check1.Value = 0
Timer1.Enabled = False
Text1.Text = InitialStr  '"123456789z"
End Sub

Private Sub Form_Unload(Cancel As Integer)
MSComm1.PortOpen = False
Text1.Text = ""
Text2.Text = ""
End Sub


Private Sub MSComm1_OnComm()
    Dim S() As Byte
    Dim SS(1024) As Byte
    Static N As Long
    Static T As Variant
 Select Case MSComm1.CommEvent
    Case comEvReceive

    S = MSComm1.Input
      If Check_hex.Value = 1 Then
        For i = 0 To UBound(S)               '一个数据包可能产生若干个oncomm事件
            Text_r.Text = Text_r.Text & Trim(Hex(S(i))) + " " 'Str(i) + "//"
            SS(N + i) = S(i)                 '接收数据包缓存于SS()
            N = N + UBound(S)
        Next i
      Else
        For j = 0 To UBound(S)               '一个数据包可能产生若干个oncomm事件
            Text_r.Text = Text_r.Text & Chr(S(j)) + " " 'Str(j) + "//"
            SS(N + j) = S(j)                 '接收数据包缓存于SS()
            N = N + UBound(S)
        Next j
      End If
    Case Else
   End Select
   
'    If (MSComm1.CommEvent = comEvReceive) Then
 '       S = MSComm1.Input                           '只要有数据就收进来，哪怕只是一个
  '      If (Timer - T > 0.3) Then  '不能小于0.3'0.01'间隔10MS以上就认为是一个新的包,
   '         Text_r = "*"                            '所以清空了显示窗口中的接收数据和N
    '        N = 0                                   'text_r用于搜集和显示接收(HEX格式)
     '   End If
      '  T = Timer
       ' For i = 0 To UBound(S)               '一个数据包可能产生若干个oncomm事件
        '    Text_r.Text = Text_r.Text & Trim(Hex(S(i))) + " "
         '   'Text_r.Text = Text_r.Text & Right("0" & Hex(S(i)) & "H", 3) + " "
          '  SS(N + i) = S(i)                 '接收数据包缓存于SS()
           ' N = N + UBound(S)
       ' Next i
   ' End If


End Sub