form2.frm

VB写的串口程序

      End
      Begin VB.Image ImageStopDown 
         Height          =   375
         Left            =   3120
         Picture         =   "Form2.frx":F76E8
         Top             =   2880
         Width           =   1170
      End
   End
   Begin VB.Label Lab退出 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      Caption         =   "退出系统"
      BeginProperty Font 
         Name            =   "黑体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000002&
      Height          =   255
      Left            =   7560
      TabIndex        =   30
      Top             =   6090
      Width           =   1215
   End
   Begin VB.Image ImagExitUp 
      Appearance      =   0  'Flat
      Height          =   375
      Left            =   7560
      Picture         =   "Form2.frx":F8E38
      Top             =   6000
      Width           =   1170
   End
   Begin VB.Image ImagExitDown 
      Appearance      =   0  'Flat
      Height          =   375
      Left            =   7560
      Picture         =   "Form2.frx":FA588
      Top             =   6000
      Width           =   1170
   End
   Begin VB.Label Lab数据管理 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      Caption         =   "数据管理"
      BeginProperty Font 
         Name            =   "黑体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000002&
      Height          =   255
      Left            =   1560
      TabIndex        =   29
      Top             =   6090
      Width           =   1215
   End
   Begin VB.Image ImagDataUp 
      Appearance      =   0  'Flat
      Height          =   375
      Left            =   1560
      Picture         =   "Form2.frx":FBCD8
      Top             =   6000
      Width           =   1170
   End
   Begin VB.Image ImagDataDown 
      Appearance      =   0  'Flat
      Height          =   375
      Left            =   1560
      Picture         =   "Form2.frx":FD428
      Top             =   6000
      Width           =   1170
   End
End
Attribute VB_Name = "Form系统主窗口"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Bool开始生产 As Boolean  '开始生产成功标志
Dim Bool参数设置 As Boolean  '参数设置成功标志
Dim Bool串口成功 As Boolean  '串口打开成功标志
Dim XorData  As Long  '保存校验结果的变量
Private Sub Command1_Click()
If ProBar进度.Value = 100 Then
ProBar进度.Value = 0
End If

ProBar进度.Value = ProBar进度.Value + 5
If ProBar进度.Value >= 100 Then
ProBar进度.Value = 100
End If

StrJindu = Format(ProBar进度.Value) '将Int型进度值转为Str型，赋给StrJindu
StrJindu = StrJindu + "%"
Lbl百分比.Caption = StrJindu

Txt面数.Text = mmm
MsgBox mmm
End Sub

Private Sub Command1_GotFocus()
MsgBox "获得焦点123！"
End Sub

Private Sub Form_GotFocus()
'Txt面数.Text = mmm
MsgBox "获得焦点123！"
End Sub

Private Sub Form_Load()
Lbl面数.ForeColor = (&HF49710)   '各控件颜色设置
Lbl带数.ForeColor = (&HF49710)
Lbl打磨时间.ForeColor = (&HF49710)
Lbl等待时间.ForeColor = (&HF49710)
Lbl半径.ForeColor = (&HF49710)
Lbl夹杆长度.ForeColor = (&HF49710)
Lbl生产状态.ForeColor = (&HF49710)
Lbl生产总数.ForeColor = (&HF49710)
Lbl运转时间.ForeColor = (&HF49710)
Lbl生产进度.ForeColor = (&HF49710)
Lbl状态显示.ForeColor = (&HF497FF)  '粉红色区别显示
Lbl总数显示.ForeColor = (&HF49710)
Lbl时间显示.ForeColor = (&HF49710)
Lbl百分比.ForeColor = (&HF49710)
Lab数据管理.ForeColor = &HFF6020
Lab退出.ForeColor = &HFF6020

Fam数据统计.ForeColor = (&HF49710)  '设置Frame_ShenchanKongzhi文字颜色
Fam生产控制.ForeColor = (&HF49710)
ProBar进度.Value = 0  '进度条初始化



Dim StrJindu As String  '定义进度显示字符串
StrJindu = ""

'使用捕捉错误方式打开串口
On Error GoTo errorHandle
MSComm1.PortOpen = True
If MSComm1.PortOpen = True Then
    Lbl状态显示.Caption = "串口初始化并打开成功！"
    Bool串口成功 = True
