spo2.frm

VB开发串口通信

Combo1.AddItem "D"

'端口判断
Opt1.Value = True
If Comm1.CommPort = True Then
   msg = MsgBox("端口已被占用!", vbOKOnly, "提示")
Else
    Comm1.CommPort = 1
End If

'波特率，串口设置
Comm1.Settings = "4800,o,8,1"
Comm1.InputMode = comInputModeBinary
Comm1.RThreshold = 0
Comm1.InputLen = 1
Comm1.PortOpen = True
Comm1.InBufferCount = 0
Comm1.OutBufferCount = 0
Command2.Enabled = False
Timer1.Enabled = False      '关定时器
flag_status = False
receive_flag = False
menu = True
length_byte = 1
For i = 0 To 4
    flag(i) = 1
Next i
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
Select Case Combo1.ListIndex
Case 0
    Label8.Caption = "是体积描记图的比例和偏移与当前样本一致"
Case 1
    Label8.Caption = "设置血氧饱和度为4次平均，脉率为8秒钟平均"
Case 2
    Label8.Caption = "设置血氧饱和度为8次平均，脉率为8秒钟平均"
Case 3
    Label8.Caption = "设置血氧饱和度为16次平均，脉率为16秒钟平均"
End Select
End Sub

Private Sub version_process(version() As Byte)      '版本校验子过程
Dim jianyan As Byte
Dim banben(2) As Byte
jianyan = version(3)
Select Case jianyan Mod 8       '取0，1，2位
Case 0
    Label11.Caption = "上次接收命令：" + "A" + vbCrLf
Case 1
    Label11.Caption = "上次接收命令：" + "B" + vbCrLf
Case 2
    Label11.Caption = "上次接收命令：" + "C" + vbCrLf
Case 3
    Label11.Caption = "上次接收命令：" + "D" + vbCrLf
Case 4
    Label11.Caption = "上次无接收命令" + vbCrLf
End Select
Select Case Int((jianyan Mod 64) / 8)   '取3，4，5位
Case 0
    Label11.Caption = Label11.Caption + "血氧4次平均" + vbCrLf
Case 1
    Label11.Caption = Label11.Caption + "血氧8次平均" + vbCrLf
Case 2
    Label11.Caption = Label11.Caption + "血氧16次平均" + vbCrLf
End Select
If (jianyan And 64) Then    '取第6位
    Label11.Caption = Label11.Caption + "A/D差分放大电路正确" + vbCrLf
Else
Label11.Caption = Label11.Caption + "A/D差分放大电路故障" + vbCrLf
End If
banben(1) = version(4)
banben(2) = version(5)
Label11.Caption = Label11.Caption + Chr(banben(1)) + "." + Chr(banben(2)) + vbCrLf
End Sub
Private Sub process_data(maibo() As Byte, tiji() As Byte, bang() As Byte, mailv() As Byte, spo2() As Byte)
Dim h, l As Integer
Dim spo, mailv_value As Integer
Dim soutime, xueyang, maibo_voice, daonian, soumai As Byte
spo = 0
mailv_value = 0
h = UBound(maibo)
l = LBound(maibo)
'分别取不同数值赋给不同数组
For j = 1 To 5
    Select Case j
        Case 1
            For i = l To h
            data(j, i) = maibo(i) Mod 16
            Next i
        Case 2
           For i = l To h
            data(j, i) = tiji(i) Mod 128
            Next i
        Case 3
            For i = l To h
            data(j, i) = bang(i) Mod 16
            ProgBar1.Value = data(j, i)     '进动条显示棒图强度
            Next i
        Case 4
            For i = l To h
            data(j, i) = (mailv(i) Mod 128) + (Int((bang(i) And (&H40)) / 64) * 128)
            mailv_value = mailv_value + data(j, i)
            Next i
            Label14.Caption = Space(3) + Str(data(4, 5))                        '显示脉率
        Case 5
            For i = l To h
            data(j, i) = spo2(i) Mod 128
            spo = spo + data(j, i)
            Next i
            Label13.Caption = Space(3) + Str(data(5, 5))                '显示spo2
     End Select
Next j

