Option Explicit '变量显示
'----------------------------------
' 变量定义申明
'----------------------------------
Public blnComOpen As Boolean '串口状态
'----------------------------------
' 过程、函数定义
'----------------------------------
'----------------------------------
' 串口状态
'----------------------------------
Public Sub ComStatus()
If frmMain.MSComm.PortOpen = False Then
frmCom.shpComLed.BackColor = vbRed
frmCom.cmdComSwitch.Caption = "打开串口" ' 串口状态显示
frmMain.StatusBar.Panels(3).Text = "COM Port Cloced"
blnZigbeeModuleConnect = False
ElseIf frmMain.MSComm.PortOpen = True Then
frmCom.shpComLed.BackColor = vbGreen
frmCom.cmdComSwitch.Caption = "关闭串口"
frmMain.StatusBar.Panels(3).Text = "" & frmCom.cboCOM.Text & " OPEND," & frmCom.cboBaudRate.Text & "," & _
"" & Mid(frmCom.cboParityBit.Text, 2, 1) & "," & frmCom.cboDataBit.Text & "," & frmCom.cboStopBit.Text
End If
End Sub
'----------------------------------
' 打开串口
'----------------------------------
Public Sub ComOpen()
On Error GoTo Err
If frmMain.MSComm.PortOpen = True Then
frmMain.MSComm.PortOpen = False ' 先判断串口是否打开，如果打开则先关闭
End If
Call Com_reSet(Val(Mid(frmCom.cboCOM.Text, 4, 1)), Val(frmCom.cboBaudRate.Text), Mid(frmCom.cboParityBit.Text, 2, 1), Val(frmCom.cboDataBit.Text), Val(frmCom.cboStopBit.Text)) '串口设置
If frmMain.MSComm.PortOpen = True Then
blnComOpen = True
Else
blnComOpen = False
End If
Call Status
Err:
End Sub
'----------------------------------
' 关闭串口
'----------------------------------
Public Sub ComClose()
On Error GoTo Err
If frmMain.MSComm.PortOpen = True Then
frmMain.MSComm.PortOpen = False ' 先判断串口是否打开，如果打开则先关闭
End If
blnComOpen = False
Call Status
Err:
End Sub
'----------------------------------
' 串口初始化
'----------------------------------
Public Sub Com_initial(Port As Double, BaudRate As Double, ParityBit As String, DataBit As Double, StopBit As Double)
On Error GoTo ErrorTrap ' 错误则跳往错误处理
If frmMain.MSComm.PortOpen = True Then
frmMain.MSComm.PortOpen = False ' 先判断串口是否打开，如果打开则先关闭
End If
frmMain.MSComm.InputMode = comInputModeBinary ' 二进制发送
frmMain.MSComm.CommPort = Port ' 设定端口
frmMain.MSComm.Settings = BaudRate & "," & ParityBit & "," & DataBit & "," & StopBit ' 设置波特率，无校验，8位数据位，1位停止位
frmMain.MSComm.InBufferSize = 1024 ' 设置接收缓冲区为1024字节
frmMain.MSComm.OutBufferSize = 4096 ' 设置发送缓冲区为4096字节
frmMain.MSComm.InBufferCount = 0 ' 清空输入缓冲区
frmMain.MSComm.OutBufferCount = 0 ' 清空输出缓冲区
frmMain.MSComm.SThreshold = 1 ' 发送缓冲区空触发发送事件
frmMain.MSComm.RThreshold = 1 ' 每X个字符到接收缓冲区引起触发接收事件
frmMain.MSComm.OutBufferCount = 0 ' 清空发送缓冲区
frmMain.MSComm.InBufferCount = 0 ' 清空接收缓冲区
frmMain.MSComm.PortOpen = True ' 打开串口
If frmMain.MSComm.PortOpen = True Then
blnComOpen = True
Else
blnComOpen = False
End If
Call Status
Exit Sub
ErrorTrap: ' 错误处理
Select Case Err.Number
Case comPortAlreadyOpen ' 如果串口已经打开，则提示
If MsgBox("没有发现串口或被占用", vbOKOnly + vbExclamation, "警告") = vbOK Then
Call ComClose
End If
Case Else
If MsgBox("没有发现串口或被占用", vbOKOnly + vbExclamation, "警告") = vbOK Then
Call ComClose
End If
End Select
Err.Clear ' 清除 Err 对象的属性
End Sub
'----------------------------------
' 串口号重设
'----------------------------------
Public Sub Com_reSet(Port As Double, BaudRate As Double, ParityBit As String, DataBit As Double, StopBit As Double)
On Error GoTo ErrorHint ' 错误则跳往错误处理
If frmMain.MSComm.PortOpen = True Then
frmMain.MSComm.PortOpen = False ' 先判断串口是否打开，如果打开则先关闭
End If
frmMain.MSComm.CommPort = Port ' 设定端口
frmMain.MSComm.Settings = BaudRate & "," & ParityBit & "," & DataBit & "," & StopBit ' 设置波特率，无校验，8位数据位，1位停止位
frmMain.MSComm.PortOpen = True ' 打开串口
If frmMain.MSComm.PortOpen = True Then
blnComOpen = True
Else
blnComOpen = False
End If
Call Status
Exit Sub
ErrorHint: ' 错误处理
Select Case Err.Number
Case comPortAlreadyOpen ' 如果串口已经打开，则提示
If MsgBox("没有发现串口或被占用", vbOKOnly + vbExclamation, "警告") = vbOK Then
Call ComClose
End If
Case Else
If MsgBox("没有发现串口或被占用", vbOKOnly + vbExclamation, "警告") = vbOK Then
Call ComClose
End If
End Select
Err.Clear ' 清除 Err 对象的属性
End Sub
'----------------------------------
' 串口配置初始化
'----------------------------------
Public Sub Com_Init()
blnComOpen = False
frmCom.shpComLed.BackColor = &H0&
frmCom.cmdComSwitch.Caption = "打开串口"
frmCom.cboCOM = "COM1"
frmCom.cboBaudRate = "38400"
frmCom.cboParityBit = "无NONE"
frmCom.cboDataBit = "8"
frmCom.cboStopBit = "1"
Call Com_initial(Val(Mid(frmCom.cboCOM.Text, 4, 1)), Val(frmCom.cboBaudRate.Text), Mid(frmCom.cboParityBit.Text, 2, 1), Val(frmCom.cboDataBit.Text), Val(frmCom.cboStopBit.Text)) '串口设置
End Sub
'----------------------------------
' 复位MSComm
'----------------------------------
Public Sub reSetMSComm()
On Error GoTo Err
frmMain.MSComm.PortOpen = False
frmMain.MSComm.InputMode = comInputModeBinary ' 二进制发送
frmMain.MSComm.InputLen = 0 ' 设置接收缓冲区为0字节
frmMain.MSComm.InBufferCount = 0 ' 滑空接收缓冲
frmMain.MSComm.RThreshold = 1 ' 每X个字符到接收缓冲区引起触发接收事件
frmMain.MSComm.PortOpen = True
Err:
End Sub
'----------------------------------
' End Of File
'----------------------------------
Option Explicit '变量显示
'----------------------------------
' 窗体导入卸载
'----------------------------------
Private Sub Form_Load()
frmCom.Caption = GS_SYSTEMTITLE & "__串口配置"
frmCom.Height = 3840
frmCom.Width = 5350
End Sub
Private Sub Form_Unload(Cancel As Integer)
frmMain.Enabled = True
frmMain.SetFocus
End Sub
'----------------------------------
' 串口配置选择
'----------------------------------
Private Sub cboCOM_Click()
Call Com_reSet(Val(Mid(frmCom.cboCOM.Text, 4, 1)), Val(frmCom.cboBaudRate.Text), Mid(frmCom.cboParityBit.Text, 2, 1), Val(frmCom.cboDataBit.Text), Val(frmCom.cboStopBit.Text)) '串口设置
End Sub
Private Sub cboBaudRate_Click()
Call Com_reSet(Val(Mid(frmCom.cboCOM.Text, 4, 1)), Val(frmCom.cboBaudRate.Text), Mid(frmCom.cboParityBit.Text, 2, 1), Val(frmCom.cboDataBit.Text), Val(frmCom.cboStopBit.Text)) '串口设置
End Sub
Private Sub cboParityBit_Click()
Call Com_reSet(Val(Mid(frmCom.cboCOM.Text, 4, 1)), Val(frmCom.cboBaudRate.Text), Mid(frmCom.cboParityBit.Text, 2, 1), Val(frmCom.cboDataBit.Text), Val(frmCom.cboStopBit.Text)) '串口设置
End Sub
Private Sub cboDataBit_Click()
Call Com_reSet(Val(Mid(frmCom.cboCOM.Text, 4, 1)), Val(frmCom.cboBaudRate.Text), Mid(frmCom.cboParityBit.Text, 2, 1), Val(frmCom.cboDataBit.Text), Val(frmCom.cboStopBit.Text)) '串口设置
End Sub
Private Sub cboStopBit_Click()
Call Com_reSet(Val(Mid(frmCom.cboCOM.Text, 4, 1)), Val(frmCom.cboBaudRate.Text), Mid(frmCom.cboParityBit.Text, 2, 1), Val(frmCom.cboDataBit.Text), Val(frmCom.cboStopBit.Text)) '串口设置
End Sub
'----------------------------------
' 串口打开
'----------------------------------
Private Sub cmdComSwitch_Click()
On Error GoTo Err:
frmCom.cmdComSwitch.Enabled = False
Call Delay(50)
frmCom.cmdComSwitch.Enabled = True
If frmMain.MSComm.PortOpen = True Then
blnComOpen = True
Call ComClose ' 关闭串口
Else
blnComOpen = False
Call ComOpen ' 打开串口
blnComOpen = True
'当窗体不是，设置串口时串口窗体能自动关闭
If (frmMain.MSComm.PortOpen = True And blnZigbeeModuleSelect = True) Then
Unload Me
End If
End If
Err:
End Sub
'----------------------------------
' End Of File
'----------------------------------
'----------------------------------
' MSComm核心程序(串口通信)
'----------------------------------
Public Sub MSComm_OnComm()
On Error GoTo Err
Select Case frmMain.MSComm.CommEvent ' 每接收1个数就触发一次
Case comEvReceive
接收程序
Else
Call reSetMSComm ' 复位MSComm
End If
End Select
Err:
End Sub
畅学电子
