Prev: Problem Registering RICHTX32.OCX with Vista
Next: ActiveX DLL for an ASP site
From: Stefan Mueller on 17 Dec 2008 22:40
Hello

I'd like to write a small tool which displays the audio data (an
animated line) captured by a microphone in real time.

Does anyone know how to get the audio data captured by a microphone
into the memory with VB6 so that I can use them to show the animated
line (no noise -> horizontal straight line / noise -> horizontal line
with valleys and hills)?

Regards
Stefan
From: Mike Williams on 18 Dec 2008 03:54
On 18 Dec, 03:40, Stefan Mueller <seekw...(a)yahoo.com> wrote:
> Hello
>
> I'd like to write a small tool which displays the audio data
> (an animated line) captured by a microphone in real time.
>
> Does anyone know how to get the audio data captured by a
> microphone into the memory with VB6 so that I can use them
> to show the animated line (no noise -> horizontal straight
> line / noise -> horizontal line with valleys and hills)?
>
> Regards
> Stefan

Here is a small program written by someone called Murphy McCauly. I
downloaded it ages ago from a VB site but I can't remember which one
it was. Anyway, the following is the full content of the VB6 .frm
file. Just paste it into NotePad or something and save it as
Oscilloscope.frm and you will be able to run it (or of course you can
load the .frm file into your own VB program):

Mike

VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 7320
ClientLeft = 3810
ClientTop = 1725
ClientWidth = 10590
LinkTopic = "Form1"
ScaleHeight = 488
ScaleMode = 3 'Pixel
ScaleWidth = 706
StartUpPosition = 3 'Windows Default
Begin VB.PictureBox Scope
BackColor = &H80000009&
ForeColor = &H80000002&
Height = 768
Index = 1
Left = 1656
ScaleHeight = 256
ScaleMode = 0 'User
ScaleWidth = 123
TabIndex = 6
Top = 468
Width = 1524
End
Begin VB.Frame Stuff
BorderStyle = 0 'None
Height = 336
Left = 72
TabIndex = 2
Top = 1296
Width = 3360
Begin VB.CommandButton StartButton
Caption = "&Start"
Height = 336
Left = 0
TabIndex = 5
Top = 0
Width = 804
End
Begin VB.CommandButton StopButton
Caption = "S&top"
Enabled = 0 'False
Height = 336
Left = 864
TabIndex = 4
Top = 0
Width = 804
End
Begin VB.CheckBox Flicker
Caption = "Flickerless"
Height = 300
Left = 1800
TabIndex = 3
Top = 36
Width = 1632
End
End
Begin VB.PictureBox Scope
BackColor = &H80000009&
ForeColor = &H80000002&
Height = 768
Index = 0
Left = 72
ScaleHeight = 256
ScaleMode = 0 'User
ScaleWidth = 123
TabIndex = 1
Top = 468
Width = 1524
End
Begin VB.ComboBox DevicesBox
Height = 315
Left = 60
Style = 2 'Dropdown List
TabIndex = 0
Top = 60
Width = 3108
End
Begin VB.Shape Shape
BackColor = &H00C00000&
BackStyle = 1 'Opaque
BorderStyle = 0 'Transparent
Height = 1188
Left = 0
Top = 0
Width = 1812
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

' Deeth Stereo Oscilloscope v1.0
' A simple oscilloscope application -- now in <<stereo>>

' Opens a waveform audio device for 8-bit 11kHz input, and plots the
' waveform to a window. Can only be resized to a certain minimum
' size defined by the Shape box.

' It would be good to make this use the same double-buffering
' scheme as the Spectrum Analyzer.

' Murphy McCauley (MurphyMc(a)Concentric.NET) 08/12/99

Option Explicit

Private DevHandle As Long
Private InData(0 To 511) As Byte
Private Inited As Boolean
Public MinHeight As Long, MinWidth As Long

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 = &H0& 'invalid format
Private Const WAVE_FORMAT_1M08 = &H1& '11.025 kHz Mono 8-bit
Private Const WAVE_FORMAT_1S08 = &H2& '11.025 kHz Stereo 8-bit
Private Const WAVE_FORMAT_1M16 = &H4& '11.025 kHz Mono 16-bit
Private Const WAVE_FORMAT_1S16 = &H8& '11.025 kHz Stereo 16-bit
Private Const WAVE_FORMAT_2M08 = &H10& '22.05 kHz Mono 8-bit
Private Const WAVE_FORMAT_2S08 = &H20& '22.05 kHz Stereo 8-bit
Private Const WAVE_FORMAT_2M16 = &H40& '22.05 kHz Mono 16-bit
Private Const WAVE_FORMAT_2S16 = &H80& '22.05 kHz Stereo 16-bit
Private Const WAVE_FORMAT_4M08 = &H100& '44.1 kHz Mono 8-bit
Private Const WAVE_FORMAT_4S08 = &H200& '44.1 kHz Stereo 8-bit
Private Const WAVE_FORMAT_4M16 = &H400& '44.1 kHz Mono 16-bit
Private Const WAVE_FORMAT_4S16 = &H800& '44.1 kHz Stereo 16-bit

Private Const WAVE_FORMAT_PCM = 1

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

Private Const WIM_OPEN = &H3BE
Private Const WIM_CLOSE = &H3BF
Private Const WIM_DATA = &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

Sub InitDevices()
Dim Caps As WaveInCaps, Which As Long
DevicesBox.Clear
For Which = 0 To waveInGetNumDevs - 1
Call waveInGetDevCaps(Which, VarPtr(Caps), Len(Caps))
'If Caps.Formats And WAVE_FORMAT_1M08 Then
If Caps.Formats And WAVE_FORMAT_1S08 Then
'Now is 1S08 -- Check for devices that can
'do stereo 8-bit 11kHz
Call DevicesBox.AddItem(StrConv(Caps.ProductName, _
vbUnicode), Which)
End If
Next
If DevicesBox.ListCount = 0 Then
MsgBox "You have no audio input devices!", _
vbCritical, "Ack!"
End
End If
DevicesBox.ListIndex = 0
End Sub