End Sub
Private Sub huatu(shuju() As Byte)      '画图程序
Dim h, k As Integer
Dim dy As Single
Dim dx As Single
Dim dz As Single
Dim zuobiao As String
h = UBound(shuju)
k = LBound(shuju)
picture1(num).Cls       '清屏
'调整坐标系，画坐标轴
picture1(num).ScaleWidth = picture1(num).Width
picture1(num).ScaleHeight = (1 / 2) * (picture1(num).Height)
picture1(num).ScaleTop = (-8 / 9) * picture1(num).ScaleHeight
picture1(num).ScaleLeft = 0
picture1(num).Line (0, 0)-(picture1(num).ScaleWidth, 0), RGB(255, 0, 0)
picture1(num).Line (10, -picture1(num).ScaleTop)-(10, picture1(num).ScaleTop), RGB(255, 0, 0)
dz = Abs(picture1(num).ScaleTop / 10)
'选择横轴与纵轴两点间的间隔
For i = 1 To 10
picture1(num).Line (30, picture1(num).ScaleTop + dz * i)-(50, picture1(num).ScaleTop + dz * i), RGB(0, 0, 255)
Next i
If num <= 1 Then
Select Case Combo4(num).ListIndex
Case -1
dy = picture1(num).ScaleTop / 2
Case 0
dy = picture1(num).ScaleTop / 2
Case 1
dy = picture1(num).ScaleTop / 4
Case 2
dy = picture1(num).ScaleTop / 8
End Select
Else
Select Case Combo4(num).ListIndex
Case -1
dy = picture1(num).ScaleTop / 10
Case 0
dy = picture1(num).ScaleTop / 10
Case 1
dy = picture1(num).ScaleTop / 50
Case 2
dy = picture1(num).ScaleTop / 100
Case 3
dy = picture1(num).ScaleTop / 150
Case 4
dy = picture1(num).ScaleTop / 200
Case 5
dy = picture1(num).ScaleTop / 300
End Select
End If

Select Case Combo3(num).ListIndex
Case -1
dx = picture1(num).ScaleWidth / h
Case 0
dx = picture1(num).ScaleWidth / h
Case 1
dx = 2 * picture1(num).ScaleWidth / h
Case 2
dx = 5 * picture1(num).ScaleWidth / h
Case 3
dx = 10 * picture1(num).ScaleWidth / h
End Select
zuobiao = Combo4(num).List(Combo4(num).ListIndex)
picture1(num).CurrentX = 20: picture1(num).CurrentY = picture1(num).ScaleTop - 10
picture1(num).Print zuobiao
'画窗口中点
    For i = k To h - 1
    picture1(num).Line (i * dx, shuju(i) * dy)-((i + 1) * dx, shuju(i + 1) * dy), RGB(255, 0, 0)
    Next i

End Sub
Private Sub HScr1_Change()          '进动条程序
Dim dushu(1 To 5, 1 To 10) As Byte
Dim h, l, k, b, c As Integer
l = LBound(dushu, 2)
h = UBound(dushu, 2)
k = UBound(xianshi, 2)
For i = 0 To 4
If flag(i) = 0 Then
    picture1(i).Visible = False
End If
Next i
Open wenname For Binary As file_number
If HScr1.Value > hscr_value Then            '进动条向右动
    For m = hscr_value + 1 To HScr1.Value
        For b = 1 To 5
            For j = 1 To 10
                    Get #file_number, (5 + (b - 1) * 10 + j + (m - 1) * 50), dushu(b, j)    '读入文件数据给数组
            Next j
        
                    For c = l To k - h                      '更新窗口数据
                        xianshi(b, c) = xianshi(b, c + h)
                    Next c
                    For c = 1 To h
                        xianshi(b, k - h + c) = dushu(b, c)
                    Next c
        Next b
    Next m
Else                                                '进动条向左动
    If HScr1.Value >= 36 Then
            For m = 1 To hscr_value - HScr1.Value
                For b = 1 To 5
                    For j = 1 To 10
                    Get #file_number, (5 + (b - 1) * 10 + j + (hscr_value - 36 - m) * 50), dushu(b, j) '读入文件数据给数组
                    Next j
                
                    For c = k - h To l Step -1
                        xianshi(b, c + h) = xianshi(b, c)
                    Next c
                    For c = h To 1 Step -1
                        xianshi(b, c) = dushu(b, c)
                    
                    Next c
            Next b
            Next m
            
    Else
            If hscr_value >= 36 Then
                For m = 1 To hscr_value - 36
                For b = 1 To 5
                    For j = 1 To 10
                    Get #file_number, (5 + (b - 1) * 10 + j + (hscr_value - 36 - m) * 50), dushu(b, j)
                    Next j
                
                    For c = k - h To l Step -1
                        xianshi(b, c + h) = xianshi(b, c)
                    Next c
                    For c = h To 1
                        xianshi(b, c) = dushu(b, c)
                    Next c
                Next b
                Next m
               For m = 1 To 36 - HScr1.Value
                For b = 1 To 5
                    For c = k - h To l Step -1
                        xianshi(b, c + h) = xianshi(b, c)
                    Next c
                    For c = h To 1 Step -1
                        xianshi(b, c) = 0
                    Next c
                Next b
                Next m
            Else
                For m = 1 To hscr_value - HScr1.Value
                For b = 1 To 5
                    For c = k - h To l Step -1
                        xianshi(b, c + h) = xianshi(b, c)
                    Next c
                    For c = h To 1 Step -1
                        xianshi(b, c) = 0
                    Next c
                Next b
                Next m
            End If
    End If
End If
    
Close #file_number
Call timer_huatu
hscr_value = HScr1.Value
End Sub


