spo2.frm

VB开发串口通信

      Width           =   975
   End
   Begin VB.Label Label6 
      Caption         =   "幅度调节"
      Height          =   255
      Index           =   0
      Left            =   14040
      TabIndex        =   12
      Top             =   1560
      Width           =   855
   End
   Begin VB.Label Label5 
      Caption         =   "走纸速度"
      Height          =   255
      Index           =   0
      Left            =   14040
      TabIndex        =   10
      Top             =   1200
      Width           =   855
   End
   Begin VB.Label Label4 
      Caption         =   "显示参数"
      Height          =   255
      Index           =   0
      Left            =   14040
      TabIndex        =   8
      Top             =   840
      Width           =   855
   End
   Begin VB.Label Label3 
      Caption         =   "命令栏："
      Height          =   375
      Left            =   0
      TabIndex        =   4
      Top             =   1200
      Width           =   1095
   End
   Begin VB.Label Label2 
      Caption         =   "发送命令区："
      Height          =   375
      Left            =   0
      TabIndex        =   2
      Top             =   2040
      Width           =   1095
   End
   Begin VB.Label Label1 
      Caption         =   "波特率："
      Height          =   255
      Left            =   0
      TabIndex        =   0
      Top             =   840
      Width           =   975
   End
   Begin VB.Menu file 
      Caption         =   "文件(&F)"
      Begin VB.Menu newfile 
         Caption         =   "新建(&N)"
      End
      Begin VB.Menu openfile 
         Caption         =   "打开(&o)"
      End
      Begin VB.Menu save 
         Caption         =   "保存(&S)"
      End
      Begin VB.Menu saveother 
         Caption         =   "另存为...(&A)"
      End
      Begin VB.Menu bmp 
         Caption         =   "当前图片另存为..."
      End
      Begin VB.Menu openbmp 
         Caption         =   "打开脉搏波图片..."
      End
      Begin VB.Menu a 
         Caption         =   "_____________"
      End
      Begin VB.Menu printf 
         Caption         =   "打印(&V)"
      End
      Begin VB.Menu exitsys 
         Caption         =   "EXIT(&X)"
      End
   End
   Begin VB.Menu shibo 
      Caption         =   "示波"
      Begin VB.Menu start 
         Caption         =   "开始示波"
      End
      Begin VB.Menu stop 
         Caption         =   "停止示波"
      End
   End
   Begin VB.Menu look 
      Caption         =   "查看"
      Begin VB.Menu tool 
         Caption         =   "工具栏"
         Checked         =   -1  'True
      End
      Begin VB.Menu control 
         Caption         =   "控制参数区"
         Checked         =   -1  'True
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'公共变量声明
Dim xianshi(1 To 5, 1 To 360) As Byte
Dim data(1 To 5, 1 To 10) As Byte
Dim receive(1 To 60) As Byte
Dim flag(0 To 4) As Byte
Dim version(1 To 6) As Byte
Dim length_byte, dbyte, file_number As Integer
Public num, hscr_value As Integer
Public flag_status, menu, receive_flag As Boolean
Dim tempfile, wenname As String
Private Sub bmp_Click()
'保存波形文件
Dim strFilename As String
savebmp.ShowSave            '打开commdialog
strFilename = savebmp.FileName
filenum = FreeFile
If strFilename <> "" Then
   Open strFilename For Output As filenum
   SavePicture picture1(2).Image, strFilename   '保存体积描记图图片
  Close filenum
End If

End Sub
Private Sub Combo2_Click(Index As Integer)      '关闭图形显示窗口
If flag_status = False Then
    If (Combo2(Index).ListIndex = 1) Then
    picture1(Index).Visible = False
    Combo3(Index).Visible = False
    Combo4(Index).Visible = False
    Label4(Index).Visible = False
    Label5(Index).Visible = False
    Label6(Index).Visible = False
    flag(Index) = 0                         '记录被关闭的窗口
    Else
    picture1(Index).Visible = True
    Combo3(Index).Visible = True
    Combo4(Index).Visible = True
    Label4(Index).Visible = True
    Label5(Index).Visible = True
    Label6(Index).Visible = True
    flag(Index) = 1
    End If
    
End If

End Sub
Private Sub Combo2_dropdown(Index As Integer)
If flag_status = True Then
    msg = MsgBox("正在示波，不能设置该参数" + vbCrLf + "请在暂停时设置", vbOKOnly, "警告")
