?? kzfrm.frm
字號:
PicW.Line (j, AE.wavedata(j))-(j + 1, AE.wavedata(j + 1)), vbBlue
Next j
End Sub
Private Sub CmdInput_Click()
Start = 1
over = KZ.SampleLength
GetAverage
'PicW.Cls
'drawWave
Beishu = Val(TextBeishu.Text)
Call drawline(Beishu, Start, over)
End Sub
Private Sub CheckdrawWZoom_Click()
If CheckdrawWZoom.Value = True Then
Zoom = True
PicW.MousePointer = 2
DoEvents
Else
Zoom = False
PicW.MousePointer = 1
End If
End Sub
Private Sub picw_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 And Zoom = True Then
x1 = x
x2 = x1
y1 = y
y2 = y1
Call RubberLine(PicW, x1, y1, x2, y2)
'Else
'PicW.DrawMode = 7
'PicW.Line (Lx, PicW.ScaleTop)-(Lx, PicW.ScaleTop + PicW.ScaleHeight), 255
'Lx = x
'PicW.Line (Lx, PicW.ScaleTop)-(Lx, PicW.ScaleTop + PicW.ScaleHeight), 255
End If
End Sub
Private Sub PicW_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Zoom = True And Button = 1 Then
x2 = x
y2 = y
Call RubberLineErase(PicW)
Call RubberLine(PicW, x1, y1, x2, y2)
End If
Label2.Caption = x + WinT0
Label1.Caption = y
End Sub
Private Sub PicW_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim k As Long
Dim w As Single
Dim j As Long
Dim n1 As Long, n2 As Long
Dim t1 As Currency, t2 As Currency
Dim En As Long, Em As Long
If Zoom = True And Button = 1 Then
x2 = x
y2 = y
Call RubberLineErase(PicW)
If x2 < x1 Then Call Swap(x1, x2)
If y2 < y1 Then Call Swap(y1, y2)
PicW.Cls
n1 = Int(x1)
n2 = Int(x2)
PicW.Scale (n1, 1500)-(n2, -1500)
For j = n1 To n2
PicW.Line (j, wavedata(j))-(j + 1, wavedata(j + 1)), vbBlue
Next j
If Val(TextBeishu.Text) <> 1 Then
'Draw_startLine
'Call drawline(Beishu, n1, n2)
'PicW.Line (n1, 0)-(n2, 0), 0
End If
Call drawline1(Sdev_Extremum)
End If
End Sub
Private Sub MaxValue()
Dim i As Long
Max = AE.wavedata(1)
For i = 1 To KZ.SampleLength
If AE.wavedata(i) > Max Then
Max = AE.wavedata(i)
M = i
End If
Min = AE.wavedata(1)
If AE.wavedata(i) < Min Then
Min = AE.wavedata(i)
End If
Next i
End Sub
Private Sub Form_Resize()
'PicW.Width = frmDATADemo.ScaleWidth
'frmDATADemo.ScaleHeight = 10000
With KZfrm
PicW.Left = .ScaleLeft
PicW.Top = .ScaleTop
PicW.Width = .ScaleWidth
' PicW.Height = (.ScaleHeight - Pictools.Height) / 2
PicSdev.Left = .ScaleLeft
PicSdev.Top = .ScaleTop + PicW.Height
PicSdev.Width = .ScaleWidth
' PicSdev.Height = .ScaleHeight - Pictools.Height - PicW.Height
End With
End Sub
Private Sub drawline(Beishu As Single, Start As Long, over As Long)
LabAverage.Caption = AVE
LabBeishu.Caption = Beishu * SDEV
LabSquare.Caption = SDEV
PicW.Line (Start, AVE + Beishu * SDEV)-(over, AVE + Beishu * SDEV), vbGreen
PicW.Line (Start, AVE - Beishu * SDEV)-(over, AVE - Beishu * SDEV), vbGreen
Draw_startLine
Draw_overLine1
'Draw_overLine2
txtMaxT.Text = MaxT
End Sub
Private Sub Draw_startLine()
Dim i As Long
Dim k As Long
Dim j As Long
k = 0
Call KZ.GetWaveDATA(1, ns, wavedata)
For i = 100 To AE.SampleLength
If AE.wavedata(i) - Abs(AVE) > Beishu * SDEV Then
Exit For
End If
j = i
Next i
PicW.Line (j - 200, 3000)-(j - 200, -3000), 200
TextPoint.Text = j
End Sub
Private Sub Draw_overLine1()
Dim i As Long
Dim k As Long
Dim j As Long
k = 0
Call KZ.GetWaveDATA(Direction, ns, wavedata)
For i = 1 To AE.SampleLength - 1
If AE.wavedata(AE.SampleLength - i) - Abs(AVE) > Beishu * SDEV Then
Exit For
End If
j = AE.SampleLength - i
Next i
MaxT = j
PicW.Line (j, 3000)-(j, -3000), 200
End Sub
Private Sub Draw_overLine2()
Dim i As Long
Dim k As Long
Dim j As Long
Dim sp As Double
k = 0
Call KZ.GetWaveDATA(Direction, ns, wavedata)
sp = AE.wavedata(1)
For i = 2 To AE.SampleLength
If AE.wavedata(i) > sp Then
sp = AE.wavedata(i)
End If
Next i
For i = 1 To AE.SampleLength - 1
j = AE.SampleLength - i
If Abs(AE.wavedata(AE.SampleLength - i)) > Beishu * sp Then
Exit For
End If
Next i
MaxT = j
PicW.Line (j, 3000)-(j, -3000), 200
End Sub
Private Sub GetAverage()
Dim chufa As Long
Dim Sum As Long
Dim Sum1 As Double
Dim i As Long
Dim pretrig As Long
AVE = 0#
SDEV = 0#
pretrig = AE.TrigLevel / 100 * AE.SampleLength
chufa = pretrig - Int(pretrig * 0.1)
Sum = 0#
For i = 1 To chufa
Sum = AE.wavedata(i) + Sum
Next i
AVE = Sum / (chufa - 1)
Debug.Print AVE
'PicW.Line (1, AVE)-(AE.Samplelength, AVE), vbBlue
Sum1 = 0#
For i = 1 To chufa
Sum1 = (AE.wavedata(i) - AVE) ^ 2 + Sum1
Next i
SDEV = Sqr(Sum1 / (chufa - 1))
End Sub
Private Function Get_Sdev(begin As Long, finish As Long) As Double
Dim i As Long
Dim s As Long, s1 As Double
Dim average As Double
s = 0#
For i = begin To finish
s = s + AE.wavedata(i)
Next i
average = s / (finish - begin)
s1 = 0#
For i = begin To finish
s1 = (AE.wavedata(i) - average) ^ 2 + s1
Next i
Get_Sdev = Sqr(s1 / (finish - begin))
End Function
Private Sub drawline1(i As Long)
PicW.Line (i, 3000)-(i, -3000), vbGreen
End Sub
Private Function Sdev_Extremum() As Long
Dim i As Long
Dim Squre1() As Double
Dim Squre2() As Double
Dim Ratio() As Double
Dim Extremum As Double
Dim Length As Long
MaxValue
Length = Val(TextWin.Text)
ReDim Squre1(1 To M) As Double
ReDim Squre2(1 To M) As Double
ReDim Ratio(1 To M) As Double
For i = 1 To M - Length
Squre1(i) = Get_Sdev(i, i + Length)
Next i
For i = Length + 1 To M
Squre2(i) = Get_Sdev(i, i + Length)
Next i
i = 1
Do
If Abs(Squre1(i)) < 0.001 Then Squre1(i) = 1#
Ratio(i) = Squre2(i + Length) / Squre1(i)
i = i + 1
Loop Until i > M - Length
'End If
Extremum = Ratio(1)
For i = 1 To M - Length
If Ratio(i) > Extremum Then
Extremum = Ratio(i)
Sdev_Extremum = i + Length
End If
Next i
End Function
Private Sub draw_Sdev()
Dim i As Long
Dim Squre1() As Double
Dim Squre2() As Double
Dim Ratio() As Double
Dim Extremum As Double
Dim Length As Long
MaxValue
Length = Val(TextWin.Text)
ReDim Squre1(1 To AE.SampleLength) As Double
ReDim Squre2(1 To AE.SampleLength) As Double
ReDim Ratio(1 To AE.SampleLength) As Double
For i = 1 To AE.SampleLength - Length
Squre1(i) = Get_Sdev(i, i + Length)
Next i
For i = Length + 1 To AE.SampleLength - Length
Squre2(i) = Get_Sdev(i, i + Length)
Next i
i = 1
Do
If Abs(Squre1(i)) < 0.001 Then Squre1(i) = 1#
Ratio(i) = Squre2(i + Length) / Squre1(i)
i = i + 1
Loop Until i > AE.SampleLength - Length
' Extremum = Ratio(1)
'For i = 1 To M - Length
'If Ratio(i) > Extremum Then
' Extremum = Ratio(i)
'Sdev_Extremum = i + Length
' End If
'Next i
PicSdev.Cls
PicSdev.Scale (0, 30)-(AE.SampleLength, -30)
For i = 1 To AE.SampleLength - Length
PicSdev.Line (i + Length, Ratio(i))-(i + Length + 1, Ratio(i + 1))
Next i
End Sub
Private Sub CmdLine_Click()
PicW.Cls
drawWave
'Line_Extremum
Call drawline1(Line_Extremum)
End Sub
Private Function Line_Extremum() As Long
Dim i As Integer
Dim LineLen1() As Double
Dim LineLen2() As Double
Dim Ratio() As Double
Dim Extremum As Double
Dim Length As Integer
MaxValue
Length = Val(TextLine.Text)
ReDim LineLen1(1 To M) As Double
ReDim LineLen2(1 To M) As Double
ReDim Ratio(1 To M) As Double
For i = 1 To M - Length
LineLen1(i) = Get_LineLen(i, i + Length)
Next i
For i = Length + 1 To M
LineLen2(i) = Get_LineLen(i, i + Length)
Next i
i = 1
Do
Ratio(i) = LineLen2(i + Length) / LineLen1(i)
i = i + 1
Loop Until i > M - Length
Extremum = Ratio(1)
For i = 1 To M - Length
If Ratio(i) > Extremum Then
Extremum = Ratio(i)
Line_Extremum = i + Length
End If
Next i
End Function
Private Sub draw_Sdev1()
Dim i As Integer
Dim LineLen1() As Double
Dim LineLen2() As Double
Dim Ratio() As Double
Dim Extremum As Double
Dim Length As Integer
MaxValue
Length = Val(TextLine.Text)
ReDim LineLen1(1 To M) As Double
ReDim LineLen2(1 To M) As Double
ReDim Ratio(1 To M) As Double
For i = 1 To M - Length
LineLen1(i) = Get_LineLen(i, i + Length)
Next i
For i = Length + 1 To M
LineLen2(i) = Get_LineLen(i, i + Length)
Next i
i = 1
Do
Ratio(i) = LineLen2(i + Length) / LineLen1(i)
i = i + 1
Loop Until i > M - Length
PicSdev.Cls
PicSdev.Scale (0, 20)-(AE.SampleLength, -20)
For i = 1 To M - Length
PicSdev.Line (i + Length, Ratio(i))-(i + Length + 1, Ratio(i + 1))
Next i
End Sub
Private Function Get_LineLen(begin As Integer, finish As Integer) As Double
Dim i As Long
Dim LineLen() As Double
Dim s As Double
'MaxValue
ReDim LineLen(1 To AE.SampleLength) As Double
For i = 1 To AE.SampleLength - 1
LineLen(i) = Sqr(1 + (AE.wavedata(i + 1) - AE.wavedata(i)) ^ 2)
Next i
s = 0#
For i = begin To finish
s = s + LineLen(i)
Next i
Get_LineLen = s
End Function
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -