我在使用Mscomm控件时,有时会出现”端口已打开“错误,这时候必须从新启动计算机,否则永远无法打开该串口。 1、串口上只接有一个显示仪表,平时就直接读取该仪表的显示值。平时不出错,一般2、3个星期才出现一次。该计算机一天工作一般为12小时。 2、平时不用的时候,偶就把串口关闭,要读取的时候,才打开。一般10分钟开关一次。 3、打开与关闭语句如下:
if mscomm1.portopen then mscomm1.portopen=false '关闭串口
if mscomm1.portopen=false then mscomm1.portopen=true '打开串口
4、我在调试时,曾经捕捉到过该错误,此时Mscomm1端口状态为false,但是,在执行后面的打开操作时,就提示该端口已打开错误。这些搞的我很头疼,用户也有意见,望各位达人能帮帮小弟!
if mscomm1.portopen then mscomm1.portopen=false '关闭串口
if mscomm1.portopen=false then mscomm1.portopen=true '打开串口
4、我在调试时,曾经捕捉到过该错误,此时Mscomm1端口状态为false,但是,在执行后面的打开操作时,就提示该端口已打开错误。这些搞的我很头疼,用户也有意见,望各位达人能帮帮小弟!
2.Mscomm代码初始化之前先加上if mscomm1.portopen then mscomm1.portopen=false
试试看!
2.设置串口的初始化,setting,commport,RThreadhold等等。
3.设置完后if mscomm1.portopen =false then mscomm1.portopen=true
....
else
....
end if
最开始是因为别得程序占用了串口,用
if mscomm1.portopen then mscomm1.portopen=false 是关闭不掉得
后来改为:
on error goto exit1
if mscomm1.portopen then mscomm1.portopen=false
exit sub
exit1:
串口已经被别得程序打开,请正确设定通讯参数!
建议楼主加几个错误处理语句,多判断几次,看是否好转!
而且平时是用exe文件运行的,不是调试方式,只有出现该错误提示后才会退出我的执行程序。
偶记得最讨厌的是我在现场的时候怎么也不出现这样的问题,等偶刚登机的时候,出问题了
后来偶干脆给它弄了个98系统,呵呵,瞧,用到现在也不出现问题了。:)真是奇怪&岂有此理
我在窗体上放了一个WebBrowser控件,就可以浏览网站了,但是网站有一些弹出的窗体,却使用了系统默认的浏览器,既使用的IE作为弹出窗体的浏览器了。
XTGN1000.L_val = CDbl(LJ) + CDbl(PZ) '最小净重值,设置仪表的最小值(即临界值)
XTGN1000.Start '打开称重接口,跟仪表通讯 XTGN1000.Over '关闭通讯接口
偶编译了一个OCX控件,其中包含一个MSComm1控件和一个Label1控件,控件名为XTGN1000;代码如下:
其中Start和Over为控件的方法,Start为启动控件跟仪表进行通讯,Over为结束通讯。该控件的caption即为仪表的显示值。
Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As LongDim RBuf
Dim Flag As Boolean
Dim ST As Boolean
'缺省属性值:
Const m_def_State = 0
Const m_def_L_val = 0
Const m_def_Err_num = 0
'属性变量:
Dim m_State As Boolean
Dim m_L_val As Single
Dim m_Err_num As Integer
'事件声明:
Event Error()
Event OnLoad()
Event OffLoad()
Private Sub My_Delay(Num As Long)
Dim T As Long
Dim B As Long
Dim Exit_Flag As Boolean
Exit_Flag = False
T = GetTickCount
Do
DoEvents
B = GetTickCount - T
If B < 0 Then
T = GetTickCount
ElseIf B >= Num Then
Exit_Flag = True
End If
Loop Until Exit_Flag = True
End Sub
'注意!不要删除或修改下列被注释的行!
'MappingInfo=Label1,Label1,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
BackColor = Label1.BackColor
End PropertyPublic Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
Label1.BackColor() = New_BackColor
PropertyChanged "BackColor"
End Property'注意!不要删除或修改下列被注释的行!
'MappingInfo=Label1,Label1,-1,Caption
Public Property Get Caption() As String
Caption = Label1.Caption
End PropertyPublic Property Let Caption(ByVal New_Caption As String)
Label1.Caption() = New_Caption
PropertyChanged "Caption"
End Property'注意!不要删除或修改下列被注释的行!
'MappingInfo=MSComm1,MSComm1,-1,CommPort
Public Property Get CommPort() As Integer
CommPort = MSComm1.CommPort
End PropertyPublic Property Let CommPort(ByVal New_CommPort As Integer)
MSComm1.CommPort() = New_CommPort
PropertyChanged "CommPort"
End Property'注意!不要删除或修改下列被注释的行!
'MappingInfo=Label1,Label1,-1,Font
Public Property Get Font() As Font
Set Font = Label1.Font
End PropertyPublic Property Set Font(ByVal New_Font As Font)
Set Label1.Font = New_Font
PropertyChanged "Font"
End Property'注意!不要删除或修改下列被注释的行!
'MappingInfo=Label1,Label1,-1,ForeColor
Public Property Get ForeColor() As OLE_COLOR
ForeColor = Label1.ForeColor
End PropertyPublic Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
Label1.ForeColor() = New_ForeColor
PropertyChanged "ForeColor"
End Property'注意!不要删除或修改下列被注释的行!
'MappingInfo=Label1,Label1,-1,BorderStyle
Public Property Get BorderStyle() As Integer
BorderStyle = Label1.BorderStyle
End PropertyPublic Property Let BorderStyle(ByVal New_BorderStyle As Integer)
Label1.BorderStyle() = New_BorderStyle
PropertyChanged "BorderStyle"
End Property'注意!不要删除或修改下列被注释的行!
'MemberInfo=0,0,0,0
Public Property Get State() As Boolean
State = m_State
End PropertyPublic Property Let State(ByVal New_State As Boolean)
m_State = New_State
PropertyChanged "State"
End Property'注意!不要删除或修改下列被注释的行!
'MemberInfo=12,0,0,0
Public Property Get L_val() As Single
L_val = m_L_val
End PropertyPublic Property Let L_val(ByVal New_L_val As Single)
m_L_val = New_L_val
PropertyChanged "L_val"
End Property'注意!不要删除或修改下列被注释的行!
'MemberInfo=0
Public Function Start() As Boolean
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
End If
Flag = False
'Timer1.Enabled = True
Start = True
ST = True
Do While ST
TM
Loop
End Function'注意!不要删除或修改下列被注释的行!
Public Function Over() As Boolean
ST = False
Over = True
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
End Function'注意!不要删除或修改下列被注释的行!
Public Property Get Err_num() As Integer
Err_num = m_Err_num
End PropertyPublic Property Let Err_num(ByVal New_Err_num As Integer)
m_Err_num = New_Err_num
PropertyChanged "Err_num"
End PropertyPrivate Sub TM()
Dim tt As Single
Dim i As Integer
Dim Tmp
Dim Tmp2 As String
Dim tmp1(0) As Byte
Dim T As Long
tmp1(0) = &H50
MSComm1.Output = tmp1
T = GetTickCount
Do While MSComm1.InBufferCount < 16
DoEvents
If (GetTickCount - T) > 300 Then
Exit Sub
End If
Loop
RBuf = MSComm1.Input
If RBuf(0) <> &H2 Or RBuf(15) <> &HA Then
Exit Sub
End If
Tmp = 0
For i = 0 To 14
Tmp = Tmp + RBuf(i)
Next i
Tmp2 = CStr(Hex(Tmp))
If Right(Tmp2, 1) <> "0" Then
Exit Sub
End If
If Not IsNumeric(Chr$(RBuf(1)) & Chr$(RBuf(2)) & Chr$(RBuf(3)) & Chr$(RBuf(4)) & Chr$(RBuf(5)) & Chr$(RBuf(6)) & Chr$(RBuf(7)) & Chr$(RBuf(8))) Then
Exit Sub
Else
tt = Chr$(RBuf(1)) & Chr$(RBuf(2)) & Chr$(RBuf(3)) & Chr$(RBuf(4)) & Chr$(RBuf(5)) & Chr$(RBuf(6)) & Chr$(RBuf(7)) & Chr$(RBuf(8))
End If
If Flag = False Then
Label1.Caption = Format(tt, "0.00")
End If
m_State = True
If (Not Flag) And (tt >= m_L_val) And (tt < 500) And m_State Then
Flag = True
RaiseEvent OnLoad
ElseIf Flag And (tt < (m_L_val * 0.7)) Then
Flag = False
RaiseEvent OffLoad
End If
End Sub'为用户控件初始化属性
Private Sub UserControl_InitProperties()
m_State = m_def_State
m_L_val = m_def_L_val
m_Err_num = m_def_Err_num
Label1.Top = 0
Label1.Left = 0
Label1.width = UserControl.width
Label1.height = UserControl.height
' m_BackStyle = m_def_BackStyle
End Sub'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag) Label1.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
Label1.Caption = PropBag.ReadProperty("Caption", "Label1")
MSComm1.CommPort = PropBag.ReadProperty("CommPort", 1)
Set Label1.Font = PropBag.ReadProperty("Font", Ambient.Font)
Label1.ForeColor = PropBag.ReadProperty("ForeColor", &H80000012)
Label1.BorderStyle = PropBag.ReadProperty("BorderStyle", 1)
m_State = PropBag.ReadProperty("State", m_def_State)
m_L_val = PropBag.ReadProperty("L_val", m_def_L_val)
m_Err_num = PropBag.ReadProperty("Err_num", m_def_Err_num)
UserControl.BackStyle = PropBag.ReadProperty("BackStyle", 0)
End SubPrivate Sub UserControl_Resize()
Label1.Top = 0
Label1.Left = 0
Label1.width = UserControl.width
Label1.height = UserControl.height
End Sub'将属性值写到存储器
Private Sub UserControl_WriteProperties(PropBag As PropertyBag) Call PropBag.WriteProperty("BackColor", Label1.BackColor, &H8000000F)
Call PropBag.WriteProperty("Caption", Label1.Caption, "Label1")
Call PropBag.WriteProperty("CommPort", MSComm1.CommPort, 1)
Call PropBag.WriteProperty("Font", Label1.Font, Ambient.Font)
Call PropBag.WriteProperty("ForeColor", Label1.ForeColor, &H80000012)
Call PropBag.WriteProperty("BorderStyle", Label1.BorderStyle, 1)
Call PropBag.WriteProperty("State", m_State, m_def_State)
Call PropBag.WriteProperty("L_val", m_L_val, m_def_L_val)
Call PropBag.WriteProperty("Err_num", m_Err_num, m_def_Err_num)
Call PropBag.WriteProperty("BackStyle", UserControl.BackStyle, 0)
End Sub
我以前用MSComm都是在程序里直接写,不论是win98还是win2k,从来没有这样的问题。
我现在在PB里调用mscomm接受地磅数据,从来没有人反应这个问题。
我从来就不关闭串口(窗口关闭自动关闭),包含串口调用的窗口多次退出进入都没有问题。