📄 ve-1de.tmp
字号:
Imports System.IO
Imports System.Drawing
Imports System.Text
Public Class MainForm
Public PortID As Integer = 0 '用于选择端口号，默认为COM1
Public MyPath As String = Application.StartupPath & "Data.dat"
'以下是子窗口打开事件
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
Private Sub Print_set_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Print_set.Click
PrintF.ShowDialog()
End Sub
Private Sub Sys_quit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Sys_quit.Click
If Me.Start_Obv.Text <> "开始监护" Then
MessageBox.Show("请先停止监护后再退出系统！", "提示", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Exit Sub
End If
File.Delete(MyPath) '删除文件
Close()
Login.Close() '关闭登陆窗口
End Sub
Private Sub Data_Man_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Data_Man.Click
FormDatabase.ShowDialog()
End Sub
Private Sub Aboout_us_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles Aboout_us.LinkClicked
AboutBox1.ShowDialog()
End Sub
Private Sub Start_Obv_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Start_Obv.Click
Stop_obv.Enabled = True
Stop_obv.BackColor = Color.Red
If Start_Obv.Text = "开始监护" Or Start_Obv.Text = "恢复" Then
Start_Obv.Text = "暂停"
Start_Obv.BackColor = Color.Yellow
Print_Image.Enabled = False
Print_Image.BackColor = Color.LightGray
ToolStripStatusLabel3.Text = "监护状态:正在监护"
ElseIf Start_Obv.Text = "暂停" Then
Start_Obv.Text = "恢复"
Start_Obv.BackColor = Color.LimeGreen
Print_Image.Enabled = True
Print_Image.BackColor = Color.LimeGreen
ToolStripStatusLabel3.Text = "监护状态:监护暂停"
'以下代码用于记录暂停数据
Pause_Begin(Pause_Count) = Point_Count
Pause_Length(Pause_Count) = Count
End If
If Start_Obv.Text = "恢复" Then
Pause_Count += 1 '记录暂停次数
ReDim Preserve Pause_Begin(Pause_Count)
ReDim Preserve Pause_Length(Pause_Count)
End If
End Sub
Private Sub Stop_obv_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Stop_obv.Click
Start_Obv.Text = "开始监护"
Start_Obv.BackColor = Color.LimeGreen
Print_Image.Enabled = False
Print_Image.BackColor = Color.LightGray
ToolStripStatusLabel3.Text = "监护状态:未开始"
DataTimer.Stop() '停止处理数据
'以下清除数据记录
Point_Count = 0
Count = 0
Pause_Count = 0
Page_Count = 0
Arr_Count = 0
FHR1(1) = 0
FHR2(1) = 0
UC(1) = 0
X_Pos = 0
ReDim Pause_Begin(Pause_Count)
ReDim Pause_Length(Pause_Count)
If SPort.IsOpen = True Then
SPort.Close()
End If
Stop_obv.Enabled = False
Stop_obv.BackColor = Color.LightGray
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
If Me.Button1.Text = "取消栅格" Then
'以下绘制栅格
Dim MyRect1(7) As Rectangle 'FHR1 栅格示意
Dim MyRect2(7) As Rectangle 'FHR2
Dim MyRect3(7) As Rectangle 'UC
Dim MyPen As New Pen(Color.Black, 1)
Dim MyColor As Color = System.Drawing.Color.FromArgb(130, 200, 200, 200)
Dim Mybrush As New SolidBrush(MyColor)
e.Graphics.FillRectangle(Mybrush, 2, 82, 720, 50) '画正常区，激发报警
e.Graphics.FillRectangle(Mybrush, 2, 82 + 210, 720, 50)
MyPen.DashStyle = Drawing2D.DashStyle.Dash
For i As Integer = 0 To 7
MyRect1(i).X = 2 + i * 90
MyRect1(i).Y = 2
MyRect1(i).Width = 90
MyRect1(i).Height = 190
MyRect2(i).X = 2 + i * 90
MyRect2(i).Y = 212
MyRect2(i).Width = 90
MyRect2(i).Height = 190
MyRect3(i).X = 2 + i * 90
MyRect3(i).Y = 437
MyRect3(i).Width = 90
MyRect3(i).Height = 100
For j As Integer = 1 To 2
e.Graphics.DrawLine(MyPen, 90 * i + 30 * j, 2, 90 * i + 30 * j, 192)
e.Graphics.DrawLine(MyPen, 90 * i + 30 * j, 212, 90 * i + 30 * j, 402)
e.Graphics.DrawLine(MyPen, 90 * i + 30 * j, 437, 90 * i + 30 * j, 537)
Next
Next
e.Graphics.DrawRectangles(Pens.Black, MyRect1)
e.Graphics.DrawRectangles(Pens.Black, MyRect2)
e.Graphics.DrawRectangles(Pens.Black, MyRect3)
For i As Integer = 1 To 18
e.Graphics.DrawLine(MyPen, 2, i * 10 + 2, 722, i * 10 + 2)
e.Graphics.DrawLine(MyPen, 2, i * 10 + 212, 722, i * 10 + 212)
If i < 10 Then
e.Graphics.DrawLine(MyPen, 2, i * 10 + 437, 722, i * 10 + 437)
End If
Next
'标注坐标
Dim Pos_Value As Integer = 240
For i As Integer = 0 To 6
e.Graphics.DrawString(Pos_Value, New Font("黑体", 8, FontStyle.Italic), Brushes.Red, 240, i * 30)
e.Graphics.DrawString(Pos_Value, New Font("黑体", 8, FontStyle.Italic), Brushes.Red, 240, 210 + i * 30)
Pos_Value -= 30
Next
Pos_Value = 100
For i As Integer = 0 To 5
e.Graphics.DrawString(Pos_Value, New Font("黑体", 8, FontStyle.Italic), Brushes.Red, 240, 435 + i * 20)
Pos_Value -= 20
Next
e.Graphics.DrawString(50, New Font("黑体", 8, FontStyle.Italic), Brushes.DarkBlue, 240, 192)
e.Graphics.DrawString(50, New Font("黑体", 8, FontStyle.Italic), Brushes.DarkBlue, 240, 402)
e.Graphics.DrawString("胎心音1", New Font("宋体", 9), Brushes.Red, 5, 189)
e.Graphics.DrawString("胎心音2", New Font("宋体", 9), Brushes.Red, 5, 401)
e.Graphics.DrawString("宫压", New Font("宋体", 9), Brushes.Red, 5, 536)
Me.PictureBox1.Image = bmp
Else '这里删除栅格
e.Graphics.Clear(Color.White)
Me.PictureBox1.Image = bmp
End If
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 = "增加栅格"
Else
Button1.Text = "取消栅格"
End If
Me.PictureBox1.Refresh()
End Sub
Private Sub MainForm_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Me.Refresh()
NowTimer.Start() '系统时钟
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
Try
.Open()
Dim MyByte As Byte = &HF8
.ReadTo(MyByte)
Catch ex As Exception
MessageBox.Show("COM1端口无效，请检查设备是否正确连接，或通过系统设置选择其它端口！", "连接失败", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
End Try
End With
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, " tth点mm分ss秒") '状态栏时间
If Me.Start_Obv.Text <> "开始监护" Then
Dim Mytmp As Integer
Mytmp = Convert.ToInt32(Val(Me.Obv_time.Text))
Me.Obv_Left.Text = Math.Floor((Mytmp * 60 - Time_Tick) / 60) & "分" & (Mytmp * 60 - Time_Tick) Mod 60 & "秒"
Time_Tick += 1
Else
Me.Obv_Left.Text = Val(Me.Obv_time.Text) & "分" & "00秒"
Time_Tick = 0
End If
'************************测试用数据，以下程序仅供测试
'**************************************************
If Me.Start_Obv.Text <> "开始监护" Then
Dim a As String = "I am one of the best of the world"
If Not SPort.IsOpen Then
SPort.Open()
End If
SPort.Write(a)
Else
SPort.Close()
End If
End Sub
Private Sub ToolStripStatusLabel7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripStatusLabel7.Click
System.Diagnostics.Process.Start("http://www.szbestman.com")
End Sub
Dim BuffData(48) As Byte
Dim Err_Counter As Integer = 0 '判断数据是否接收出错
Private Sub SPort_DataReceived(ByVal sender As Object, ByVal e As System.IO.Ports.SerialDataReceivedEventArgs) Handles SPort.DataReceived
SPort.Read(BuffData, 0, 4)
If BuffData(0) = &HF8 Then
SPort.Read(BuffData, 0, 48)
BeginInvoke(New EventHandler(AddressOf DataFromPort), Nothing)
End If
End Sub
Sub DataFromPort(ByVal sender As System.Object, ByVal e As System.EventArgs)
If Me.Start_Obv.Text = "开始监护" Then '控制数据是否处理，因为数据的接收不可控
DataTimer.Stop()
Else
DataTimer.Start()
End If
If Err_Counter > 30 Then '如果连续接收到30个数据均不符合要求，则说明仪器有问题
Err_Counter = 0
MessageBox.Show("数据，请检查线路是否正确连接！", "数据接收错误", MessageBoxButtons.OK, MessageBoxIcon.Information)
If vbOK Then
Me.Stop_obv_Click(Nothing, Nothing)
End If
End If
End Sub
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_Begin(0) As Integer '计数暂停开始处和每段暂停中未画的点数
Private Pause_Length(0) As Integer
Private Pause_Count As Integer = 0 '记录暂停次数
Private Point_Count As Integer = 0 '总点数
Private Count As Integer = 0 '计数暂停中忽略数据长度
Private Page_Count As Integer = 0 '换页
Private Sub DataTimer_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles DataTimer.Tick
Point_Count += 1
Page_Count += 1
If Page_Count > 724 Then
Page_Count = 2
End If
FHR1(Arr_Count) = BuffData(1)
FHR2(Arr_Count) = BuffData(2)
UC(Arr_Count) = BuffData(3)
If Me.Start_Obv.Text = "暂停" Then
Using MyDraw As Graphics = Graphics.FromImage(bmp)
MyDraw.DrawLine(Pens.Black, X_Pos, 242 - FHR1(1 - Arr_Count), X_Pos + 1, 242 - FHR1(Arr_Count))
MyDraw.DrawLine(Pens.Black, X_Pos, 210 + 242 - FHR2(1 - Arr_Count), X_Pos + 1, 210 + 242 - FHR1(Arr_Count))
MyDraw.DrawLine(Pens.Black, X_Pos, 435 + 242 - UC(1 - Arr_Count), X_Pos + 1, 435 + 242 - UC(Arr_Count))
Me.PictureBox1.Image = bmp
End Using
ElseIf Me.Start_Obv.Text = "恢复" Then
Count += 1
End If
If Arr_Count = 0 Then
Arr_Count = 1
Else
Arr_Count = 0
End If
X_Pos = Point_Count
End Sub
End Class⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -