frm_hfecg2.frm

在VB上采用改进的阈值法检测心电高频向量

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frm_HFECG2 
   Caption         =   "高频心电图分析"
   ClientHeight    =   8355
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   10650
   LinkTopic       =   "Form1"
   ScaleHeight     =   8355
   ScaleWidth      =   10650
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command6 
      Caption         =   "波形显示"
      Height          =   975
      Left            =   7800
      TabIndex        =   5
      Top             =   1920
      Width           =   1335
   End
   Begin VB.CommandButton Command4 
      Caption         =   "找QS点"
      Height          =   615
      Left            =   5040
      TabIndex        =   4
      Top             =   5280
      Width           =   2055
   End
   Begin VB.CommandButton Command3 
      Caption         =   "计算差分"
      Height          =   615
      Left            =   5040
      TabIndex        =   3
      Top             =   2760
      Width           =   2055
   End
   Begin VB.CommandButton Command5 
      Caption         =   "找R波点"
      Height          =   615
      Left            =   5040
      TabIndex        =   2
      Top             =   4080
      Width           =   2055
   End
   Begin VB.CommandButton Command2 
      Caption         =   "退出"
      Height          =   615
      Left            =   8280
      TabIndex        =   1
      Top             =   7320
      Width           =   2055
   End
   Begin VB.CommandButton Command1 
      Caption         =   "HFECG信号获取"
      Height          =   735
      Left            =   5040
      TabIndex        =   0
      Top             =   1440
      Width           =   2055
   End
   Begin MSComDlg.CommonDialog dlgCommondi1 
      Left            =   360
      Top             =   480
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      CancelError     =   -1  'True
      Color           =   4210752
   End
End
Attribute VB_Name = "frm_HFECG2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim z1 As Variant
Dim z2 As Variant
Dim z3 As Variant
Dim r(800) As Double
Dim d(8400) As Double


Private Sub Command1_Click() '高频心电信号获取
On Error GoTo Errorhandler

With dlgCommondi1
     .InitDir = "D:\Program Files\VB6Expr\高频心电数据"
     .FileName = "D:\Program Files\VB6Expr\高频心电数据\" & "*.hecg"
     .Filter = "专用文件(*.hecg)|*.hecg"
     .Flags = cdlOFNOverwritePrompt
     .ShowOpen
     sfile = .FileName
End With


Open sfile For Binary As #1

Get #1, , sampling_fre '取出采样频率

For i = 1 To 8400 '取出心电波形
    Get #1, , HFECG1(i)
Next i
For i = 1 To 8400
    Get #1, , HFECG2(i)
Next i
For i = 1 To 8400
    Get #1, , HFECG3(i)
Next i
For i = 1 To 8400
    Get #1, , HFECG4(i)
Next i
For i = 1 To 8400
    Get #1, , HFECG5(i)
Next i
For i = 1 To 8400
    Get #1, , HFECG6(i)
Next i
For i = 1 To 8400
    Get #1, , HFECG7(i)
Next i
For i = 1 To 8400
    Get #1, , HFECG8(i)
Next i
For i = 1 To 8400
    Get #1, , HFECG9(i)
Next i
For i = 1 To 8400
    Get #1, , HFECG10(i)
Next i
For i = 1 To 8400
    Get #1, , HFECG11(i)
Next i
For i = 1 To 8400
    Get #1, , HFECG12(i)
Next i

Close #1

Errorhandler:
             Exit Sub
End Sub

Private Sub Command2_Click() '退出
End
End Sub

Private Sub Command3_Click()
Dim j As Variant
Dim n As Variant
Dim m As Variant
Dim s  As Variant
n = 1
For i = 1 To 8400
j = HFECG1(i) - HFECG1(i - 1)
rb0(n) = j
n = n + 1
Next i

m = rb0(0)
For k = 0 To 4199
If rb0(k + 1) > m Then
m = rb0(k + 1)
Else
End If
Next k
Print m

s = rb0(4200)
For k = 4200 To 8399
If rb0(k + 1) > s Then
s = rb0(k + 1)
Else
End If
Next k
Print s

h = (s + m) / 2
Print h

z1 = 5 * h / 16
z2 = 5 * h / 16
z3 = 2 * h / 9
Print z1
Print z2
Print z3
Print
End Sub

Private Sub Command5_Click()
Dim c As Variant
Dim k As Variant
k = 0
For i = 1 To 8400
If rb0(i) > z1 Then
i = i + 1
If rb0(i) > z2 Then
n = 0
Do
i = i + 1
n = n + 1
If rb0(i) < 0 Then
If Abs(rb0(i)) > z3 Then
k = k + 1
r(k) = i - n
If HFECG1(i) > 0.2 Then
Print i
Print HFECG1(i)
Print
End If
Exit Do
End If
Else: End If
Loop Until n = 800
Else
End If
Else: End If
Next i
End Sub

Private Sub Command4_Click()
Dim D1(8400) As Double
Dim d2(8400) As Double

Dim d11(8400) As Double
Dim d22(8400) As Double
For n = 0 To 8400
D1(n) = Abs(rb0(n))
Next n
For n = 1 To 8399
d11(n) = (D1(n + 1) + 3 * D1(n) + D1(n - 1)) / 5
Next n
For n = 2 To 8400
d2(n) = Abs(HFECG1(n) - 2 * HFECG1(n - 1) + HFECG1(n - 2))
Next n
For n = 1 To 8399
d22(n) = (d2(n + 1) + 3 * d2(n) + d2(n - 1)) / 5
Next n
For n = 1 To 8400
d(n) = d11(n) + d22(n)
Next n

m = d(1144)
For k = 1144 To 1244
If d(k + 1) > m Then  '局部极值点
m = d(k + 1)
Else
End If
Next k

If m > d(1246) Then
For i = 1144 To 1244
If d(i) = m Then
For n = i - 100 To i
c = d(n) - d(i) / 2
If c = 0 Then '如何找一半的点？
Print n
End If
Next n
End If
Next i
End If

m = d(1247)
For k = 1247 To 1547
If d(k + 1) > m Then
m = d(k + 1)
Else
End If
Next k


Print      '以后no

m = d(3700)
For k = 3700 To 3768
If d(k + 1) > m Then
m = d(k + 1)
Else
End If
Next k

For i = 3700 To 3768
If d(i) = m Then
End If
Next i

m = d(3771)
For k = 3771 To 3820
If d(k + 1) > m Then
m = d(k + 1)
Else
End If
Next k


For i = 3771 To 3820
If d(i) = m Then
End If
Next i
Print

End Sub

Private Sub Command6_Click()
frm_HFECG2.Hide
Form1.Show
End Sub