Private Sub Command8_Click()
Dim cmd(0 To 2) As Byte
cmd(0) = &H2
cmd(1) = &H8
cmd(2) = &H1
MSComm1.Output = cmd
End Sub如上。我往串口写命令的时候。画面会卡住几秒。之后正常。写入也成功、
我接收数据的代码写在定时器在。这个是什么原因?
如图。红色部分是有一个label。被卡没了。写命令反应很慢。但是有得命令又很快

解决方案 »

  1.   

    猜想;卡有可能是某些事件占用了你的CPU,比如说在你界面上,定时器程序中标签是否重绘了,我以前碰到过就是在发送或者接收的时候把数据发或者接一次就在textbox里面显示一次,导致一卡一卡的,后来改成在内存中处理完了再显示出来就好很多。
      

  2.   

    Dim comFlag As Long '打开关闭串口按钮标记
    Dim flag As Long
    Dim result As String'屏蔽窗口的关闭按钮
    Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
    Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
    Private Const MF_REMOVE = &H1000
    Private Const SC_CLOSE = &HF060
    '打开串口函数
    Private Declare Function InitDev Lib "Lib980.dll" (ByVal comport As Byte, ByVal baudrate As Long) As Byte
    '关闭串口函数
    Private Declare Sub DelDev Lib "Lib980.dll" ()
    '发送命令函数
    Private Declare Function SerSend Lib "Lib980.dll" (ByVal portNo As Long, ByVal cmd As Byte) As Long
    '接收命令函数
    Private Declare Function SerRecv Lib "Lib980.dll" (ByVal portNo As Long, ByVal data As Long, ByVal timeout As Long) As Long
    Private Sub Command1_Click()
    Dim comport As Byte
    Dim baudrate As Long
    Dim  As Byte
    Dim status As Long
    'Dim cmd As Byte
    'Dim data(0 To 300) As Byte
    'Dim timeout As Long
    'Dim portNo As Long
    'portNo = 0
    'timeout = 5000
    'cmd = CByte("0105")
    comFlag = comFlag + 1
    comport = CByte(Combo1.Text)
    baudrate = CLng(Combo2.Text)
    If (comFlag Mod 2 = 0) Then
    Command1.Caption = "打开串口"
    'DelDev
    Command2.Enabled = True
    Command3.Enabled = False
    Command4.Enabled = False
    Command5.Enabled = False
    Command6.Enabled = False
    Command7.Enabled = False
    Command8.Enabled = False
    Command10.Enabled = False
    Command11.Enabled = False
    Command12.Enabled = False
      Timer1.Enabled = False
      MSComm1.PortOpen = False
      Shape1.FillColor = &H808080
      Label5.Caption = ""
    Else
    Command1.Caption = "关闭串口"
    ' = InitDev(comport, baudrate)
    MSComm1.CommPort = comport
    MSComm1.Settings = CStr(baudrate) + ",n,8,1"
    MSComm1.PortOpen = True
    Timer1.Enabled = True
    Shape1.FillColor = &HC000&
    Label5.Caption = "请刷卡       >>>"
    Command2.Enabled = False
    Command3.Enabled = True
    Command4.Enabled = True
    Command5.Enabled = True
    Command6.Enabled = True
    Command7.Enabled = True
    Command8.Enabled = True
    Command10.Enabled = True
    Command11.Enabled = True
    Command12.Enabled = True
    'If ( = 0) Then
    'Text1.Text = "串口<" + CStr(Combo2.Text) + ">初始化成功!"
    'status = SerSend(portNo, cmd)
    'status = SerRecv(portNo, VarPtr(data(0)), timeout)
    'Text1.Text = Hex(data(0))
    'Else
    'Text1.Text = "串口已被占用!"
    'End If
    End If
    End Sub
    Private Sub Command10_Click()
    Timer1.Enabled = False
    Dim cmd(0 To 2) As Byte
    cmd(0) = &H2
    cmd(1) = &H8
    cmd(2) = &H2
    MSComm1.Output = cmd
    Timer1.Enabled = True
    End Sub
    Private Sub Command11_Click()
    Timer1.Enabled = False
    Dim cmd(0 To 2) As Byte
    cmd(0) = &H2
    cmd(1) = &H8
    cmd(2) = &H3
    MSComm1.Output = cmd
    Timer1.Enabled = True
    End Sub
    Private Sub Command12_Click()
    Timer1.Enabled = False
    Dim cmd(0 To 1) As Byte
    cmd(0) = &H1
    cmd(1) = &H4
    MSComm1.Output = cmdTimer1.Enabled = True
    End Sub
    Private Sub Command2_Click()
    Unload Form1
    End Sub
    Private Sub Command3_Click()
    Timer1.Enabled = False
    Dim cmd(0 To 1) As Byte
    cmd(0) = &H1
    cmd(1) = &H5
    MSComm1.Output = cmd
    Timer1.Enabled = True
    End Sub
    Private Sub Command4_Click()
    Timer1.Enabled = False
    Dim cmd(0 To 1) As Byte
    cmd(0) = &H1
    cmd(1) = &H1
    MSComm1.Output = cmd
    Timer1.Enabled = True
    End Sub
    Private Sub Command5_Click()
    Timer1.Enabled = False
    Dim cmd(0 To 1) As Byte
    cmd(0) = &H1
    cmd(1) = &H6
    MSComm1.Output = cmd
    Timer1.Enabled = True
    End Sub
    Private Sub Command6_Click()
    Timer1.Enabled = False
    Dim cmd(0 To 1) As Byte
    cmd(0) = &H1
    cmd(1) = &H3
    MSComm1.Output = cmd
    Timer1.Enabled = True
    End Sub
    Private Sub Command7_Click()
    If (Text1.Text = "" Or Text1.Text = Null) Then
    MsgBox ("请输入命令!")
    Else
    'Timer1.Enabled = False
    Dim cmd(0 To 49) As Byte
    '命令处理
    Dim str() As String
    Dim strLength As Integer
    Dim flag As Boolean
     str = Split(Text1.Text, " ")
     strLength = UBound(str) - LBound(str) + 1
      For i = 0 To (strLength - 1)
         If (Len(str(i)) <> 2) Then
          Label4.ForeColor = &HFF&
        Label4.Caption = "命令格式错误、正确格式:xx xx xx......!"
         flag = True
         Exit For
         Else
         Label4.Caption = ""
         cmd(i) = str(i)
        End If
     Next i
    '
    If (flag = False) Then
    MSComm1.Output = cmd
    End If
    'Timer1.Enabled = True
    End If
    End Sub
    Private Sub Command8_Click()
    Timer1.Enabled = False
    Dim cmd(0 To 2) As Byte
    cmd(0) = &H2
    cmd(1) = &H8
    cmd(2) = &H1
    MSComm1.Output = cmd
    Timer1.Enabled = True
    End Sub
    Private Sub Command9_Click()
    Text2.Text = ""
    result = ""
    End Sub
    Private Sub Form_Load()
    Disabled Me.hwnd
    Command3.Enabled = False
    Command4.Enabled = False
    Command5.Enabled = False
    Command6.Enabled = False
    Command7.Enabled = False
    Command8.Enabled = False
    Command10.Enabled = False
    Command11.Enabled = False
    Command12.Enabled = False
    Option1.Value = TrueCombo1.AddItem (1)
    Combo1.AddItem (2)
    Combo1.AddItem (3)
    Combo1.AddItem (4)
    Combo1.AddItem (5)
    Combo1.AddItem (6)
    Combo1.AddItem (9)
    Combo1.ListIndex = 3
    Combo2.AddItem (9600)
    Combo2.AddItem (115200)
    Combo2.ListIndex = 0
    Command1.Caption = "打开串口"
    Timer1.Enabled = False
    Timer1.Interval = 1000
    If (MSComm1.PortOpen = True) Then
    MSComm1.PortOpen = False
    MSComm1.InBufferCount = 0
    Shape1.FillColor = &HC000&
    End If
    End Sub
    Private Sub Option1_Click()
    If (MSComm1.PortOpen = True) Then
    MSComm1.InputMode = comInputModeText
    Text2.Text = ""
    result = ""
    End If
    End Sub
    Private Sub Option2_Click()
    If (MSComm1.PortOpen = True) Then
    MSComm1.InputMode = comInputModeBinary
    Text2.Text = ""
    result = ""
    End If
    End Sub
    Private Sub Text1_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
           Case 8, 32, Asc("0") To Asc("9")
           Label4.Caption = ""
           Case Asc("a") To Asc("f")
           Label4.Caption = ""
           Case Asc("A") To Asc("F")
           Label4.Caption = ""
           Case Else
            KeyAscii = 0
            Label4.ForeColor = &HFF&
          Label4.Caption = "您输入了不属于十六进制的字符!"
    End Select
    End Sub
    Private Sub Timer1_Timer()
    Dim strBuff As String
    Dim BytReceived() As Byte
    flag = flag + 1
    If (flag Mod 3 = 0) Then
    Label5.Caption = "请刷卡    >>>"
    ElseIf (flag Mod 3 = 1) Then
    Label5.Caption = "请刷卡  >>>"
    Else
    Label5.Caption = "请刷卡>>>"
    End If
    MSComm1.InputLen = 0
    strBuff = MSComm1.Input
    If (strBuff <> Null Or strBuff <> "") Then
    MsgBox (strBuff)
      If (Option1.Value = True) Then
      result = strBuff
      Text2.Text = Text2.Text + result
      End If
      If (Option2.Value = True) Then
      BytReceived() = strBuff
          For i = 0 To UBound(BytReceived)
              If Len(Hex(BytReceived(i))) = 1 Then
              result = result & "0" & Hex(BytReceived(i)) & " " '如果只有一个字符,则前补0,如F显示0F,最后补空格
              Else
              result = result & Hex(BytReceived(i)) & " " '方便显示观察如: 00 0F FE
              End If
         Next
         Text2.Text = result
      End If
    End IfEnd Sub
    '屏蔽窗口的关闭按钮
    Function Disabled(ChWnd As Long)
    Dim hMenu, hendMenu As Long
    Dim c As Long
    hMenu = GetSystemMenu(ChWnd, 0)
    RemoveMenu hMenu, SC_CLOSE, MF_REMOVE
    End Function
    代码全贴上了、奇怪的是只有部分命令卡、但不是硬件问题。因为我用STC串口工具。反应很快