dtmfs.zip DTMF.frm

www.pudn.com > dtmfs.zip > DTMF.frm

VERSION 5.00
Begin VB.Form Form1
Caption = "DTMF Decode (KB5RYO)"
ClientHeight = 5385
ClientLeft = 60
ClientTop = 435
ClientWidth = 8610
LinkTopic = "Form1"
Picture = "DTMF.frx":0000
ScaleHeight = 359
ScaleMode = 3 'Pixel
ScaleWidth = 574
StartUpPosition = 3 'Windows Default
Begin VB.ListBox list1
BackColor = &amt;H00C0FFFF&amt;
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2985
ItemData = "DTMF.frx":439C
Left = 5880
List = "DTMF.frx":439E
TabIndex = 7
Top = 840
Width = 2295
End
Begin VB.ComboBox DeviceBox
BackColor = &amt;H00C0FFFF&amt;
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 1560
TabIndex = 6
Text = " "
Top = 3480
Width = 3735
End
Begin VB.CommandButton Command1
Caption = "Clear"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 4320
TabIndex = 5
Top = 840
Width = 975
End
Begin VB.TextBox Text1
BackColor = &amt;H00C0FFFF&amt;
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1440
TabIndex = 4
Text = " "
Top = 840
Width = 2415
End
Begin VB.PictureBox Display
BackColor = &amt;H00C0FFFF&amt;
FillColor = &amt;H00FFFFFF&amt;
ForeColor = &amt;H000080FF&amt;
Height = 1215
Left = 1440
ScaleHeight = 77
ScaleMode = 3 'Pixel
ScaleWidth = 259
TabIndex = 3
Top = 1920
Width = 3945
End
Begin VB.CommandButton About
Caption = "About"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 4950
TabIndex = 2
Top = 4560
Width = 1335
End
Begin VB.CommandButton Close
Caption = "Close"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2760
TabIndex = 1
Top = 4560
Width = 1335
End
Begin VB.CommandButton Start
Caption = "Start"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 600
TabIndex = 0
Top = 4560
Width = 1335
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************
'DTMF Decoded by KB5RYO
'A simple DTMF decoded for the pc using the sound card...
'Uses AudioFFT code by Muphy McCauley(MurphyMc@Concentric.NET)
' http://www.fullspectrum.com/deeth/
'
'*****************************************************
Option Explicit

Private DevHandle As Long 'Handle of the open audio device

Private Visualizing As Boolean
Private Divisor As Long
Dim Tone_on(0 To 16) As Integer

Private ScopeHeight As Long 'Saves time because hitting up a Long is faster
'than a property.

Private Type WaveFormatEx
FormatTag As Integer
Channels As Integer
SamplesPerSec As Long
AvgBytesPerSec As Long
BlockAlign As Integer
BitsPerSample As Integer
ExtraDataSize As Integer
End Type

Private Type WaveHdr
lpData As Long
dwBufferLength As Long
dwBytesRecorded As Long
dwUser As Long
dwFlags As Long
dwLoops As Long
lpNext As Long 'wavehdr_tag
Reserved As Long
End Type

Private Type WaveInCaps
ManufacturerID As Integer 'wMid
ProductID As Integer 'wPid
DriverVersion As Long 'MMVERSIONS vDriverVersion
ProductName(1 To 32) As Byte 'szPname[MAXPNAMELEN]
Formats As Long
Channels As Integer
Reserved As Integer
End Type

Private Const WAVE_INVALIDFORMAT = &amt;H0&amt; '/* invalid format */
Private Const WAVE_FORMAT_1M08 = &amt;H1&amt; '/* 11.025 kHz, Mono, 8-bit
Private Const WAVE_FORMAT_1S08 = &amt;H2&amt; '/* 11.025 kHz, Stereo, 8-bit
Private Const WAVE_FORMAT_1M16 = &amt;H4&amt; '/* 11.025 kHz, Mono, 16-bit
Private Const WAVE_FORMAT_1S16 = &amt;H8&amt; '/* 11.025 kHz, Stereo, 16-bit
Private Const WAVE_FORMAT_2M08 = &amt;H10&amt; '/* 22.05 kHz, Mono, 8-bit
Private Const WAVE_FORMAT_2S08 = &amt;H20&amt; '/* 22.05 kHz, Stereo, 8-bit
Private Const WAVE_FORMAT_2M16 = &amt;H40&amt; '/* 22.05 kHz, Mono, 16-bit
Private Const WAVE_FORMAT_2S16 = &amt;H80&amt; '/* 22.05 kHz, Stereo, 16-bit
Private Const WAVE_FORMAT_4M08 = &amt;H100&amt; '/* 44.1 kHz, Mono, 8-bit
Private Const WAVE_FORMAT_4S08 = &amt;H200&amt; '/* 44.1 kHz, Stereo, 8-bit
Private Const WAVE_FORMAT_4M16 = &amt;H400&amt; '/* 44.1 kHz, Mono, 16-bit
Private Const WAVE_FORMAT_4S16 = &amt;H800&amt; '/* 44.1 kHz, Stereo, 16-bit

Private Const WAVE_FORMAT_PCM = 1

Private Const WHDR_DONE = &amt;H1&amt; '/* done bit */
Private Const WHDR_PREPARED = &amt;H2&amt; '/* set if this header has been prepared */
Private Const WHDR_BEGINLOOP = &amt;H4&amt; '/* loop start block */
Private Const WHDR_ENDLOOP = &amt;H8&amt; '/* loop end block */
Private Const WHDR_INQUEUE = &amt;H10&amt; '/* reserved for driver */

Private Const WIM_OPEN = &amt;H3BE
Private Const WIM_CLOSE = &amt;H3BF
Private Const WIM_DATA = &amt;H3C0

Private Declare Function waveInAddBuffer Lib "winmm" (ByVal InputDeviceHandle As Long, ByVal WaveHdrPointer As Long, ByVal WaveHdrStructSize As Long) As Long
Private Declare Function waveInPrepareHeader Lib "winmm" (ByVal InputDeviceHandle As Long, ByVal WaveHdrPointer As Long, ByVal WaveHdrStructSize As Long) As Long
Private Declare Function waveInUnprepareHeader Lib "winmm" (ByVal InputDeviceHandle As Long, ByVal WaveHdrPointer As Long, ByVal WaveHdrStructSize As Long) As Long

Private Declare Function waveInGetNumDevs Lib "winmm" () As Long
Private Declare Function waveInGetDevCaps Lib "winmm" Alias "waveInGetDevCapsA" (ByVal uDeviceID As Long, ByVal WaveInCapsPointer As Long, ByVal WaveInCapsStructSize As Long) As Long

Private Declare Function waveInOpen Lib "winmm" (WaveDeviceInputHandle As Long, ByVal WhichDevice As Long, ByVal WaveFormatExPointer As Long, ByVal CallBack As Long, ByVal CallBackInstance As Long, ByVal Flags As Long) As Long
Private Declare Function waveInClose Lib "winmm" (ByVal WaveDeviceInputHandle As Long) As Long

Private Declare Function waveInStart Lib "winmm" (ByVal WaveDeviceInputHandle As Long) As Long
Private Declare Function waveInReset Lib "winmm" (ByVal WaveDeviceInputHandle As Long) As Long
Private Declare Function waveInStop Lib "winmm" (ByVal WaveDeviceInputHandle As Long) As Long

Public Sub InitDevices()
'Fill the DeviceBox box with all the compatible audio input devices
'Bail if there are none.

Dim Caps As WaveInCaps, Which As Long
DeviceBox.Clear
For Which = 0 To waveInGetNumDevs - 1
Call waveInGetDevCaps(Which, VarPtr(Caps), Len(Caps))
If Caps.Formats And WAVE_FORMAT_1M16 Then '16-bit mono devices
Call DeviceBox.AddItem(StrConv(Caps.ProductName, vbUnicode), Which)
End If
Next
If DeviceBox.ListCount = 0 Then
MsgBox "You have no audio input devices!", vbCritical, "Ack!"
End 'Ewww! End! Bad me!
End If
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