Problem with MIDI;
Also, I love this method, but after reading all the info it looks like it won't actually let me specify exact frequencies for play back, only preset values for specific tones, such as one base freq for a given note, its sharp or flat.
Knowing how to do this is valuable in and of itself, I now can play back musical notes that sound a lot better than the PC Speaker sounds. Sadly this doesn't solve the problem I have though.... :(
create wav file
--------------------------------------------------------------------------------
The following code works but won't let me specify exact frequencies, only tones
This generates a wave file (no clicks or ticks... just clear sound ):
(It makes a 1 second tone of 440 Hz)
VB Code:
Option Explicit
Private Type tWAVEFORMATEX
wFormatTag As Integer
nChannels As Integer
nSamplesPerSec As Long
nAvgBytesPerSec As Long
nBlockAlign As Integer
wBitsPerSample As Integer
cbSize As Integer
ExtraData(1 To 32) As Byte ' makes the structure 50 bytes long
End Type
Private Type FileHeader
lRiff As Long
lFileSize As Long
lWave As Long
lFormat As Long
lFormatLength As Long
End Type
Private Type WaveFormat
wFormatTag As Integer
nChannels As Integer
nSamplesPerSec As Long
nAvgBytesPerSec As Long
nBlockAlign As Integer
wBitsPerSample As Integer
End Type
Private Type ChunkHeader
lType As Long
lLen As Long
End Type
Private Sub Form_Load()
Dim Buff(0 To 44100) As Integer
GenerateTone 440, Buff, 1
SaveWaveFile "C:\test_Wave.wav", Buff
End Sub
Private Sub GenerateTone(ByVal Frequency As Single, IntBuff() As Integer, Optional Amplitude As Single = 1, Optional SamplesPerSec As Long = 44100, Optional Startpos As Long = 0, Optional Length As Long = -1)
Dim K As Long, V1 As Double
Const PI As Double = 3.14159265358979
V1 = SamplesPerSec / (PI * 2 * Frequency)
If Length = -1 Then Length = UBound(IntBuff) - Startpos
For K = Startpos To Startpos + Length
IntBuff(K) = CInt(Fix(Sin(K / V1) * (32766.5 * Amplitude)))
Next K
End Sub
Private Sub SaveWaveFile(ByVal WaveFileName As String, ByRef Buffer() As Integer, Optional SamplesPerSec As Long = 44100)
Dim WF As tWAVEFORMATEX
WF.wFormatTag = 1 'WAVE_FORMAT_PCM
WF.nChannels = 1
WF.wBitsPerSample = 16
WF.nSamplesPerSec = SamplesPerSec
WF.nBlockAlign = (WF.wBitsPerSample * WF.nChannels) \ 8
WF.nAvgBytesPerSec = WF.nSamplesPerSec * WF.nBlockAlign
Open WaveFileName For Binary Access Write Lock Write As #1
WaveWriteHeader 1, WF
Put #1, , Buffer
WaveWriteHeaderEnd 1
Close #1
End Sub
Private Sub WaveWriteHeader(ByVal OutFileNum As Integer, WaveFmt As tWAVEFORMATEX)
Dim header As FileHeader
Dim HdrFormat As WaveFormat
Dim chunk As ChunkHeader
With header
.lRiff = &H46464952 ' "RIFF"
.lFileSize = 0
.lWave = &H45564157 ' "WAVE"
.lFormat = &H20746D66 ' "fmt "
.lFormatLength = Len(HdrFormat)
End With
With HdrFormat
.wFormatTag = WaveFmt.wFormatTag
.nChannels = WaveFmt.nChannels
.nSamplesPerSec = WaveFmt.nSamplesPerSec
.nAvgBytesPerSec = WaveFmt.nAvgBytesPerSec
.nBlockAlign = WaveFmt.nBlockAlign
.wBitsPerSample = WaveFmt.wBitsPerSample
End With
chunk.lType = &H61746164 ' "data"
chunk.lLen = 0
Put #OutFileNum, 1, header
Put #OutFileNum, , HdrFormat
Put #OutFileNum, , chunk
End Sub
Private Sub WaveWriteHeaderEnd(ByVal OutFileNum As Integer)
Dim header As FileHeader
Dim HdrFormat As WaveFormat
Dim chunk As ChunkHeader
Dim Lng As Long
Lng = LOF(OutFileNum)
Put #OutFileNum, 5, Lng
Lng = LOF(OutFileNum) - (Len(header) + Len(HdrFormat) + Len(chunk))
Put #OutFileNum, Len(header) + Len(HdrFormat) + 5, Lng
End Sub
===========
===========
This code works, but only allows me to generate sounds to the PC Speaker, which sounds horrible!
Option Explicit
Private Declare Function Beep Lib "kernel32.dll" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Private Sub Command1_Click()
Beep 432.8765, 1000
End Sub
================
=========================
This code works for MIDI, but doesn't let me specify exact frequencies only preset musical tones
==================
midiOutShortMsg
The midiOutShortMsg function sends a short MIDI message to the specified MIDI output device.
VB4-32,5,6
Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As Long
Operating Systems Supported
Requires Windows NT 3.1 or later; Requires Windows 95 or later
=============
PLAY NOTE:
Private Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As Long
Private Declare Function midiOutOpen Lib "winmm.dll" (lphMidiOut As Long, ByVal uDeviceID As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
Private Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As Long
Dim hMidiOut As Long
Private Sub Form_Load()
'KPD-Team 2000
'URL: http://www.allapi.net/
'E-Mail: [email protected]
Dim T As Long
midiOutOpen hMidiOut, 0, 0, 0, 0
midiOutShortMsg hMidiOut, 6567325
T = Timer
Do: DoEvents: Loop Until Timer > T + 4
midiOutClose hMidiOut
End Sub
----------------------
http://allapi.mentalis.org/apilist/midiOutShortMsg.shtml
===============================
Again, this only works for the PC Speaker
A better beep
If you aren't satisfied with the standard Beep command (who is?) you can use the Beep API function instead, that lets you control both the frequency (in Hertz) and the duration (in milliseconds) of the beep. Note that you need an aliased Declare to avoid a name conflict with the VB command:
Private Declare Function BeepAPI Lib "kernel32" Alias "Beep" (ByVal dwFrequency _
As Long, ByVal dwMilliseconds As Long) As Long
The standard Beep command has a frequency of 440 Hertz and a duration of 200 milliseconds (more or less), so you can produce a short beep with a higher pitch with the following statement:
BeepAPI 600, 100
And of course you can even produce more complex sounds, when a simple beep won't suffice:
Dim i As Long
For i = 100 To 1000 Step 10
BeepAPI i, 20
Next
No one has replied yet! Why not be the first?
Sign in or Join us (it's free).