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