End If
End Sub
Private Sub Combo3_click(Index As Integer)      '暂停状态下修改图形设置属性
picture1(Index).Cls
If flag_status = False Then
num = Index
Call timer_huatu
End If
End Sub
Private Sub Combo4_click(Index As Integer)      ''暂停状态下修改图形设置属性
picture1(Index).Cls
If flag_status = False Then
num = Index
Call timer_huatu
End If
End Sub
Private Sub data_fenpei(recept() As Byte)       '将得到的receive中十个包的数据按字节分配给不同数组
Dim maibo(1 To 10) As Byte
Dim tiji(1 To 10) As Byte
Dim mailv(1 To 10) As Byte
Dim bang(1 To 10) As Byte
Dim spo2(1 To 10) As Byte
Dim l, h As Integer
l = LBound(recept)
h = UBound(recept)

For i = l To h Step 6
        maibo(Int(i / 6) + 1) = recept(i)
        tiji(Int(i / 6) + 1) = recept(i + 1)
        bang(Int(i / 6) + 1) = recept(i + 2)
        mailv(Int(i / 6) + 1) = recept(i + 3)
        spo2(Int(i / 6) + 1) = recept(i + 4)
        '状态灯显示相关状态
        If ((maibo(Int(i / 6) + 1) And &H10) = &H10) Then
            Shape1(0).FillColor = vbRed
            Else
            Shape1(0).FillColor = vbGreen
         End If
        If ((maibo(Int(i / 6) + 1) And &H20) = &H20) Then
            Shape1(1).FillColor = vbRed
        Else
             Shape1(1).FillColor = vbGreen
       End If
        If ((maibo(Int(i / 6) + 1) And &H40) = &H40) Then
            Shape1(2).FillColor = vbRed
        Else
            Shape1(2).FillColor = vbGreen
          End If
        If ((bang(Int(i / 6) + 1) And &H10) = &H10) Then
              Shape1(3).FillColor = vbRed
        Else
              Shape1(3).FillColor = vbGreen
        End If
        If ((bang(Int(i / 6) + 1) And &H20) = &H20) Then
            Shape1(4).FillColor = vbRed
        Else
            Shape1(4).FillColor = vbGreen

        End If


Next i
Call process_data(maibo(), tiji(), bang(), mailv(), spo2())     '调用数据处理子过程
End Sub
Private Sub Comm1_OnComm()
Dim h, l, k, t, m As Integer
Dim input_Byte, input_byte2 As Byte
Dim dele_byte, input_var, input_varg As Variant
Dim jiaoyan(1 To 6) As Byte
Dim jiao_hex As Long
Select Case Comm1.CommEvent
Case comEvReceive           '接受事件触发
Comm1.RThreshold = 0        '关闭OnComm事件
m = 0
Do
DoEvents
Loop Until Comm1.InBufferCount > 60

Do
jiao_hex = 0
If Comm1.InBufferCount <> 0 Then
input_var = Comm1.Input                       '读进一个字节
input_Byte = input_var(0)
    If (input_Byte >= &H80) Then              '判断包头字节
        jiaoyan(1) = input_Byte
        i = 2
                                          '读一个包校验
          Do While i <= 6
          If Comm1.InBufferCount <> 0 Then
            input_varg = Comm1.Input
            input_Byte = input_varg(0)
            jiaoyan(i) = input_Byte
            i = i + 1
          End If
        Loop
        
        For j = 1 To 5                          '  前五个字节和
            jiao_hex = jiaoyan(j) + jiao_hex
        Next j
        
        If jiaoyan(6) = (jiao_hex Mod 256) Then     '求最后一个字节与校验码比较
                z = 1
            Do While (length_byte <= 60 And z <= 6)          '读60个字节
                receive(length_byte) = jiaoyan(z)
                length_byte = length_byte + 1
                z = z + 1
            Loop
                If length_byte > 60 Then
                    Call data_fenpei(receive())         '调用数据分配子过程
                    Exit Do
                End If
        End If
    Else
    dele_byte = input_Byte          '去除错误数据
    End If
End If
Loop

End Select
length_byte = 1
Comm1.RThreshold = 1        '打开OnComm事件
End Sub

Private Sub Command2_Click()
Dim miling As Variant
If Combo1.ListIndex = -1 Then

 Combo1.SetFocus
  msg = MsgBox("请输入命令", vbOKOnly, "警告")
 Do
DoEvents
Loop Until Combo1.ListIndex > -1
End If
Select Case Combo1.ListIndex        '发送命令字
    Case 0
        Comm1.Output = "A"
    Case 1
        Comm1.Output = "B"
    Case 2
        Comm1.Output = "C"
    Case 3
        Comm1.Output = "D"
    End Select
Text2.Text = Text2.Text + "%" + Combo1.List(Combo1.ListIndex) + "%"     '命令字显示在命令栏内
End Sub

