主程序： 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 MSCommLib.MSComm Public y0Stt As Boolean Public y0_on As Boolean Public tmrFlag As Boolean Public tmr As Long Sub runn() On Error GoTo ed com1.Settings = "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 "串口打開錯(cuò)誤！" 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 com1.InBufferCount >= 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 com1.InBufferCount >= 8 End If End If End If tmrFlag = False Exit Function ed: MsgBox "串口錯(cuò)誤！" tmrFlag = False End Function
界面程序： Private Sub cmd1_Click() y0_on = True y0Stt = Not y0Stt End Sub Private Sub cmdRun_Click() runn CheckBox1.Value = 1 End Sub Private Sub cmdStop_Click() stopp CheckBox1.Value = 0 End Sub