Exit Sub
End If
errorHandle:
If Err.Number = 8005 Then
    MsgBox "串口正被另一应用程序使用，请关闭此程序，然后重新启动本系统！", 0, "警告"
    Lbl状态显示.Caption = "串口初始化失败！"
     Bool串口成功 = False
Else
    MsgBox "检测到错误:   " & Err.Number & vbLf & "错误描述：   " & Err.Description, 0, "错误！ "
End If
    
End Sub
Private Sub Form_LostFocus()
MsgBox "失去焦点123！"
End Sub

Private Sub Lab数据管理_Click()
Load Form数据管理
Form数据管理.Show 1
End Sub
Private Sub Lab数据管理_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ImagDataUp.Visible = False
Lab数据管理.ForeColor = &HE0E0E0
End Sub
Private Sub Lab数据管理_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
ImagDataUp.Visible = True
Lab数据管理.ForeColor = &HFF6020
End Sub
Private Sub Lab退出_Click()
End
End Sub
Private Sub Lab退出_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ImagExitUp.Visible = False
Lab退出.ForeColor = &HE0E0E0
End Sub
Private Sub Lab退出_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
ImagExitUp.Visible = True
Lab退出.ForeColor = &HFF6020
End Sub

Private Sub Lbl传参_Click()
Dim LongData(-1 To 7) As Long
Dim SendLongData(-1 To 7) As Byte
LongData(-1) = &HFF         '报文起始标志 FF
LongData(0) = Val(Txt面数)  '将TextBox中的字符读为数值
LongData(1) = Val(Txt带数)
LongData(2) = Val(Txt打磨时间)
LongData(3) = Val(Txt等待时间)
LongData(4) = Val(Txt工件半径)
LongData(5) = Val(Txt夹杆长度)
LongData(7) = &HFE          '报文结束标志 FE


Dim i As Integer
Dim j As Integer    '设置错误计数
j = 0
    For i = 0 To 5
    If 3 > LongData(i) Or LongData(i) > 250 Then
    j = j + 1
    End If
    Next i

If j > 0 Then
    MsgBox Format(j) + "项参数设置错误，" + "参数必须为3-250的整数！", vbOKOnly, "提示"
    Lbl状态显示.Caption = "参数设置错误，未能完成传送！"
    Bool参数设置 = False
Else
    XorData = 0  '初始化校验变量
    SendLongData(-1) = LongData(-1)
    SendLongData(0) = LongData(0)
    SendLongData(1) = LongData(1)
    SendLongData(2) = LongData(2)
    SendLongData(3) = LongData(3)
    SendLongData(4) = LongData(4)
    SendLongData(5) = LongData(5)
    SendLongData(7) = LongData(7)
    For m = 0 To 5
        XorData = SendLongData(m) Xor XorData   '计算校验结果，对Byte型数据进行异或运算
    Next
    SendLongData(6) = XorData   '在数据串中插入 异或校验结果
    If Bool串口成功 = True Then
        MSComm1.Output = SendLongData   '发送数据
        Bool参数设置 = True
        Lbl状态显示.Caption = "参数设置并传送完成！"
    Else: MsgBox "串口未能打开，不能进行相关操作！" & vbLf & "请检查串口是否被其他应用程序占用！", vbOKOnly, "提示"
        Lbl状态显示.Caption = "不能完成传送参数操作！"
    End If
End If

'Dim Data(0) As Byte     '定义一个数组，类型必须为Byte型
'Data(0) = &H60          'VB中十六进制的表示方式
'MSComm1.Output = Data   '发送16进制数10，接收端16进制显示时为10

End Sub
Private Sub Lbl开始生产_Click()
If Bool参数设置 = True Then
    Dim SendLongData(-1 To 1) As Byte
    SendLongData(-1) = &HFF  '报文开始标志 FF
    SendLongData(0) = &HEE   '开始生产命令 EE
    SendLongData(1) = &HFE    '报文结束标志 FE
    MSComm1.Output = SendLongData
    Bool开始生产 = True
    Lbl状态显示.Caption = "生产进行中...."
Else
MsgBox "尚未进行参数设置，请先设置参数！", vbOKOnly, "提示"
End If
End Sub
Private Sub Lbl手动_Click()
Dim SendLongData(-1 To 1) As Byte
    SendLongData(-1) = &HFF  '报文开始标志 FF
    SendLongData(0) = &HDD   '开始生产命令 DD
    SendLongData(1) = &HFE    '报文结束标志 FE
    MSComm1.Output = SendLongData