Private Sub Flicker_Click()
Scope(0).Cls
Scope(1).Cls
If Flicker.Value = vbChecked Then
Scope(0).AutoRedraw = True
Scope(1).AutoRedraw = True
Else
Scope(0).AutoRedraw = False
Scope(1).AutoRedraw = False
End If
End Sub


Private Sub Form_Load()
Call InitDevices

'Set MinWidth and MinHeight based on Shape...
Dim XAdjust As Long, YAdjust As Long
XAdjust = Me.Width \ Screen.TwipsPerPixelX - Me.ScaleWidth
YAdjust = Me.Height \ Screen.TwipsPerPixelY - Me.ScaleHeight

MinWidth = Shape.Width + XAdjust
MinHeight = Shape.Height + YAdjust

Shape.BackStyle = vbTransparent


End Sub


Private Sub Form_Resize()
Scope(0).Cls
Scope(1).Cls

Stuff.Top = Me.ScaleHeight - Stuff.Height - 3
Scope(0).Height = Me.ScaleHeight - 75
Scope(1).Height = Scope(0).Height
Scope(0).Width = (Me.ScaleWidth - 13) \ 2
Scope(1).Width = Scope(0).Width
Scope(1).Left = Scope(0).Left + Scope(0).Width + 1

DevicesBox.Width = Me.ScaleWidth - 13

Scope(0).ScaleHeight = 256
Scope(0).ScaleWidth = 255
Scope(1).ScaleHeight = 256
Scope(1).ScaleWidth = 255

'Make the window resize now so that it doesn't
'interfere with redrawing the data
DoEvents

'Redraw the data at the new size
If Inited = True Then
Call DrawData
End If
End Sub


Private Sub Form_Unload(Cancel As Integer)
If DevHandle <> 0 Then
Call DoStop
End If
End Sub


Private Sub StartButton_Click()
Static WaveFormat As WaveFormatEx
With WaveFormat
.FormatTag = WAVE_FORMAT_PCM
.Channels = 2 'Two channels -- left and right
.SamplesPerSec = 11025 '11khz
.BitsPerSample = 8
.BlockAlign = (.Channels * .BitsPerSample) \ 8
.AvgBytesPerSec = .BlockAlign * .SamplesPerSec
.ExtraDataSize = 0
End With

Debug.Print "waveInOpen:"; waveInOpen(DevHandle, _
DevicesBox.ListIndex, VarPtr(WaveFormat), 0, 0, 0)

If DevHandle = 0 Then
Call MsgBox("Wave input device didn't open!", _
vbExclamation, "Ack!")
Exit Sub
End If
Debug.Print " "; DevHandle
Call waveInStart(DevHandle)

Inited = True

StopButton.Enabled = True
StartButton.Enabled = False

Call Visualize
End Sub


Private Sub StopButton_Click()
Call DoStop
End Sub


Private Sub DoStop()
Call waveInReset(DevHandle)
Call waveInClose(DevHandle)
DevHandle = 0
StopButton.Enabled = False
StartButton.Enabled = True
End Sub


Private Sub Visualize()
Static Wave As WaveHdr

Wave.lpData = VarPtr(InData(0))
Wave.dwBufferLength = 512 'This is now 512
'so there's still 256 samples per channel
Wave.dwFlags = 0

Do

Call waveInPrepareHeader(DevHandle, VarPtr(Wave), Len(Wave))
Call waveInAddBuffer(DevHandle, VarPtr(Wave), Len(Wave))

Do
'Nothing -- we're waiting for the audio
'driver to mark this wave chunk as done.
Loop Until ((Wave.dwFlags And WHDR_DONE) _
= WHDR_DONE) Or DevHandle = 0

Call waveInUnprepareHeader(DevHandle, _
VarPtr(Wave), Len(Wave))

If DevHandle = 0 Then
'The device has closed...
Exit Do
End If

Scope(0).Cls
Scope(1).Cls

Call DrawData

DoEvents
Loop While DevHandle <> 0 'While audio device is open

End Sub


Private Sub DrawData()
Static X As Long

Scope(0).CurrentX = -1
Scope(0).CurrentY = Scope(0).ScaleHeight \ 2
Scope(1).CurrentX = -1
Scope(1).CurrentY = Scope(0).ScaleHeight \ 2

'Plot the data...
For X = 0 To 255
'For a good soundcard...
Scope(0).Line Step(0, 0)-(X, InData(X * 2))
Scope(1).Line Step(0, 0)-(X, InData(X * 2 + 1))

'Use these to plot dots instead of lines...
'For a good soundcard...
'Scope(0).PSet (X, InData(X * 2))
'Scope(1).PSet (X, InData(X * 2 + 1))

'My soundcard is pretty cheap... the right is
'noticably less loud than the left... so I add 5
'Scope(1).Line Step(0, 0)-(X, InData(X * 2 + 1) + 5)
Next

Scope(0).CurrentY = Scope(0).Width
Scope(1).CurrentY = Scope(0).Width
End Sub




From: Stefan Mueller on 18 Dec 2008 19:13
Hello Mike

Many many thanks to you and Murphy McCauly. This code is exactly what
I was looking for. It's just great!

Many thanks again, regards
Stefan
 | 
Pages: 1
Prev: Problem Registering RICHTX32.OCX with Vista
Next: ActiveX DLL for an ASP site