Private Sub openbmp_Click()
'打开图片文件
Dim strFilename As String
Dim strLine
savebmp.ShowOpen
strFilename = savebmp.FileName
picture1(2).Cls
filenum = FreeFile
If strFilename <> "" Then
   Open strFilename For Input As filenum
   Do While Not EOF(filenum)
      Line Input #filenum, strLine
       picture1(2).Picture = LoadPicture(strFilename)
   Loop
      Close filenum
End If

End Sub

Private Sub openfile_Click()
Dim file_length As Long
If Comm1.PortOpen = True Then
Comm1.PortOpen = False
End If
dakai.ShowOpen
wenname = dakai.FileName
file_number = FreeFile
Open wenname For Binary As file_number
    For i = 0 To 4
        Get #file_number, i + 1, flag(i)
    Next i
    file_length = LOF(file_number)
    dbyte = Int((file_length - 5) / (5 * 10))
    HScr1.Max = dbyte
    HScr1.Min = 0
    hscr_value = HScr1.Value
   For i = 1 To 5
    For j = 1 To 360
        'Get #filenumber, 6, dushu(i)
        xianshi(i, j) = 0
    Next j
    Next i
Close #file_number
    Call timer_huatu
End Sub

Private Sub Opt1_Click()
Comm1.CommPort = 1
End Sub

Private Sub Opt2_Click()
Comm1.CommPort = 2
End Sub

Private Sub printf_Click()
dakai.ShowPrinter
End Sub

Private Sub save_Click()
savefile.Show
End Sub
Private Sub saveother_Click()
Dim filenumber As Integer
dakai.ShowSave
fname = dakai.FileName
filenumber = FreeFile
Open fname For Binary As filenumber
Close #filenumber
If fname <> "" Then
    FileCopy "C:\Documents and Settings\tempfile.dat", fname
    Kill "C:\Documents and Settings\tempfile.dat"
     Close #filenumber
End If
End Sub

Private Sub start_Click()
Toolbar1.Buttons(3).Key = "run"
Call Toolbar1_ButtonClick(Toolbar1.Buttons(3))
End Sub

Private Sub stop_Click()
Toolbar1.Buttons(2).Key = "zhongzhi"
Call Toolbar1_ButtonClick(Toolbar1.Buttons(2))

End Sub

Private Sub Timer1_Timer()
Dim h, l, k As Integer
Timer1.Enabled = False
l = LBound(data, 2)
h = UBound(data, 2)
k = UBound(xianshi, 2)

'窗口数据更新
For j = 1 To 5
    For i = l To k - h
    xianshi(j, i) = xianshi(j, i + h)
    Next i
    For i = 1 To h
        xianshi(j, k - h + i) = data(j, i)
    Next i
    
    Open "C:\Documents and Settings\tempfile.dat" For Binary As 1
'向文件写数据
        t = LOF(1)
        For i = 1 To UBound(data, 2)
        Put #1, (t + i), data(j, i)
        Next i
        Close #1
Next j
       

Call timer_huatu

Timer1.Enabled = True
End Sub

Private Sub tool_Click()
If tool.Checked = True Then
    tool.Checked = False
    Toolbar1.Visible = False
Else
    tool.Checked = True
    Toolbar1.Visible = True
End If
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "exit"
    End
Case "run"
    
    Timer1.Enabled = True
    flag_status = True
    tempfile = Str(Int((Rnd(6) * 1000000)))
    Open "C:\Documents and Settings\tempfile.dat" For Binary As 1
    For i = 0 To 4
    Put #1, Seek(1), flag(i)
    Next i
    Close #1
    menu = False
    If Comm1.PortOpen = False Then
    Comm1.PortOpen = True
    End If
    
Case "open"
    
    
Case "zhongzhi"
    Timer1.Enabled = False
    Comm1.RThreshold = 0
    flag_status = False
    menu = True
End Select
End Sub
Private Sub timer_huatu()   '更新画图数组
Dim shu(1 To 360) As Byte
For num = 0 To 4
    Select Case num
    Case 0
    For i = LBound(xianshi, 2) To UBound(xianshi, 2)
        shu(i) = xianshi(num + 1, i)
    Next i
    
    Case 1
    For i = LBound(xianshi, 2) To UBound(xianshi, 2)    '改成显示棒图
   
        shu(i) = xianshi(num + 2, i)
    Next i

    Case 2
    For i = LBound(xianshi, 2) To UBound(xianshi, 2)   '改成显示体积描记图
        shu(i) = xianshi(num, i)
    Next i

    Case 3
    For i = LBound(xianshi, 2) To UBound(xianshi, 2)
        shu(i) = xianshi(num + 1, i)
       
    Next i
        '
    
    Case 4
    For i = LBound(xianshi, 2) To UBound(xianshi, 2)
        shu(i) = xianshi(num + 1, i)
      
    Next i
        

End Select
        Call huatu(shu())
Next num
End Sub