主程序: Option Explicit Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long Public com1 As New XXXXXXXXXXXXComm Public y0Stt As Boolean Public y0_on As Boolean Public tmrFlag As Boolean Public tmr As Long Sub runn() On Error GoTo ed XXXXXXXttings = "9600,e,8,1" If com1.PortOpen = False Then com1.PortOpen = True End If tmr = SetTimer(0, 0, 500, AddressOf ontimer) Exit Sub ed: MsgBox "串口打开错误!" End Sub Sub stopp() If com1.PortOpen = True Then com1.PortOpen = False KillTimer 0, tmr End If End Sub Public Function ontimer() Dim a(7) As Byte Dim add As Long On Error GoTo ed If tmrFlag = False Then tmrFlag = True If y0_on = True Then y0_on = False If y0Stt = True Then a(0) = &H1 a(1) = &H5 a(2) = &H0 a(3) = &H0 a(4) = &HFF a(5) = &H0 a(6) = &H8C a(7) = &H3A com1.Output = a add = 0 Do DoEvents Sleep 10 add = add + 1 If add >= 100 Then Exit Do End If Loop Until XXXXXXXBufferCount >= 8 Else a(0) = &H1 a(1) = &H5 a(2) = &H0 a(3) = &H0 a(4) = &H0 a(5) = &H0 a(6) = &HCD a(7) = &HCA com1.Output = a add = 0 Do DoEvents Sleep 10 add = add + 1 If add >= 100 Then Exit Do End If Loop Until XXXXXXXBufferCount >= 8 End If End If End If tmrFlag = False Exit Function ed: MsgBox "串口错误!" tmrFlag = False End Function
界面程序: Private Sub cmd1_Click() y0_on = True y0Stt = Not y0Stt End Sub Private Sub cmdRun_Click() runn XXXXXXXXXXXXlue = 1 End Sub Private Sub cmdStop_Click() stopp XXXXXXXXXXXXlue = 0 End Sub