Lbl状态显示.Caption = "手动调整"
End Sub

Private Sub Lbl手动_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ImageFreeUp.Visible = False
End Sub

Private Sub Lbl手动_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
ImageFreeUp.Visible = True
End Sub

Private Sub Lbl停止_Click()
If Bool开始生产 = True Then
    Dim SendLongData(-1 To 1) As Byte
    SendLongData(-1) = &HFF  '报文开始标志 FF
    SendLongData(0) = &HBB   '开始生产命令 BB
    SendLongData(1) = &HFE    '报文结束标志 FE
    MSComm1.Output = SendLongData
    Bool开始生产 = False
    Lbl状态显示.Caption = "停止生产"
Else: MsgBox "还没有进行生产", vbOKOnly, "提示"
End If
End Sub

Private Sub Lbl暂停_Click()
If Bool开始生产 = True Then
Dim SendLongData(-1 To 1) As Byte
    SendLongData(-1) = &HFF  '报文开始标志 FF
    SendLongData(0) = &HCC   '开始生产命令 CC
    SendLongData(1) = &HFE    '报文结束标志 FE
    MSComm1.Output = SendLongData
Lbl状态显示.Caption = "暂停生产"
Else: MsgBox "还没有进行生产", vbOKOnly, "提示"
End If
End Sub

Private Sub Lbl暂停_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ImagePaUp.Visible = False
End Sub
Private Sub Lbl暂停_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
ImagePaUp.Visible = True
End Sub

Private Sub Lbl开始生产_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ImageStaUp.Visible = False
End Sub
Private Sub Lbl开始生产_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
ImageStaUp.Visible = True
End Sub

Private Sub Lbl停止_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ImageStopUp.Visible = False
End Sub

Private Sub Lbl停止_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
ImageStopUp.Visible = True
End Sub

Private Sub Lbl传参_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ImageTrUp.Visible = False
End Sub

Private Sub Lbl传参_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
ImageTrUp.Visible = True
End Sub
Private Sub MSComm1_OnComm()
Dim InBuf() As Byte  '定义一个二进制指针，用来存放接收缓冲区的数据
Dim ByteCount As Integer  '接收到的字节数
'Dim InputData() As Long

Select Case MSComm1.CommEvent  '根据串口事件
  Case comEvReceive   '如果接收到数据,comEvReceive本身值为 2
  'RThreshold设置太小，可能不能一次性接收完数据，太大不能触发comEvReceive事件
  InBuf = MSComm1.Input  '能否一次性接收完数据，和 RThreshold设置有关，也与Select中程序处理时间有关
  Case comEventBreak '接收到中断信号
  MsgBox "接收到中断信号！", 0, "提示"
  Case comEventOverrun
  MsgBox "端口超速！", 0, "提示"
  Case comEventRxOver
  MsgBox "接收缓冲区溢出！", 0, "提示"
  Case Else
  MsgBox "串口错误请检查！", 0, "提示"
End Select

ReDim InputData(LBound(InBuf) To UBound(InBuf)) As Long  '动态定义数组
For i = LBound(InBuf) To UBound(InBuf)
  InputData(i) = InBuf(i)
Next i
  
'If MSComm1.CommEvent = 2 Then    '如果接收到数据
'  InBuf = MSComm1.Input  '保存接收缓冲区的数据  (转移数据)
'End If
Dim str As String
Dim strMachNum As String
str = "接收到数据："
For k = LBound(InBuf) To UBound(InBuf)
  str = str & " " & Hex(InputData(k))
Next k
MsgBox str, 0, "提示" 'InputData(15)   ' UBound(InBuf)

If InputData(1) = &HFF Then  '下位机发送的 &HFF 表示下位机接收到正确数据
  strMachNum = InputData(0)
  Lbl状态显示.Caption = strMachNum & "号下位机接收正确信息！"
End If

If ProBar进度.Value = 100 Then
ProBar进度.Value = 0
End If
ProBar进度.Value = ProBar进度.Value + 5
If ProBar进度.Value >= 100 Then
ProBar进度.Value = 100
End If
StrJindu = Format(ProBar进度.Value) '将Int型进度值转为Str型，赋给StrJindu
StrJindu = StrJindu + "%"
Lbl百分比.Caption = StrJindu
 
MSComm1.InBufferCount = 0 '清空
End Sub