ve-9e.tmp

这是我自己用VB.NET编写的一款监护仪的电脑软件

            e.Graphics.DrawRectangle(Pens.Gray, 2, 2, PictureBox1.Width, 190)
            e.Graphics.DrawRectangle(Pens.Gray, 2, 2 + 210, PictureBox1.Width, 190)
            e.Graphics.DrawRectangle(Pens.Gray, 2, 2 + 435, PictureBox1.Width, 100)


        End If
err:    Exit Sub

    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        If Button1.Text = "取消栅格" Then
            Button1.Text = "增加栅格"
            Me.RichTextBox1.Visible = False
        Else
            Button1.Text = "取消栅格"
            Me.RichTextBox1.Visible = True
        End If
        Me.PictureBox1.Refresh()
    End Sub

    Private Sub MainForm_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        NowTimer.Start() '系统时钟
        Obv_Timer.Stop()  '防止意外打开计时
        DataTimer.Stop()
        File.Create(MyPath, 512, FileOptions.Asynchronous) '建文件
        ToolStripStatusLabel4.Text += Login.UserID.Text  ' 操作用户
        Me.Opr_User.Text = Login.UserID.Text
        With SPort
            .PortName = My.Computer.Ports.SerialPortNames(PortID)
            .BaudRate = 57600
            .ReadBufferSize = 1024
            .DataBits = 8
            .ReadTimeout = 1000  '1秒超时
            .ReceivedBytesThreshold = 48
        End With
        '任务栏信息更新
        If DangAn.xingming.Text <> "" Then
            Me.Prag_Name.Text = DangAn.xingming.Text
            Me.Prag_HosID.Text = DangAn.bianhao.Text
            Me.Prag_BedID.Text = DangAn.chuangweihao.Text
            Me.Prag_week.Text = DangAn.yunzhou.Text
        Else
            Me.Prag_Name.Text = "未设置"
            Me.Prag_HosID.Text = "未设置"
            Me.Prag_BedID.Text = "未设置"
            Me.Prag_week.Text = "未设置"
        End If
        If SystemSet.yiyuanming.Text <> "" Then
            Me.Hos_Name.Text = SystemSet.yiyuanming.Text
        Else
            Me.Hos_Name.Text = "未设置"
        End If
        If Login.RadioButton2.Checked Then   '系统管理员进入
            Me.Data_Man.Text = "数据库管理"
        Else
            Me.Data_Man.Text = "帮助"
        End If
    End Sub
    Dim Time_Tick As Integer = 0
    Private Sub NowTimer_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NowTimer.Tick
        ToolStripStatusLabel2.Text = Format(Now, "yyyy年M月d日 ") & Format(Now, "tt hh点mm分ss秒")  '系统时间
    End Sub



    Private Sub SPort_DataReceived(ByVal sender As Object, ByVal e As System.IO.Ports.SerialDataReceivedEventArgs) Handles SPort.DataReceived
        On Error GoTo err
        SPort.Read(BuffData, 0, 4)
        Exp_Bytes = SPort.BytesToRead
        If BuffData(0) = &HF8 Then
            BeginInvoke(New EventHandler(AddressOf DataFromPort), SPort.ReadBufferSize)
        End If
Err:    Threading.Thread.CurrentThread.Abort()

    End Sub
    Private Err_Off As Integer = 0
    Private Err_FHR1 As Integer = 0    '报警计数
    Private Err_FHR2 As Integer = 0
    Private Err_UC As Integer = 0

    Private bmp As New Bitmap(750, 600)

    Private Arr_Count As Integer = 0
    Private FHR1() As Byte = {0, 0}  '用于暂存数据
    Private FHR2() As Byte = {0, 0}
    Private UC() As Byte = {0, 0}

    Private X_Pos As Integer = 0 '起始横坐标
    Private Pause_Count As Integer = 0 '记录暂停次数
    Private Page_Count As Integer = 0  '换页
    Private Time_Delay As Integer = 10  '这里控制显示速度

    Sub DataFromPort(ByVal sender As System.Object, ByVal e As System.EventArgs)
        If Me.Stop_obv.Text = "开始监护" Then
            DataTimer.Stop() '开始显示和存数据
        Else
            DataTimer.Enabled = True
        End If

        '指示换页
        '***************************************************************

        If SystemSet.CheckBox2.Checked = True Then
            '探头脱落报警
            If BuffData(1) <= 20 Or BuffData(3) <= &HA Then   '空数据发送格式&HFF 00 00 0A
                Err_Off += 1
            End If
            If Err_Off > 10 Then
                Err_Off = 0
                Me.Stop_obv_Click(Nothing, Nothing)
                MessageBox.Show("探头脱落，请重新连接！", "警告", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
                Exit Sub
            End If
        End If

        If SystemSet.CheckBox3.Checked = True Then
            '宫压报警
            If BuffData(3) > SystemSet.ComboBox4.Text Then
                Err_UC += 1
            End If

            If Err_UC > 10 Then
                Err_UC = 0
                Me.Stop_obv_Click(Nothing, Nothing)
                MessageBox.Show("宫压不正常！", "警告", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
                Exit Sub
            End If
        End If


        If SystemSet.CheckBox3.Checked = True Then

            '心率报警
            If BuffData(1) > SystemSet.ComboBox1.Text Or BuffData(1) < SystemSet.ComboBox2.Text Then
                Err_FHR1 += 1
            End If
            If Err_FHR1 > 10 Then
                Err_FHR1 = 0
                Me.Stop_obv_Click(Nothing, Nothing)
                MessageBox.Show("胎心音1不正常！", "警告", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
                Exit Sub
            End If

            If BuffData(2) > SystemSet.ComboBox1.Text Or BuffData(1) < SystemSet.ComboBox2.Text Then
                Err_FHR2 += 1
            End If
            If Err_FHR2 > 10 Then
                Err_FHR2 = 0
                Me.Stop_obv_Click(Nothing, Nothing)
                MessageBox.Show("胎心音2不正常！", "警告", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
                Exit Sub
            End If
        End If
    End Sub


    Private Sub ToolStripStatusLabel6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripStatusLabel6.Click
        System.Diagnostics.Process.Start("http://www.szbestman.com")
    End Sub

    Private Sub PrintDocument1_PrintPage(ByVal sender As System.Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage

        With Me.PrintDocument1
            .DefaultPageSettings.Margins.Left = 10
            .DefaultPageSettings.Margins.Right = 10
            .DefaultPageSettings.Margins.Bottom = 10
            .DefaultPageSettings.Margins.Top = 10
            .DefaultPageSettings.PrinterResolution.Kind = Printing.PrinterResolutionKind.High
            .DefaultPageSettings.Landscape = True '横向打印

        End With

        Dim dpi As Integer
        e.Graphics.DrawImage(PrintBMP, 0, 0)  '网格
        dpi = e.Graphics.DpiX   '获取dpi数
        e.Graphics.PageUnit = GraphicsUnit.Display
        Static Page_C As Integer = 1  '页码
        Dim i_Page As Integer = 0  '页码
        i_Page = Me.Draw_PageImage()
        e.Graphics.DrawImage(MyTemp_Bmp, 10, 10)

        e.Graphics.DrawImage(Me.PictureBox2.Image, 300, 10)
        e.Graphics.DrawString("电脑胎儿监护图", New Font("黑体", 30), Brushes.Black, 420, 20)
        e.Graphics.DrawString("档案编号: " & Me.Prag_HosID.Text, New Font("黑体", 16), Brushes.Black, 220, 80)
        e.Graphics.DrawString("第 " & Page_C & " 页，" & "共 " & CInt(Point_Count / Paper_Length + 1) & " 页", New Font("宋体", 12), Brushes.Black, 500, 84)
        e.Graphics.DrawString("孕妇姓名: " & Me.Prag_Name.Text, New Font("宋体", 14, FontStyle.Bold), Brushes.Black, 650, 84)
        e.Graphics.DrawString(Me.Hos_Name.Text & "   地址： " & SystemSet.yiyuandizhi.Text & "   电话： " & SystemSet.yiyuandianhua.Text, New Font("黑体", 12), Brushes.Black, 250, 770)
        e.Graphics.DrawLine(Pens.Black, 100, 765, 1100, 765)
        e.Graphics.DrawLine(Pens.Black, 250, 71, 750, 71)
        e.Graphics.DrawString("走纸速度:" & Me.Print_rate.Text & "   操作人:" & Me.Opr_User.Text & "; 存档时间:" & Format(Now, "yyyy年M月d日 tt hh:mm:ss"), New Font("黑体", 16), Brushes.Black, 200, 745)
        Try
            For k As Integer = 0 + (Page_C - 1) * 6 To MyTime.Length - 1  '画时间
                e.Graphics.FillEllipse(Brushes.DarkGoldenrod, 5 + k * 188 - (Page_C - 1) * 1080, 446 + 125, 10, 10)
                e.Graphics.DrawString(MyTime(k), New Font("宋体", 10), Brushes.DarkSlateBlue, 15 + k * 188 - (Page_C - 1) * 1080, 444 + 125)
            Next
        Catch ex As Exception
            Exit Try
        End Try



        If i_Page > 0 Then
            e.HasMorePages = True
            Page_C += 1
        Else
            e.HasMorePages = False
            Page_C = 1
        End If
    End Sub

    Dim MyTemp_Bmp As Bitmap   '打印画布
    Dim PrintRead_Data() As Byte   '打印数据，从Data.dat文件读取
    Public Const Paper_Length As Integer = 1080  '打印画布长度


    Function Draw_PageImage()   '绘制打印曲线
        On Error Resume Next
        MyTemp_Bmp = New Bitmap(Paper_Length, 2500)
        Dim Page_Add As Integer = 1  '页码
        Static Point_Number As Integer = 0   '计算页数，每调用一次函数则点数指示换页
        Dim read_Count As Integer = 0

        Dim MyFS1 As FileStream = File.Open(MyPath, FileMode.Open, FileAccess.Read)
        MyFS1.Seek(Point_Number * Paper_Length * 4, SeekOrigin.Begin)
        ReDim PrintRead_Data(MyFS1.Length - 1 - Point_Number * Paper_Length * 4)
        Dim MySR As New BinaryReader(MyFS1)
        PrintRead_Data = MySR.ReadBytes(MyFS1.Length)
        MySR.Close()
        MyFS1.Close()


        Dim MyDrawPic As Graphics = Graphics.FromImage(MyTemp_Bmp)
        MyDrawPic.PageUnit = GraphicsUnit.Display

        ReDim FHR11(PrintRead_Data.Length / 4)
        ReDim FHR21(PrintRead_Data.Length / 4)
        ReDim UC1(PrintRead_Data.Length / 4)
        Page_Add = PrintRead_Data.Length / Paper_Length / 4 + 1 '计算页码

        If Page_Add > 1 Then
            Point_Number += 1
        Else
            If Point_Number <> 0 Then
                Point_Number = 0  '显式重置
            End If
        End If

        For i As Integer = 1 To PrintRead_Data.Length - 1 Step 4
            FHR11(read_Count) = PrintRead_Data(i)
            FHR21(read_Count) = PrintRead_Data(i + 1)
            UC1(read_Count) = PrintRead_Data(i + 2)
            read_Count += 1
        Next

        ' @@@@@@@@@@@@@@@@@@@@@@@@@@@@重绘部分代码
        Dim Temp_XPos As Integer = 0

        For i As Integer = 1 To FHR11.Length - 2
            Temp_XPos = i - 1
            If FHR11(i - 1) <> &HFF Then
                If FHR11(i) <> &HFF Then
                    MyDrawPic.DrawLine(Pens.Blue, Temp_XPos, 130 + 80 + FHR11(i - 1), Temp_XPos + 1, 130 + 80 + FHR11(i))
                    MyDrawPic.DrawLine(Pens.Blue, Temp_XPos, 130 + 210 + 80 + FHR21(i - 1), Temp_XPos + 1, 130 + 210 + 80 + FHR21(i))
                    MyDrawPic.DrawLine(Pens.DarkBlue, Temp_XPos, 130 + 435 + 10 + UC1(i - 1), Temp_XPos + 1, 130 + 435 + 10 + UC1(i))
                End If
            End If
            If Temp_XPos >= Paper_Length Then   '超出一页
                Exit For
            End If
        Next
        Return Point_Number
    End Function

    Private Sub Draw_PrintImage(ByVal a As Bitmap)
        Dim e As Graphics = Graphics.FromImage(a)
        e.PageUnit = GraphicsUnit.Display
        e.Clear(Color.White)

        '#################################################重绘代码
        '以下绘制栅格

        Dim MyRect1(1200 / 90 - 1) As Rectangle  'FHR1  栅格示意
        Dim MyRect2(1200 / 90 - 1) As Rectangle  'FHR2
        Dim MyRect3(1200 / 90 - 1) As Rectangle  'UC
        Dim MyColor As Color = System.Drawing.Color.FromArgb(130, 200, 200, 200)
        Dim Mybrush As New SolidBrush(MyColor)