mainform.vb

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




Imports System.IO
Imports System.Drawing
Imports System.Text
Public Class MainForm
    Public PortID As String = "COM1" '用于选择端口号，默认为COM1
    Public Point_Count As Integer = 0 '总点数
    Public File_Flag As Integer = 0 '判断是否已保存文件
    Public FHR1_ForeColor As Color = Color.BlueViolet
    Public FHR2_ForeColor As Color = Color.Lime
    Public UC_ForeColor As Color = Color.Blue
    Public Shadow_ForeColor As Color = Color.Gainsboro
    Public MyBaudRate As Integer = 57600
    Public Twin_Offset As Integer = 0
    Public Monitor_Time As Integer = 15 '监护时长
    Public Auto_Save As Boolean = False '自动保存
    '以下是子窗口打开事件
    Private Sub Sys_Set_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Sys_Set.Click
        SystemSet.ShowDialog()
    End Sub

    Private Sub Pra_File_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Pra_File.Click
        DangAn.ShowDialog()
    End Sub

    Public Sub Start_Obv_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Start_Obv.Click
        Me.FHR_1.Visible = True
        Me.FHR_2.Visible = True
        If Me.Print_rate.Text = "Not set" Then     '用户第一次登陆
            MessageBox.Show("Please set up the system first！", "Startup failure", MessageBoxButtons.OK, MessageBoxIcon.Information)                                    '*************这里设置走纸速度
            Exit Sub
        ElseIf Me.Print_rate.Text = "3 cm/min" Then                  '*******************************
            DataTimer.Interval = 500
        ElseIf Me.Print_rate.Text = "2 cm/min" Then                   '*******************************
            DataTimer.Interval = 750
        Else
            DataTimer.Interval = 1500
        End If

        Print_Image.Enabled = False
        Print_Image.BackColor = Color.LightGray


        If Me.Start_Obv.Text = "Start" Then
            '以下清除数据记录
            If Point_Count = 0 Then
                Me.Prag_Name.Text = "Not set"
                Me.Prag_HosID.Text = "Not set"
                Me.Prag_week.Text = "Not set"
                Me.Prag_BedID.Text = "Not set"
                Me.Obv_Left.Text = "00min00sec"
            End If
            Point_Count = 0
            Page_Count = 0
            Arr_Count = 0
            FHR1(1) = 0
            FHR2(1) = 0
            UC(1) = 0
            X_Pos = 0
            Me.ComboBox1.Text = Nothing
            Me.ComboBox1.Items.Clear()
            Me.PictureBox1.Left = 0
            Me.HScrollBar1.Value = 0
            Me.Auto_Save = False
            Me.Total_Page.Text = "1 Page total"
            ReDim bmp(0)
            File_Flag = 0
            Me.PictureBox1.Image = Nothing
            Try
                With SPort
                    If SPort.IsOpen Then
                        SPort.Close()
                    End If
                    .PortName = PortID
                    .BaudRate = MyBaudRate
                    .ReadBufferSize = 512
                    .DataBits = 8
                    .ReadTimeout = 500  '0.5秒超时
                    .ReceivedBytesThreshold = 5
                End With
                Dim ceshi(15) As Byte
                If Not SPort.IsOpen Then
                    SPort.Open()
                End If
                SPort.Read(ceshi, 0, 10)
            Catch
                MessageBox.Show("An error occurred while opening the serial port ,please check your connection and make sure you have chosen a right serial port！", "error", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
                Exit Sub
            End Try
        End If
        Stop_obv.Enabled = True  '停止按钮可用
        Stop_obv.BackColor = Color.Red

        If Start_Obv.Text = "Start" Or Start_Obv.Text = "Resume" Then
            Start_Obv.Text = "Pause"
            Me.Obv_Timer.Start()
            Me.FHR_1.Text = 0
            Me.FHR_2.Text = 0
            Me.UC_Obv.Text = 0
            Start_Obv.BackColor = Color.Yellow
            Start_Obv.Image = Me.ImageList1.Images(9)
            ToolStripStatusLabel3.Text = "Monitor State: Monitoring"
            Me.Obv_status.Text = "Monitoring"

        ElseIf Start_Obv.Text = "Pause" Then
            Start_Obv.Text = "Resume"
            Me.RichTextBox1.Text += Now & "Pause" & vbCrLf
            Start_Obv.BackColor = Color.LimeGreen
            Start_Obv.Image = Me.ImageList1.Images(8)
            ToolStripStatusLabel3.Text = "Monitor State: Paused"
            Me.Obv_status.Text = "Paused"
            '以下代码用于记录暂停数据
        End If
    End Sub

    Private Sub Stop_obv_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Stop_obv.Click
        DataTimer.Stop()
        Obv_Timer.Stop()
        Me.ReceiveTimer.Stop()
        Time_Tick = 0
        Start_Obv.Text = "Start"
        Start_Obv.BackColor = Color.LimeGreen
        Start_Obv.Image = Me.ImageList1.Images(8)
        Print_Image.Enabled = True
        Print_Image.BackColor = Color.LimeGreen

        Me.Obv_status.Text = "Start"
        ToolStripStatusLabel3.Text = "Monitor State: Ready"
        Try
            '************************测试用数据，以下程序仅供测试
            '  Timer_Ceshi.Stop()
            '******************************************************
            If SPort.IsOpen = True Then
                SPort.Close()
            End If
            Stop_obv.Enabled = False
            Stop_obv.BackColor = Color.LightGray
            If SystemSet.RadioButton10.Checked And Me.Point_Count > 50 Then
                If Me.Prag_Name.Text = "" Or Me.Prag_Name.Text = "Not set" Then
                    Me.Auto_Save = True
                    DangAn.ShowDialog()
                Else
                    Me.Auto_Save = False
                    Me.ImageSave_Click(Nothing, Nothing)
                End If
            End If
            Me.FHR_1.Visible = True
            Me.FHR_2.Visible = True
            Me.FHR_1.ForeColor = Color.Black
            Me.FHR_2.ForeColor = Color.Black
        Catch ex As Exception
            DataTimer.Stop()
            Me.ReceiveTimer.Stop()
            Exit Sub
        End Try
    End Sub


    Private Sub MoreInform_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles MoreInform.LinkClicked
        DangAn.ShowDialog()
    End Sub

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

    Private Sub PictureBox1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles PictureBox1.Paint
        Me.PictureBox1.BackgroundImage = Nothing   '这句用来清除栅格，不能使用Clear语句
        '以下绘制栅格
        Dim MyRect1(Me.PictureBox1.Width / 120 - 1) As Rectangle  'FHR1/2  栅格示意
        Dim MyRect2(Me.PictureBox1.Width / 120 - 1) As Rectangle  'UC
        Dim MyPen As New Pen(Color.YellowGreen, 1)
        Dim RecColor As New Pen(Color.Gray, 1)
        Dim MyColor As Color = System.Drawing.Color.FromArgb(180, 220, 200, 230)
        Dim Mybrush As New SolidBrush(MyColor)
        MyPen.DashStyle = Drawing2D.DashStyle.Dash
        For i As Integer = 0 To Me.PictureBox1.Width / 120 - 1
            MyRect1(i).X = i * 120 + 5
            MyRect1(i).Y = 50
            MyRect1(i).Width = 120
            MyRect1(i).Height = 315

            MyRect2(i).X = i * 120 + 5
            MyRect2(i).Y = 450
            MyRect2(i).Width = 120
            MyRect2(i).Height = 150
            For j As Integer = 1 To 2
                e.Graphics.DrawLine(MyPen, 5 + 120 * i + 40 * j, 50, 5 + 120 * i + 40 * j, 365)
                e.Graphics.DrawLine(MyPen, 5 + 120 * i + 40 * j, 450, 5 + 120 * i + 40 * j, 600)
            Next
        Next

        e.Graphics.DrawRectangles(RecColor, MyRect1)
        e.Graphics.DrawRectangles(RecColor, MyRect2)
        For i As Integer = 0 To 21
            If i Mod 3 = 0 Then
                e.Graphics.DrawLine(Pens.LightSteelBlue, 5, 50 + i * 15, 1085, 50 + i * 15)
            Else
                e.Graphics.DrawLine(MyPen, 5, 50 + i * 15, 1085, 50 + i * 15)
            End If
        Next
        For i As Integer = 0 To 10
            If i Mod 2 = 0 Then
                e.Graphics.DrawLine(Pens.LightSteelBlue, 5, i * 15 + 450, 1085, i * 15 + 450)
            Else
                e.Graphics.DrawLine(MyPen, 5, i * 15 + 450, 1085, i * 15 + 450)
            End If

        Next


        Dim YGrid As Integer = 240
        For i As Integer = 0 To 7
            e.Graphics.DrawString(YGrid - i * 30, New Font("Arial", 8, FontStyle.Italic), Brushes.DarkGreen, 545, 45 + i * 45)
        Next
        YGrid = 100
        For i As Integer = 0 To 5
            e.Graphics.DrawString(YGrid - i * 20, New Font("Arial", 8, FontStyle.Italic), Brushes.DarkGreen, 545, 445 + i * 30)
        Next
    End Sub

    Private Sub MainForm_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        Login.Close()
    End Sub

    Private Sub MainForm_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        NowTimer.Start() '系统时钟
        If Obv_Timer.Enabled = True Then
        End If
        Obv_Timer.Stop()  '防止意外打开计时
        ToolStripStatusLabel4.Text += Login.UserID.Text  ' 操作用户
        '  Me.Opr_User.Text = Login.UserID.Text
        '任务栏信息更新
        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 = "Not set"
            Me.Prag_HosID.Text = "Not set"
            Me.Prag_BedID.Text = "Not set"
            Me.Prag_week.Text = "Not set"
        End If

        If Login.RadioButton2.Checked Then   '系统管理员进入
            Me.Data_Man.Text = "Database"
        Else
            Me.Data_Man.Text = "Help"
        End If

        Dim NewPath As String = Application.StartupPath & "\Data"
        If Not IO.Directory.Exists(NewPath) Then
            IO.Directory.CreateDirectory(NewPath)
        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
    Dim DataBuff(4) As Byte
    Dim BuffData(3) As Byte


    Private Sub SPort_DataReceived(ByVal sender As Object, ByVal e As System.IO.Ports.SerialDataReceivedEventArgs) Handles SPort.DataReceived

        Try
            DataBuff(0) = SPort.ReadByte
            If DataBuff(0) = &HF8 Then
                SPort.Read(DataBuff, 1, 4)
                BeginInvoke(New EventHandler(AddressOf DataFromPort), SPort.ReadBufferSize)
            End If
        Catch ex As Exception
            If DataTimer.Enabled = True Then
                DataTimer.Stop()
            End If
            MessageBox.Show("The procedure is terminated unexpectedly！", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
        End Try
    End Sub
    Private Err_Off As Integer = 0


    Private bmp(0) As Bitmap
    Private Arr_Count As Integer = 0
    Private FHR1() As Integer = {0, 0}  '用于暂存数据
    Private FHR2() As Integer = {0, 0}
    Private UC() As Integer = {0, 0}
    Private X_Pos As Integer = 0 '起始横坐标
    Private Page_Count As Integer = 0  '换页
    Private Time_Count As Integer = 0

    Sub DataFromPort(ByVal sender As System.Object, ByVal e As System.EventArgs)
        If DataBuff(4) = &H1 Then
            Mark_State = 1
        ElseIf DataBuff(4) = &H2 Then
            Mark_State = 2
        Else
            Mark_State = 0
        End If
        For i As Integer = 0 To 3
            BuffData(i) = DataBuff(i)
        Next
        If Me.Stop_obv.Enabled = False Then
            DataTimer.Enabled = False '开始显示和存数据
            Me.ReceiveTimer.Enabled = False
            Exit Sub
        Else
            DataTimer.Enabled = True
            Me.ReceiveTimer.Enabled = True
        End If
    End Sub
    Dim MyBytes() As Byte = New Byte(4) {&HF8, &HFF, &HFF, &HFF, &H0}  '无数据点用FF表示
    Dim MyTime() As String
    Dim Mark_State As Integer = 0


    Private Sub DataTimer_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles DataTimer.Tick

        If Point_Count Mod 1080 = 0 Then
            Me.Total_Page.Text = Page_Count + 1 & " Page total"
            Me.ComboBox1.Items.Add(Page_Count + 1)
            Me.ComboBox1.Text = Page_Count + 1
        End If
        If X_Pos = 0 Then