?? freq.frm
字號:
VERSION 5.00
Begin VB.Form PlotFreq
AutoRedraw = -1 'True
Caption = "Frequency Analyser"
ClientHeight = 6105
ClientLeft = 60
ClientTop = 345
ClientWidth = 11880
ForeColor = &H8000000D&
LinkTopic = "Form1"
ScaleHeight = 6105
ScaleWidth = 11880
Begin VB.PictureBox Picture1
Height = 5415
Left = 0
ScaleHeight = 5355
ScaleWidth = 11835
TabIndex = 0
Top = 600
Width = 11895
Begin VB.HScrollBar HScroll1
Height = 240
LargeChange = 600
Left = 0
Max = 17700
Min = -60
SmallChange = 90
TabIndex = 2
Top = 4920
Width = 11775
End
Begin VB.PictureBox Picture2
AutoRedraw = -1 'True
BackColor = &H00400040&
ForeColor = &H8000000E&
Height = 4960
Left = 0
MousePointer = 2 'Cross
ScaleHeight = 4905
ScaleWidth = 29445
TabIndex = 1
Top = 0
Width = 29500
Begin VB.Line Line1
BorderColor = &H0000FFFF&
X1 = 3720
X2 = 3720
Y1 = 0
Y2 = 4920
End
Begin VB.Label Label1
AutoSize = -1 'True
BackColor = &H00400040&
BackStyle = 0 'Transparent
Caption = "Frequency Analysis"
BeginProperty Font
Name = "Times New Roman"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 285
Left = 9960
TabIndex = 3
Top = 0
Width = 2205
End
End
End
Begin VB.Label Label12
Caption = "57"
Height = 255
Left = 6360
TabIndex = 11
Top = 0
Visible = 0 'False
Width = 615
End
Begin VB.Label Label11
Caption = "52"
Height = 255
Left = 5520
TabIndex = 10
Top = 0
Visible = 0 'False
Width = 495
End
Begin VB.Label Label10
BackStyle = 0 'Transparent
Height = 255
Left = 4440
TabIndex = 9
Top = 0
Visible = 0 'False
Width = 615
End
Begin VB.Label Label9
AutoSize = -1 'True
Caption = "Label9"
Height = 195
Left = 3120
TabIndex = 8
Top = 360
Visible = 0 'False
Width = 480
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "Hz"
Height = 195
Left = 5040
TabIndex = 7
Top = 360
Width = 195
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "Octave:"
Height = 195
Left = 8760
TabIndex = 6
Top = 360
Width = 570
End
Begin VB.Label Label3
AutoSize = -1 'True
Height = 195
Left = 5760
TabIndex = 5
Top = 360
Width = 45
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
AutoSize = -1 'True
Height = 195
Left = 4920
TabIndex = 4
Top = 360
Width = 45
End
End
Attribute VB_Name = "PlotFreq"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'TrueWavAnalyzer
'by: Paul Bryan in 2002
'Allows for graphical isolation of sample ranges
'will analyze by frequency and decibal for up
'to 32768 samples (VB Single Precision Demension Max)
'Uses the FFT alogorythm
' I hope this helps, feel free to re-use this code.
Dim Ad$
Dim NotFilePos1 As Integer, NotFilePos2 As Integer
Dim Original(32768) As Double 'original data (before FFT)
Dim AfterFFT(32768) As Double 'data after FFT calculation
Dim yi(16384) As Double, yimax As Double 'imaginary
Dim yr(16384) As Double, yrmax As Double 'real
Dim ymod(16384) As Double, ymodmax As Double 'vector
Dim SampFreq As Long 'File Sampling Frequency
Sub FFTWave(Y() As Double, Npont As Long, Freq As Long, Sectime As String)
' Me.Caption = "Frequency Analysis for first 32768 Samples of " & Sectime & " Selected."
Dim N As Long, g As Long
N = Npont / 2
'Store original data
SampFreq = Freq
For g = 1 To Npont
Original(g) = Y(g)
Next g
RealFFT Y(), N, 1
'Store FFT data
For g = 1 To Npont
AfterFFT(g) = Y(g)
Next g
GraphFFT Y(), N
'PlotFreq.SetFocus
PlotFreq.Show
End Sub
Sub RealFFT(Y() As Double, N As Long, Isign As Integer)
Dim wr As Double, wi As Double, wpr As Double
Dim PIsin As Double, TmpW As Double, CalcA As Double
Dim c1 As Double, c2 As Double
Dim PB As Long, Paul As Long, i As Long
Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long
Dim wrs As Single, wis As Single
Dim h1r As Double, h1i As Double
Dim h2r As Double, h2i As Double
PB = 2 * N
CalcA = 3.14159265358979 / CDbl(N)
c1 = 0.5
If Isign = 1 Then
c2 = -0.5
PlotIt Y(), N, 1
Else
c2 = 0.5
CalcA = -CalcA
End If
wpr = -2# * Sin(0.5 * CalcA) ^ 2
PIsin = Sin(CalcA)
wr = 1# + wpr
wi = PIsin
Paul = 2 * N + 3
For i = 2 To N / 2 + 1
i1 = 2 * i - 1
i2 = i1 + 1
i3 = Paul - i2
i4 = i3 + 1
wrs = CSng(wr)
wis = CSng(wi)
h1r = c1 * (Y(i1) + Y(i3))
h1i = c1 * (Y(i2) - Y(i4))
h2r = -c2 * (Y(i2) + Y(i4))
h2i = c2 * (Y(i1) - Y(i3))
Y(i1) = h1r + wrs * h2r - wis * h2i
Y(i2) = h1i + wrs * h2i + wis * h2r
Y(i3) = h1r - wrs * h2r + wis * h2i
Y(i4) = -h1i + wrs * h2i + wis * h2r
TmpW = wr
wr = wr * wpr - wi * PIsin + wr
wi = wi * wpr + TmpW * PIsin + wi
Next i
If Isign = 1 Then
h1r = Y(1)
Y(1) = h1r + Y(2)
Y(2) = h1r - Y(2)
Else
h1r = Y(1)
Y(1) = c1 * (h1r + Y(2))
Y(2) = c1 * (h1r - Y(2))
PlotIt Y(), N, -1
End If
End Sub
Sub PlotIt(Y() As Double, PB As Long, Isign As Integer)
Dim N As Long, i As Long, j As Long
Dim m As Long, mmax As Long, istep As Long
Dim TmpR As Double, TmpI As Double
Dim wr As Double, wi As Double, wpr As Double
Dim PIsin As Double, TmpW As Double, CalcA As Double
N = 2 * PB
j = 1
For i = 1 To N Step 2
If j > i Then
TmpR = Y(j)
TmpI = Y(j + 1)
Y(j) = Y(i)
Y(j + 1) = Y(i + 1)
Y(i) = TmpR
Y(i + 1) = TmpI
End If
m = N / 2
1: If (m >= 2 And j > m) Then
j = j - m
m = m / 2
GoTo 1
End If
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -