⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ve-1ba.tmp

📁 这是我自己用VB.NET编写的一款监护仪的电脑软件
💻 TMP
字号:

Imports System.IO
Imports System.Text
Public Class MainForm
    Public fontcount As Integer = 0
    Public path As String = Application.StartupPath & "Data.dat"
    Private Sub MainForm_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        Login.Close()
        File.Delete(path)
    End Sub

    Private Sub MainForm_GotFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.GotFocus
        Me.PictureBox1.Refresh()
    End Sub

    Private Sub MainForm_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        SysTime.Enabled = True
        ToolStripStatusLabel3.Text = ToolStripStatusLabel3.Text + Login.UserID.Text
        ToolStripStatusLabel4.Text = ToolStripStatusLabel4.Text + "已停止 "

        '以下在任务栏显示打纸速度
        Me.TextBox6.Text = "1厘米/分钟"
        ' 以下在任务栏显示监护状态
        Me.TextBox7.Text = " 未开始"
        '以下显示操作用户
        Me.TextBox8.Text = Login.UserID.Text
        '以下显示监护时长
        Me.TextBox4.Text = "  10分钟"
        Me.TextBox5.Text = " 10分00秒"
        With SerialPort1
            .BaudRate = 4800
            .DataBits = 8
            .ReadBufferSize = 1024 '这里设置可以使机器等待一定时间再接收数据
            .ReceivedBytesThreshold = 48
            .ReadTimeout = 500

            '可用电脑的COM1或COM2端口

            Try
                If Not .IsOpen Then
                    .PortName = My.Computer.Ports.SerialPortNames.Item(0)
                    .Open()
                    .DiscardInBuffer()
                    Dim ceshi(100) As Byte
                    .Read(ceshi, 0, 100)
                End If

            Catch ex As Exception
                Try
                    .PortName = My.Computer.Ports.SerialPortNames.Item(1)
                    .Open()
                    .DiscardInBuffer()
                    Dim ceshi(100) As Byte
                    .Read(ceshi, 0, 100)
                Catch ey As Exception
                    MessageBox.Show("未检查到设备!请检查设备是否正确连接至COM1端口!", "设备连接出错", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)  '测试设备是否连接通畅
                    .Close()
                End Try

            End Try
            If .IsOpen Then
                .Close()
            End If
        End With
        File.Create(path, 256, FileOptions.Asynchronous)
    End Sub
    Dim Time_Count As Integer = 0
    Private Sub SysTime_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles SysTime.Tick
        todate.Text = " 当前日期: " & CStr(Now)

        If Me.Observe.Text <> "开始监护" Then
            Time_Count += 1
            Dim CuTime As Integer
            Dim Minit As Integer
            Dim Second As Integer
            CuTime = Convert.ToInt32(Val(TextBox4.Text)) * 60 - Time_Count
            Minit = Math.Floor(CuTime / 60.0)
            Second = CuTime - 60 * Minit
            TextBox5.Text = " " & Minit & "分" & Second & "秒"

        End If
        If But_Clk = True Then
            Time_Count = 0
            TextBox5.Text = Convert.ToInt32(Val(TextBox4.Text)) & "分" & "00秒"
        End If

    End Sub



    Private Sub Observe_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Observe.Click
        Button2.Enabled = True
        Button2.BackColor = Color.Salmon
        But_Clk = False '判断“停止监护”按钮未按下
        If Observe.Text = "开始监护" Or Observe.Text = "恢复" Then
            Me.ObserveWatch.Start()
            Me.StopWatch.Stop()
            With SerialPort1
                Try
                    If Not .IsOpen Then
                        .Open()
                        Dim ceshi(100) As Byte
                        .Read(ceshi, 0, 100)
                    End If

                Catch ex As Exception
                    MessageBox.Show("未找到设备,请检查串口是否正确连接!", "设备连接出错", MessageBoxButtons.OK, MessageBoxIcon.Warning)  '测试设备是否连接通畅
                    Observe.Text = "开始监护"
                    Observe.BackColor = Color.Lime
                    Exit Sub
                End Try
            End With

            Observe.Text = "暂停"
            Observe.BackColor = Color.Yellow
            ToolStripStatusLabel4.Text = " 监护状态: 正在监护 "
            Me.TextBox7.Text = "正在监护"
            Dayin.Enabled = False
            Dayin.BackColor = Color.WhiteSmoke
            ObserveWatch.Start()

        Else
            Observe.Text = "恢复"
            Observe.BackColor = Color.Lime
            ToolStripStatusLabel4.Text = " 监护状态: 暂停监护 "
            Dayin.Enabled = True
            Dayin.BackColor = Color.Lime
            Me.ObserveWatch.Stop()
            Me.StopWatch.Start()
            Me.TextBox7.Text = "监护暂停"
        End If
    End Sub

    Private Sub SysQuit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles SysQuit.Click
        StopWatch.Stop()
        If Observe.Text = "暂停" Then
            MsgBox("系统正在运行,请先停止监护后再退出系统!", MsgBoxStyle.Critical, "警告")
        Else
            Dim i = MsgBox("确实要退出系统吗?", MsgBoxStyle.Question Or MsgBoxStyle.OkCancel, "退出系统")
            If i = vbOK Then
                Me.Close()
            End If
        End If
    End Sub

    Private Sub PictureBox1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles PictureBox1.Paint

        Dim i
        Dim j
        Dim mypen As New Pen(Color.Black, 0.2)
        mypen.DashStyle = Drawing2D.DashStyle.Dash
        Dim ycount As Integer = 210
        Dim myfont As New Font("宋体", 8, FontStyle.Italic)

        '绘制栅格和文字
        For i = 60 To 100 Step 2
            e.Graphics.DrawLine(Pens.LightBlue, 10, i, PictureBox1.Width, i)
            e.Graphics.DrawLine(Pens.LightGreen, 10, i + 190, PictureBox1.Width, i + 190)
        Next


        For i = 10 To 160 Step 30
            e.Graphics.DrawLine(New Pen(Color.Black, 0.5), 10, i, PictureBox1.Width, i)
            For j = 98 To Me.PictureBox1.Width Step 270
                e.Graphics.DrawString(CStr(ycount), myfont, Brushes.Red, j, i)
            Next
            ycount -= 30
        Next

        ycount = 210
        For i = 200 To 350 Step 30
            e.Graphics.DrawLine(New Pen(Color.Black, 0.5), 10, i, PictureBox1.Width, i)
            For j = 98 To Me.PictureBox1.Width Step 270
                e.Graphics.DrawString(CStr(ycount), myfont, Brushes.Red, j, i)
            Next
            ycount -= 30
        Next

        ycount = 100

        '心率

        For i = 390 To 490 Step 20
            e.Graphics.DrawLine(New Pen(Color.Black, 0.2), 10, i, PictureBox1.Width, i)


            For j = 98 To Me.PictureBox1.Width Step 270
                e.Graphics.DrawString(CStr(ycount), myfont, Brushes.Red, j, i)
            Next
            ycount -= 20

        Next

        For i = 10 To PictureBox1.Width Step 90
            e.Graphics.DrawLine(New Pen(Color.Black, 0.5), i, 10, i, 160)
            e.Graphics.DrawLine(New Pen(Color.Black, 0.5), i, 200, i, 350)
            e.Graphics.DrawLine(New Pen(Color.Black, 0.5), i, 390, i, 490)
        Next
        For i = 10 To 160 Step 10
            e.Graphics.DrawLine(mypen, 10, i, PictureBox1.Width, i)
        Next

        For i = 200 To 350 Step 10
            e.Graphics.DrawLine(mypen, 10, i, PictureBox1.Width, i)
        Next



        For i = 390 To 490 Step 10
            e.Graphics.DrawLine(mypen, 10, i, PictureBox1.Width, i)
        Next


        For i = 10 To PictureBox1.Width Step 30
            e.Graphics.DrawLine(mypen, i, 10, i, 160)
            e.Graphics.DrawLine(mypen, i, 200, i, 350)
            e.Graphics.DrawLine(mypen, i, 390, i, 490)
        Next




    End Sub







    Private Sub HScrollBar1_Scroll(ByVal sender As System.Object, ByVal e As System.Windows.Forms.ScrollEventArgs) Handles HScrollBar1.Scroll
        PictureBox1.Left = -HScrollBar1.Value + 90
    End Sub

    Public x0 As Single = 1
    Public bmp As New Bitmap(8000, 800) '宽度不会超过7200
    Dim y(3) As Byte


    Private Sub StopWatch_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles StopWatch.Tick
        x_plot += 1
    End Sub

    Private Sub SysSet_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles SysSet.Click
        Dim Myform As New SystemSet
        Myform.ShowDialog()
    End Sub

    Private Sub DangAn_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles DangAn.Click
        Dim MyD As New DangAn
        MyD.ShowDialog()
    End Sub

    Private Sub Print_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Print.Click
        Dim MyF As New PrintF
        MyF.ShowDialog()
    End Sub

    Private Sub Dayin_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Dayin.Click
        Me.PrintDialog1.ShowDialog()
    End Sub
    Public But_Clk As Boolean
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        ToolStripStatusLabel4.Text = " 监护状态: 已停止 "
        Dim MyResult As MsgBoxResult = MessageBox.Show("将删除所有图像数据,确定继续吗?", "数据删除", MessageBoxButtons.OKCancel, MessageBoxIcon.Question)
        If MyResult = MsgBoxResult.Cancel Then
            Exit Sub
        End If
        Observe.Text = "开始监护"
        Observe.BackColor = Color.Lime
        Dim a As Graphics = Graphics.FromImage(bmp)
        a.Clear(Me.PictureBox1.BackColor)
        x_plot = 10
        PictureBox1.Refresh()
        But_Clk = True
        StopWatch.Stop()
        Me.ObserveWatch.Stop()
        Me.TextBox7.Text = "已停止"
        Me.HScrollBar1.Visible = False

        Button2.Enabled = False
        Button2.BackColor = Color.WhiteSmoke
    End Sub

    Private Sub LinkLabel2_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles LinkLabel2.LinkClicked
        AboutBox1.ShowDialog()
    End Sub

    Private Sub LinkLabel1_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles LinkLabel1.LinkClicked
        Dim MyD As New DangAn
        MyD.ShowDialog()
    End Sub



    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        FormDatabase.ShowDialog()
    End Sub

    Dim buffB(3) As Byte '这个数组存储的是胎心音1、胎心音2及宫压值

    Private Sub SerialPort1_DataReceived(ByVal sender As Object, ByVal e As System.IO.Ports.SerialDataReceivedEventArgs) Handles SerialPort1.DataReceived
        SerialPort1.Read(buffB, 0, 4)
        If Hex(buffB(0)) = "F8" Then '协议部分
            BeginInvoke(New EventHandler(AddressOf ONMLoadA), SerialPort1.ReadBufferSize) '使用委托方式显示接收到的字符串
        End If
    End Sub

    Private FHR1(1) As Byte  '初始化 
    Private FHR2(1) As Byte
    Private UC(1) As Byte

    Private ACount = 0     '用于记录和判断两个绘图点
    Dim x_plot As Integer = 10  '绘图横坐标
    Dim inter() As Integer  '用于记录中断过程,没暂停一次出发中断,记录中断位置
    Dim BUFF(3) As Byte
    Dim BUFF_OFF = 0
    '线程编程,此处是核心部分,把数据写入文件中
    Sub ONMLoadA(ByVal sender As System.Object, ByVal e As System.EventArgs)
        If x_plot = 0 Then
            FHR1(1 - ACount) = 0
            FHR2(1 - ACount) = 0
            UC(1 - ACount) = 0
        End If

        For i As Integer = 0 To 3
            Me.RichTextBox1.Text += Hex(buffB(i))
        Next
        Me.RichTextBox1.Text += "\"
        Dim sw As New FileStream(path, FileMode.Append, FileAccess.Write)
        sw.Write(buffB, 0, 4)
        sw.Close()
        Dim sr As New FileStream(path, FileMode.Open, FileAccess.Read)
        sr.Seek(BUFF_OFF, SeekOrigin.Begin)
        For le As Integer = 0 To 3

            BUFF(le) = sr.ReadByte()
        Next

        sr.Close()

        FHR1(ACount) = BUFF(1)
        FHR2(ACount) = BUFF(2)
        UC(ACount) = BUFF(3)
        Using MyGraph As Graphics = Graphics.FromImage(bmp)
            Dim Mypen As New Pen(Color.Black, 2)
            MyGraph.FillRectangle(Brushes.White, x_plot, 0, 1, bmp.Height)
            MyGraph.DrawLine(Mypen, x_plot - 1, 40 + FHR1(1 - ACount), x_plot, 40 + FHR1(ACount))   '画心率
            MyGraph.DrawLine(Mypen, x_plot - 1, 230 + FHR2(1 - ACount), x_plot, 230 + FHR2(ACount))
            MyGraph.DrawLine(Mypen, x_plot - 1, 420 + UC(1 - ACount), x_plot, 420 + UC(ACount))

            If ACount = 0 Then
                ACount = 1
            Else
                ACount = 0
            End If
            PictureBox1.Image = bmp
            x_plot += 1 '横坐标
            BUFF_OFF += 4
            If x_plot > Me.PictureBox1.Width Then
                x_plot = 10
            End If
        End Using
    End Sub


    Private Sub ObserveWatch_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ObserveWatch.Tick
        '绘制sin函数
        y(0) = &HF8
        y(1) = Math.Round(Math.Sin(x0 / 15) * 25) + 30
        y(2) = Math.Round(Math.Cos(x0 / 15) * 25) + 30
        y(3) = x0 Mod 30
        If Not But_Clk Then
            With SerialPort1
                .Write(y, 0, 4)
            End With
        End If
        x0 += 1
    End Sub



    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        If Button3.Text = "取消栅格" Then
            Button3.Text = "增加栅格"
            Using MyG As Graphics = Me.PictureBox1.CreateGraphics
                MyG.Clear(Color.White)
                PictureBox1.Image = bmp
            End Using

        Else
            Button3.Text = "取消栅格"
        End If

    End Sub
End Class



⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -