?? freq.frm
字號(hào):
j = j + m
Next i
mmax = 2
2: If N > mmax Then
istep = 2 * mmax
CalcA = 6.28318530717959 / (Isign * mmax)
wpr = -2 * Sin(0.5 * CalcA) ^ 2
PIsin = Sin(CalcA)
wr = 1
wi = 0
For m = 1 To mmax Step 2
For i = m To N Step istep
j = i + mmax
TmpR = CSng(wr) * Y(j) - CSng(wi) * Y(j + 1)
TmpI = CSng(wr) * Y(j + 1) + CSng(wi) * Y(j)
Y(j) = Y(i) - TmpR
Y(j + 1) = Y(i + 1) - TmpI
Y(i) = Y(i) + TmpR
Y(i + 1) = Y(i + 1) + TmpI
Next i
TmpW = wr
wr = wr * wpr - wi * PIsin + wr
wi = wi * wpr + TmpW * PIsin + wi
Next m
mmax = istep
GoTo 2
End If
End Sub
Sub GraphFFT(Y() As Double, CurSamp As Long)
Dim g As Long
'Separate real from imaginary; save; calculate vector; save;
'and finally find maximum values for each case
yimax = 0
yrmax = 0
ymodmax = 0
For g = 0 To CurSamp - 1
yr(g + 1) = Y(g * 2 + 1)
If Abs(yr(g + 1)) > yrmax Then
yrmax = Abs(yr(g + 1))
End If
yi(g + 1) = Y(g * 2 + 2)
If Abs(yi(g + 1)) > yimax Then
yimax = Abs(yi(g + 1))
End If
ymod(g + 1) = ((yr(g + 1)) ^ 2 + (yi(g + 1)) ^ 2) ^ (1 / 2)
If ymod(g + 1) > ymodmax Then
ymodmax = ymod(g + 1)
End If
Next g
Call DrawRuler(CurSamp, False)
End Sub
Sub DrawRuler(CurSamp As Long, SoEsc As Boolean)
Dim a As Integer, u As Integer, xmin As Integer
Dim xzero As Double, x440 As Integer
Dim yzero As Double, ymaxgraf As Double
Dim xmult As Double, xmax As Integer
Dim ymult As Double, N As Long, PaulBryan As Double
Dim mpl As Double, xn As Integer
a = 1
Rule:
u = 0
Picture2.Cls
xmin = 0
xzero = 0.964615822 'Hz
x440 = 15900 'twips
yzero = Picture2.Height * 2 / 3 - 500
If a = -1 Then yzero = Picture2.Height * 1 / 3
ymaxgraf = Picture2.Height / 8
If a = -1 Then ymaxgraf = 0
xmult = x440 / Log(440 / xzero)
xmax = 7362 '150 twips for each logical note
Picture2.Line (xmin, yzero)-(xmin + Picture2.Width, yzero), &H0&
If SoEsc = True Then GoTo NumRuler
ymult = (yzero - ymaxgraf) / ymodmax
Picture2.PSet (xmin + u, yzero - (a * ymod(1)) * ymult)
PaulBryan = CurSamp * 2 / SampFreq
For N = 1 To CurSamp - 1
Picture2.Line -(Log(N / (PaulBryan * xzero)) * xmult + u, yzero - (a * ymod(N + 1)) * ymult), &HFF00&
Next N
NumRuler:
mpl = x440 / Log(440 / xzero)
Picture2.Line (xmin, yzero + 200)-(xmin + Picture2.Width, yzero + 200)
For N = 1 To 50
xn = Int(Log(N / xzero) * mpl + u)
Picture2.Line (xn, yzero + 200)-(xn, yzero + 260)
If N < 5 And N > 1 Then
Picture2.PSet (xn - 100, yzero + 280), &H400040
Picture2.Print N
End If
Next N
For N = 60 To 500 Step 10
xn = Int(Log(N / xzero) * mpl + u)
Picture2.Line (xn, yzero + 200)-(xn, yzero + 260)
Next N
For N = 600 To 5000 Step 100
xn = Int(Log(N / xzero) * mpl + u)
Picture2.Line (xn, yzero + 200)-(xn, yzero + 260)
Next N
For N = 6000 To 50000 Step 1000
xn = Int(Log(N / xzero) * mpl + u)
Picture2.Line (xn, yzero + 200)-(xn, yzero + 260)
Next N
For N = 1 To 5 Step 4
xn = Int(Log(N / xzero) * mpl + u)
Picture2.Line (xn, yzero + 200)-(xn, yzero + 360)
Picture2.Circle (xn, yzero + 360), 20
Picture2.PSet (xn - 100, yzero + 400), &H400040
Picture2.Print N
Next N
For N = 10 To 50 Step 10
xn = Int(Log(N / xzero) * mpl + u)
Picture2.Line (xn, yzero + 200)-(xn, yzero + 360)
Picture2.Circle (xn, yzero + 360), 20
Picture2.PSet (xn - 120, yzero + 400), &H400040
Picture2.Print N
Next N
For N = 100 To 500 Step 100
xn = Int(Log(N / xzero) * mpl + u)
Picture2.Line (xn, yzero + 200)-(xn, yzero + 360)
Picture2.Circle (xn, yzero + 360), 20
Picture2.PSet (xn - 180, yzero + 400), &H400040
Picture2.Print N
Next N
For N = 1000 To 5000 Step 1000
xn = Int(Log(N / xzero) * mpl + u)
Picture2.Line (xn, yzero + 200)-(xn, yzero + 360)
Picture2.Circle (xn, yzero + 360), 20
Picture2.PSet (xn - 180, yzero + 400), &H400040
Picture2.Print N / 1000; " K"
Next N
For N = 10000 To 50000 Step 10000
xn = Int(Log(N / xzero) * mpl + u)
Picture2.Line (xn, yzero + 200)-(xn, yzero + 360)
Picture2.Circle (xn, yzero + 360), 20
Picture2.PSet (xn - 180, yzero + 400), &H400040
Picture2.Print N / 1000; " K"
Next N
For N = 5 To 50 Step 5
xn = Int(Log(N / xzero) * mpl + u)
Picture2.Line (xn, yzero + 200)-(xn, yzero + 320)
Next N
For N = 50 To 500 Step 50
xn = Int(Log(N / xzero) * mpl + u)
Picture2.Line (xn, yzero + 200)-(xn, yzero + 320)
Next N
For N = 500 To 5000 Step 500
xn = Int(Log(N / xzero) * mpl + u)
Picture2.Line (xn, yzero + 200)-(xn, yzero + 320)
Next N
For N = 5000 To 50000 Step 5000
xn = Int(Log(N / xzero) * mpl + u)
Picture2.Line (xn, yzero + 200)-(xn, yzero + 320)
Next N
'Call DrawLines
End Sub
Sub DrawLines()
yzero = Picture2.Height * 2 / 3 + 400
For N = 0 To 29500 Step 150
Picture2.Line (N, yzero)-(N, yzero + 280), &HFFFF&
Next N
Picture2.Line (15900, yzero + 280)-(15900, yzero - 100)
End Sub
Private Sub Form_Load()
Me.Width = 11900
Me.Height = 6270
Me.Top = 300
Me.Left = 0
HScroll1.Value = 12500
'Me.Icon = MDIMain.Icon
Call DrawRuler(0, True)
End Sub
Private Sub HScroll1_Change()
Picture2.Left = -HScroll1.Value
End Sub
Private Sub MMControl1_Done(NotifyCode As Integer)
MMControl1.Command = "Close"
End Sub
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Pn As Integer, Pt As Double, freqf As Double
Dim Freq As Single, PNot As Single, PNotBas As Single
Dim Octave As Integer, PNotInt As Integer
Dim Note As String
'Post Frequency Under the mouse position
Pn = (X - 15900) / 15
Pt = 2 ^ (1 / 120)
freqf = 440 * (Pt ^ Pn)
Freq = Int(freqf * 1000) / 1000
If freqf - Freq >= 0.0005 Then Freq = Freq + 0.001
Label2.Caption = Freq
'If corresponds exactly to a note (turn captions Blue)
PNot = Pn / 10
If Abs(PNot - Int(PNot)) < 0.001 Then
Label2.ForeColor = vbBlue
Label3.ForeColor = vbBlue
Else
Label2.ForeColor = vbBlack
Label3.ForeColor = vbBlack
End If
'To which note it belongs
'and to which octave it belongs
PNotBas = PNot
Octave = 5
PNotInt = Int(PNotBas)
If PNotBas - PNotInt >= 0.5 Then
PNotInt = PNotInt + 1
End If
XNotPlay = PNotInt * 10 * 15 + 15900
Label9.Caption = PNotInt + 69 'note played
Do While PNotInt < 0
PNotInt = PNotInt + 12
Octave = Octave - 1
Loop
Do While PNotInt >= 12
PNotInt = PNotInt - 12
Octave = Octave + 1
Loop
If PNotInt < 3 Then 'It is A, A# or B of the next octave
Octave = Octave - 1
End If
Select Case PNotInt
Case 0
Note = "(A)"
Case 12
Note = "(A)"
Case 1
Note = "(A #) or (B b)"
Case 2
Note = "(B)"
Case 3
Note = "(C)"
Case 4
Note = "(C #) or (D b)"
Case 5
Note = "(D)"
Case 6
Note = "(D #) or (E b)"
Case 7
Note = "(E)"
Case 8
Note = "(F)"
Case 9
Note = "(F #) or (G b)"
Case 10
Note = "(G)"
Case 11
Note = "(G #) or (A b)"
End Select
Fim:
Label3.Caption = Note
Label4.Caption = "Octave: " & Octave
Line1.X1 = X
Line1.X2 = X
Line1.Visible = True
End Sub
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -