dtmf.frm

一个用VB编写的双音多频识别程式(运用傅里叶变换算法)

    DeviceBox.ListIndex = 0
End Sub

Private Sub About_Click()
frmAbout.Visible = True

End Sub

Private Sub Close_Click()
'Close the wave device.....
Call waveInReset(DevHandle)
Call waveInClose(DevHandle)
'Unload the program....
Unload Me
End
End Sub

Private Sub Command1_Click()
list1.AddItem Text1.Text

Text1.Text = " "

End Sub

Private Sub Form_Load()
Call InitDevices    'Get the sound devices....
'
'Pre-calculate the reverse numbers...
Call DoReverse

Call Hanning


ScopeHeight = Display.Height
Divisor = 40


End Sub

Private Sub Start_Click()
'
'Open the wave device and init it....
Static WaveFormat As WaveFormatEx
With WaveFormat
    .FormatTag = WAVE_FORMAT_PCM
    .Channels = 1
    .SamplesPerSec = 11025
    .BitsPerSample = 16
    .BlockAlign = (.Channels * .BitsPerSample) \ 8
    .AvgBytesPerSec = .BlockAlign * .SamplesPerSec
    .ExtraDataSize = 0
End With
Debug.Print "waveInOpen:"; waveInOpen(DevHandle, DeviceBox.ListIndex, VarPtr(WaveFormat), 0, 0, 0)
'If there is no device complain about it....
If DevHandle = 0 Then
    Call MsgBox("Wave input device didn't open!!", vbExclamation, "Woops")
    Exit Sub
End If
'Otherwise init the device....
Debug.Print " "; DevHandle
Call waveInStart(DevHandle)

Call ShowStuff

End Sub

Public Sub ShowStuff()
   Static x As Long
    Static average As Long
   
    Static Wave As WaveHdr
    
    Static InData(0 To NumSamples - 1) As Integer
    Static OutData(0 To NumSamples - 1) As Single
    
    'With ScopeBuff 'Save some time referencing it...
    With Display
        Do
            Wave.lpData = VarPtr(InData(0))
            Wave.dwBufferLength = NumSamples
            Wave.dwFlags = 0
            Call waveInPrepareHeader(DevHandle, VarPtr(Wave), Len(Wave))
            Call waveInAddBuffer(DevHandle, VarPtr(Wave), Len(Wave))
            
            Do
                'Just wait for the blocks to be done or the device to close
            Loop Until ((Wave.dwFlags And WHDR_DONE) = WHDR_DONE) Or DevHandle = 0
            If DevHandle = 0 Then Exit Do 'Cut out if the device is closed
            
            Call waveInUnprepareHeader(DevHandle, VarPtr(Wave), Len(Wave))
              
            Call FFTAudio(InData, OutData)
            .Cls
            .CurrentX = 0
            .CurrentY = ScopeHeight
        
            For x = 0 To 255
                .CurrentY = ScopeHeight
                .CurrentX = x
             average = Sqr(Abs(OutData(0))) * 1.4
               
            'I average two elements here because it gives a smoother appearance.
                Display.Line Step(0, 0)-(x, ScopeHeight - (Sqr(Abs(OutData(x * 2) \ Divisor)) + Sqr(Abs(OutData(x * 2 + 1) \ Divisor))))
            Next
            'Display the key...
            If ((Sqr(Abs(OutData(88)))) + (Sqr(Abs(OutData((NumSamples - 1) - 88))))) > average And ((Sqr(Abs(OutData(123)))) + (Sqr(Abs(OutData((NumSamples - 1) - 123))))) > average Then
            If Tone_on(0) = 0 Then
            Text1.Text = Text1.Text + "0"
            Tone_on(0) = 1
            End If
            Else
            Tone_on(0) = 0
            End If
            
            If ((Sqr(Abs(OutData(65)))) + (Sqr(Abs(OutData((NumSamples - 1) - 65))))) > average And ((Sqr(Abs(OutData(113)))) + (Sqr(Abs(OutData((NumSamples - 1) - 113))))) > average Then
            If Tone_on(1) = 0 Then
            Text1.Text = Text1.Text + "1"
            Tone_on(1) = 1
            End If
            Else
            Tone_on(1) = 0
            End If
            
            If ((Sqr(Abs(OutData(65)))) + (Sqr(Abs(OutData((NumSamples - 1) - 65))))) > average And ((Sqr(Abs(OutData(123)))) + (Sqr(Abs(OutData((NumSamples - 1) - 123))))) > average Then
            If Tone_on(2) = 0 Then
            Text1.Text = Text1.Text + "2"
            Tone_on(2) = 1
            End If
            Else
            Tone_on(2) = 0
            End If
                        
            If ((Sqr(Abs(OutData(65)))) + (Sqr(Abs(OutData((NumSamples - 1) - 65))))) > average And ((Sqr(Abs(OutData(136)))) + (Sqr(Abs(OutData((NumSamples - 1) - 136))))) > average Then
            If Tone_on(3) = 0 Then
            Text1.Text = Text1.Text + "3"
            Tone_on(3) = 1
            End If
            Else
            Tone_on(3) = 0
            End If
            
            If ((Sqr(Abs(OutData(71)))) + (Sqr(Abs(OutData((NumSamples - 1) - 71))))) > average And ((Sqr(Abs(OutData(113)))) + (Sqr(Abs(OutData((NumSamples - 1) - 113))))) > average Then
            If Tone_on(4) = 0 Then
            Text1.Text = Text1.Text + "4"
            Tone_on(4) = 1
            End If
            Else
            Tone_on(4) = 0
            End If
            
            If ((Sqr(Abs(OutData(71)))) + (Sqr(Abs(OutData((NumSamples - 1) - 71))))) > average And ((Sqr(Abs(OutData(123)))) + (Sqr(Abs(OutData((NumSamples - 1) - 123))))) > average Then
            If Tone_on(5) = 0 Then
            Text1.Text = Text1.Text + "5"
            Tone_on(5) = 1
            End If
            Else
            Tone_on(5) = 0
            End If
            
            If ((Sqr(Abs(OutData(71)))) + (Sqr(Abs(OutData((NumSamples - 1) - 71))))) > average And ((Sqr(Abs(OutData(136)))) + (Sqr(Abs(OutData((NumSamples - 1) - 136))))) > average Then
            If Tone_on(6) = 0 Then
            Text1.Text = Text1.Text + "6"
            Tone_on(6) = 1
            End If
            Else
            Tone_on(6) = 0
            End If
            
            If ((Sqr(Abs(OutData(79)))) + (Sqr(Abs(OutData((NumSamples - 1) - 79))))) > average And ((Sqr(Abs(OutData(113)))) + (Sqr(Abs(OutData((NumSamples - 1) - 113))))) > average Then
            If Tone_on(7) = 0 Then
            Text1.Text = Text1.Text + "7"
            Tone_on(7) = 1
            End If
            Else
            Tone_on(7) = 0
            End If
            
            If ((Sqr(Abs(OutData(79)))) + (Sqr(Abs(OutData((NumSamples - 1) - 79))))) > average And ((Sqr(Abs(OutData(123)))) + (Sqr(Abs(OutData((NumSamples - 1) - 123))))) > average Then
            If Tone_on(8) = 0 Then
            Text1.Text = Text1.Text + "8"
            Tone_on(8) = 1
            End If
            Else
            Tone_on(8) = 0
            End If
            
            If ((Sqr(Abs(OutData(79)))) + (Sqr(Abs(OutData((NumSamples - 1) - 79))))) > average And ((Sqr(Abs(OutData(136)))) + (Sqr(Abs(OutData((NumSamples - 1) - 136))))) > average Then
            If Tone_on(9) = 0 Then
            Text1.Text = Text1.Text + "9"
            Tone_on(9) = 1
            End If
            Else
            Tone_on(9) = 0
            End If
            
            If ((Sqr(Abs(OutData(88)))) + (Sqr(Abs(OutData((NumSamples - 1) - 88))))) > average And ((Sqr(Abs(OutData(113)))) + (Sqr(Abs(OutData((NumSamples - 1) - 113))))) > average Then
            If Tone_on(10) = 0 Then
            Text1.Text = Text1.Text + "*"
            Tone_on(10) = 1
            End If
            Else
            Tone_on(10) = 0
            End If
            
            If ((Sqr(Abs(OutData(88)))) + (Sqr(Abs(OutData((NumSamples - 1) - 88))))) > average And ((Sqr(Abs(OutData(136)))) + (Sqr(Abs(OutData((NumSamples - 1) - 136))))) > average Then
            If Tone_on(11) = 0 Then
            Text1.Text = Text1.Text + "#"
            Tone_on(11) = 1
            End If
            Else
            Tone_on(11) = 0
            End If
                        
            If ((Sqr(Abs(OutData(65)))) + (Sqr(Abs(OutData((NumSamples - 1) - 65))))) > average And ((Sqr(Abs(OutData(152)))) + (Sqr(Abs(OutData((NumSamples - 1) - 152))))) > average Then
            If Tone_on(12) = 0 Then
            Text1.Text = Text1.Text + "A"
            Tone_on(12) = 1
            End If
            Else
            Tone_on(12) = 0
            End If
            
            If ((Sqr(Abs(OutData(71)))) + (Sqr(Abs(OutData((NumSamples - 1) - 71))))) > average And ((Sqr(Abs(OutData(152)))) + (Sqr(Abs(OutData((NumSamples - 1) - 152))))) > average Then
            If Tone_on(13) = 0 Then
            Text1.Text = Text1.Text + "B"
            Tone_on(13) = 1
            End If
            Else
            Tone_on(13) = 0
            End If
            
            If ((Sqr(Abs(OutData(79)))) + (Sqr(Abs(OutData((NumSamples - 1) - 79))))) > average And ((Sqr(Abs(OutData(152)))) + (Sqr(Abs(OutData((NumSamples - 1) - 152))))) > average Then
            If Tone_on(14) = 0 Then
            Text1.Text = Text1.Text + "C"
            Tone_on(14) = 1
            End If
            Else
            Tone_on(14) = 0
            End If
            
            If ((Sqr(Abs(OutData(88)))) + (Sqr(Abs(OutData((NumSamples - 1) - 88))))) > average And ((Sqr(Abs(OutData(152)))) + (Sqr(Abs(OutData((NumSamples - 1) - 152))))) > average Then
            If Tone_on(15) = 0 Then
            Text1.Text = Text1.Text + "D"
            Tone_on(15) = 1
            End If
            Else
            Tone_on(15) = 0
            End If
            
            DoEvents
           
            
        Loop While DevHandle <> 0
    
      
   
        
    End With
     
End Sub