📄 ve-1ba.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 + -