Private Sub Command3_Click()
Comm1.PortOpen = False
End
End Sub
Private Sub Command4_Click()        '系统验证
Dim input_yan(1 To 2) As Byte
Dim input_look, dele_byte As Variant
Comm1.Output = "E"
Text2.Text = Text2.Text + "%E%"
receive_flag = False
Do
If Comm1.InBufferCount = 0 Then
k = k + 1
Else
Exit Do
End If
Loop Until k > 1000
If k > 1000 Then            '未接受到数据，提示通讯错误
    Text3.Text = "通讯错误，请检查接口！"
    Exit Sub
Else

Comm1.RThreshold = 0    '关闭OnComm事件
Do
input_look = Comm1.Input
Do
DoEvents
Loop Until Comm1.InBufferCount > 0
If Comm1.InBufferCount > 0 Then
input_yan(1) = input_look(0)
    If (input_yan(1) = &H80) Then       '判断首字节是否是ox80
        input_look = Comm1.Input
        input_yan(2) = input_look(0)
        If (input_yan(2) = &HFF) Then   '判断次字节是否是oxff
        For j = 1 To 2
            version(j) = input_yan(j)
        Next j
 
        For i = 1 To 4
               Do
                If Comm1.InBufferCount <> 0 Then
                Exit Do
                End If
              Loop
            input_look = Comm1.Input
            input_yan(1) = input_look(0)
            version(2 + i) = input_yan(1)
        Next i
        receive_flag = True
        Exit Do
        End If
    Else
        dele_byte = input_yan(1)
    End If
End If
Loop
Command2.Enabled = True
If (version(1) = &H80) Then
    Call version_process(version)   '调用版本数据包处理子过程
End If
End If
Comm1.RThreshold = 1    '打开触发事件
End Sub

Private Sub Command4_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
Label8.Caption = "模块软件版本号查询, 系统验证!"
End Sub

Private Sub Command5_Click()
If Text2.Text = "" Then
msg = MsgBox("命令栏已清空", vbOKOnly, "提示！")
Else
Text2.Text = ""
End If
End Sub

Private Sub control_Click()
If control.Checked = True Then
    control.Checked = False
    For t = 0 To 4
    Combo2(i).Visible = False
    Combo3(i).Visible = False
    Combo4(i).Visible = False
    Label4(i).Visible = False
    Label5(i).Visible = False
    Label6(i).Visible = False
    Next t
Else
    control.Checked = True
    For t = 0 To 4
    Combo2(i).Visible = True
    Combo3(i).Visible = True
    Combo4(i).Visible = True
    Label4(i).Visible = True
    Label5(i).Visible = True
    Label6(i).Visible = True
    Next t
End If

End Sub

Private Sub exitsys_Click()
Comm1.PortOpen = False
End
End Sub

Private Sub file_Click()
If menu = ture Then
    openfile.Enabled = False
    newfile.Enabled = False
    save.Enabled = False
    saveother.Enabled = False
Else
    openfile.Enabled = True
    newfile.Enabled = True
    save.Enabled = True
    saveother.Enabled = True
End If
End Sub

Private Sub Form_Load()
Text1.Text = "4800"
'相关选择控件的说明
For i = 0 To 1
Combo4(i).Text = "2"
Combo4(i).AddItem "2"
Combo4(i).AddItem "4"
Combo4(i).AddItem "8"
Next i
For i = 2 To 4
Combo4(i).Text = "10"
Combo4(i).AddItem "10"
Combo4(i).AddItem "50"
Combo4(i).AddItem "100"
Combo4(i).AddItem "150"
Combo4(i).AddItem "200"
Combo4(i).AddItem "300"
Next i
For i = 0 To 4
Combo3(i).Text = "10"
Combo3(i).AddItem "10"
Combo3(i).AddItem "20"
Combo3(i).AddItem "50"
Combo3(i).AddItem "100"
Select Case i
Case 0
Combo2(i).Text = "脉搏强度图"
Combo2(i).AddItem "脉搏强度图"
Combo2(i).AddItem "关闭"
Case 1
Combo2(i).Text = "棒图强度图"
Combo2(i).AddItem "棒图强度图"
Combo2(i).AddItem "关闭"
Case 2
Combo2(i).Text = "体积描记图"
Combo2(i).AddItem "体积描记图"
Combo2(i).AddItem "关闭"
Case 3
Combo2(i).Text = "脉率图"
Combo2(i).AddItem "脉率图"
Combo2(i).AddItem "关闭"
Case 4
Combo2(i).Text = "血氧饱和度图"
Combo2(i).AddItem "血氧饱和度图"
Combo2(i).AddItem "关闭"
End Select
Next i
Combo1.Text = "请选择命令"
Combo1.AddItem "A"
Combo1.AddItem "B"
Combo1.AddItem "C"