How can i play de musical notes with Visual Basic 6?

[Capo]

I need play the musical notes. How can i do that. 1000 thanks.

 

[davec8783]

If you create a wav or midi file you can run it using the multimedia control. It is easy to play a music file once it is created.

 

[tedsmith]

I want to know too - without using a wave file - like you can with quickbasic and MSaccess Version2 APIs.

 

[scking]

I built a VB6 prototype called MediaToy which uses ActiveX, Shockwave, and audio files .wav and .midi. The Splash screen opens up with ShockWave objects on it and then the main form opens which allows the user to select .wav or .midi files in a listbox. They are then played using the following functions. I've given you more than you need. You can ignore TestFiles and GetFiles functions.

Steve King


'Basic Wave Playing by J W Lehman
Declare Function sndPlaySoundx Lib "MMSYSTEM.DLL" (ByVal lpszSoundName$, ByVal wFlags%) As Integer

Public Declare Function sndPlaySound Lib "winmm" Alias "sndPlaySoundA" _
(ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

Global Const SND_SYNC = &H0
Global Const SND_ASYNC = &H1
Global Const SND_NODEFAULT = &H2
Global Const SND_LOOP = &H8
Global Const SND_NOSTOP = &H10

Type tagOPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
strFilter As String
strCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
strFile As String
nMaxFile As Long
strFileTitle As String
nMaxFileTitle As Long
strInitialDir As String
strTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
strDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

' Note: This code is from the Access 95 Developer's Handbook,
' by Paul Litwin, Ken Getz, Mike Gilbert, and Greg Reddick.
' (c) 1995 by Sybex.
' Used with permission



Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

Public Const glrOFN_READONLY = &H1
Public Const glrOFN_OVERWRITEPROMPT = &H2
Public Const glrOFN_HIDEREADONLY = &H4
Public Const glrOFN_NOCHANGEDIR = &H8
Public Const glrOFN_SHOWHELP = &H10
Public Const glrOFN_NOVALIDATE = &H100
Public Const glrOFN_ALLOWMULTISELECT = &H200
Public Const glrOFN_EXTENSIONDIFFERENT = &H400
Public Const glrOFN_PATHMUSTEXIST = &H800
Public Const glrOFN_FILEMUSTEXIST = &H1000
Public Const glrOFN_CREATEPROMPT = &H2000
Public Const glrOFN_SHAREAWARE = &H4000
Public Const glrOFN_NOREADONLYRETURN = &H8000
Public Const glrOFN_NOTESTFILECREATE = &H10000
Public Const glrOFN_NONETWORKBUTTON = &H20000
Public Const glrOFN_NOLONGNAMES = &H40000
Public Const glrOFN_EXPLORER = &H80000
Public Const glrOFN_NODEREFERENCELINKS = &H100000
Public Const glrOFN_LONGNAMES = &H200000

Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
(ByVal lpString1 As String, ByVal _
lpString2 As String) As Long
Declare Function glr_apiGetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (ofn As tagOPENFILENAME) As Boolean
Declare Function glr_apiGetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (ofn As tagOPENFILENAME) As Boolean

'Play MIDI file
Private Declare Function mciSendString Lib "winmm.dll" Alias _
"mciSendStringA" (ByVal lpstrCommand As String, ByVal _
lpstrReturnString As String, ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long

Public Function PlayMidiFile(MidiFile As String) As Boolean

'MidiFile = File's Full Path
'Returns: True if successful, false otherwise

Dim lRet As Long

On Error Resume Next

If Dir(MidiFile) = "" Then Exit Function
'Stop any currently playing .mid
lRet = mciSendString("stop midi", "", 0, 0)
lRet = mciSendString("close midi", "", 0, 0)

'Play
lRet = mciSendString("open sequencer!" & MidiFile & " alias midi", "", 0, 0)
lRet = mciSendString("play midi", "", 0, 0)
PlayMidiFile = (lRet = 0)
Debug.Print "PlayMidiFile " & MidiFile

End Function

Public Function StopMidi() As Boolean

'Stops midi from playing
'Returns: True if successful, false otherwise

Dim lRet As Long

On Error Resume Next

'Stop any currently playing .midi
lRet = mciSendString("stop midi", "", 0, 0)
StopMidi = (lRet = 0)
lRet = mciSendString("close midi", "", 0, 0)


End Function

Public Sub Main()

frmSplash.Show

End Sub

Function GetFiles(strPath As String, _
dctDict As Dictionary, _
Optional blnRecursive As Boolean) As Boolean

' This procedure returns all the files in a directory into
' a Dictionary object. If called recursively, it also returns
' all files in subfolders.

Dim fsoSysObj As FileSystemObject
Dim fdrFolder As Folder
Dim fdrSubFolder As Folder
Dim filFile As File
Dim filItem As Variant
' Return new FileSystemObject.
Set fsoSysObj = New FileSystemObject

On Error Resume Next
' Get folder.
Set fdrFolder = fsoSysObj.GetFolder(strPath)
If Err <> 0 Then
' Incorrect path.
GetFiles = False
GoTo GetFiles_End
End If
On Error GoTo 0

' Loop through Files collection, adding to dictionary.
For Each filFile In fdrFolder.Files
dctDict.Add filFile.Path, filFile.Path
Next filFile

' If Recursive flag is true, call recursively.
If blnRecursive Then
For Each fdrSubFolder In fdrFolder.SubFolders
GetFiles fdrSubFolder.Path, dctDict, True
Next fdrSubFolder
End If

' Return True if no error occurred.
GetFiles = True

GetFiles_End:
Exit Function
End Function

Sub TestGetFiles()
' Call to test GetFiles function.

Dim dctDict As Dictionary
Dim varItem As Variant

' Create new dictionary.
Set dctDict = New Dictionary
' Call recursively, return files into Dictionary object.
If GetFiles(CurDir, dctDict, True) Then
' Print items in dictionary.
For Each varItem In dctDict
If IsSupportedAudioFile(varItem) Then
Debug.Print varItem
End If
Next
End If
End Sub
Function IsSupportedAudioFile(varFilename As Variant) As Boolean

Dim strExtension As String
strExtension = Right$(varFilename, 3)

Select Case strExtension
Case &quot;MID&quot;, &quot;WAV&quot;, &quot;mid&quot;, &quot;wav&quot;
IsSupportedAudioFile = True
Case Else
IsSupportedAudioFile = False
End Select

End Function

 

[tedsmith]

Thanks Steve but what we want is how to generate tones directly without using midi or a file that has had the sound 'recorded' on it. You used to be able to do this in DOS basic and the first version of Visual basic and MSAccess2 using a 16 bit API but with vb6, you get a messsage that says &quot;cant find the reference in the DLL&quot;
The old command was something like
Sound(Frequency,Duration)
Thanks Ted

 

[tedsmith]

Playing sound: Just 2 lines of code.Declare the sndPlaySound function in your module then call the SndPlaySound function (with the name of a your wave file containing the sound)in the load routine of your first form. (You can find details at the MSN API reference site)

To make a window stay up for a certain time, you can either make the window a new small form (set borders and size)or a use a frame on your current form.
Have a timer on your splash form or current form set to the time delay you want and set the timer1.enabled to true. In the sub timer1_timer you put -
Unload MySplashForm:timer1.enabled=false for a form or
MySplashFrame.visible=false.timer1.enabled=false for a frame

To show it you put in the original sub form_load:-
MySplashForm.Show or MsSplashFrame.visible=true.

It hides itself when the timer delay has elapsed.

I've never tried the other things.
What does your new program do?

 

[Capo]

I'm only want to make a little program to recognize the musical notes.

 

[MickTheBelgian]

if you want to work without WAV, use beep:

Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Private Sub Form_Activate()
    'KPD-Team 1999
    'URL: [URL unfurl="true"]http://www.allapi.net/[/URL]
    'E-Mail: KPDTeam@Allapi.net
    Dim Cnt As Long
    For Cnt = 0 To 5000 Step 10
        'play a tone of 'Cnt' hertz, for 50 milliseconds
        Beep Cnt, 50
        Me.Caption = Cnt
        DoEvents
    Next Cnt
End Sub

Only NT!!!!!
Declare Function Beep Lib &quot;kernel32&quot; Alias &quot;Beep&quot; (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
· dwFreq
Windows NT:
Specifies the frequency, in hertz, of the sound. This parameter must be in the range 37 through 32,767 (0x25 through 0x7FFF).
Windows 95:
The parameter is ignored.

· dwDuration
Windows NT:
Specifies the duration, in milliseconds, of the sound.
Windows 95:
The parameter is ignored.

 

[edderic]

To Capo

Whas the example I send not enough ?

Eric
Eric De Decker
vbg.be@vbgroup.nl

Licence And Copy Protection AxtiveX.

Download Demo version on my Site:
Promotions before 02/28/2001 (free source codebook),visite my site

http://www.createsoftware2000.com

 

[tedsmith]

Sorry, My post about sndPlaySound was meant for another thread - please ignore.
Having to re enter my user name and password every time I reply to a thread is a pain and easy to get mixed up.
Ted

 

[dbrooks74]

I finally figured this one out throw this code in the beginning of your form...
#If Win32 Then

Private Declare Function mciSendString Lib &quot;winmm.dll&quot; Alias _
&quot;mciSendStringA&quot; (ByVal lpstrCommand As String, ByVal _
lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal _
hwndCallback As Long) As Long

#ElseIf Win16 Then

Private Declare Function mciSendString Lib &quot;mmsystem&quot; (ByVal _
lpstrCommand As String, ByVal lpstrReturnStr As Any, ByVal _
wReturnLen As Integer, ByVal hCallBack As Integer) As Long

#End If

Then within a command button for instance put this code...

Private Sub Command1_Click()
Dim ret As Integer

' The following will open the sequencer with the C:\Sounds\ff9finalbattle(2).mid
ret = mciSendString( _
&quot;open C:\Sounds\ff9finalbattle(2).mid type sequencer alias canyon&quot;, &quot;&quot;, 0, 0)
ret = mciSendString(&quot;C:\Sounds\ff9finalbattle(2).mid&quot;, &quot;&quot;, 0, 0)
ret = mciSendString(&quot;play canyon&quot;, &quot;&quot;, 0, 0)
End Sub

All you need now is to tell your program to stop playing the file. I do this on form unload...
ret = mciSendString(&quot;close canyon&quot;, &quot;&quot;, 0, 0)

The whole point of the ret integers is so you can tell what point your at in your midi program

 

[2Teknikal]

I just tried the beep method suggested by MickTheBelgian and it didnt work, I dont get any change in the length or frequency of the beep, Does this method work in Win98?

 

[compdrmt]

My though is this. Are there keyboard codes that play sounds similar tothe bell ascii code. I have an asci chart but not one for unicode. Anyone ?

 

[Hypetia]

Run this code. Just for fun. It uses the Beep API which works properly on WinNT/2k/XP only.
___
[tt]
' &quot;Annie's Song&quot;
' by John Denver
Option Explicit
Private Declare Function Beep Lib &quot;kernel32&quot; (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Private Declare Sub Sleep Lib &quot;kernel32&quot; (ByVal dwMilliseconds As Long)
Private Sub Form_Load()
Dim Note As Long
Dim Frequencies As String, Durations As String
Dim Frequency As Long, Duration As Long
Frequencies = &quot;iiihfihfffhidadddfhihfffhihiiihfihffihfdadddfhihffhiki&quot;
Durations = &quot;aabbbfjaabbbbnaabbbfjaabcapaabbbfjaabbbbnaabbbfjaabcap&quot;
Const E4 = 329.6276
For Note = 1 To Len(Frequencies)
Frequency = E4 * 2 ^ ((Asc(Mid$(Frequencies, Note, 1)) - 96) / 12)
Duration = (Asc(Mid$(Durations, Note, 1)) - 96) * 200 - 10
Beep Frequency, Duration
Sleep 10
DoEvents
Next
Unload Me
End Sub[/tt]
___

Note that Beep API function does not generate the beep of the desired frequency on Win95/98/Me machines. However, this function can be emulated in a VB program using a port i/o DLL. With the help of that DLL, you can control the PPI and PIT chips on the mother board to control the system timer and system speaker to generate the tones of the desired frequency.

 

[Hypetia]

Here is the code which emulates the Beep function in VB to make the above program work in Windows 98 as well.

It uses win95io.dll port I/O library from

http://www.softcircuits.com

which is available for download at ftp://ftp.softcircuits.com/tools/win95io.zip

The size of this tiny DLL is only 4KB but it does a great job. Before running this code download and extract this file to Windows\System directory.
___
[tt]
' &quot;Annie's Song&quot;
' by John Denver

'for Windows 95/98/Me.
Option Explicit
Private Declare Sub vbOut Lib &quot;Win95io.dll&quot; (ByVal nPort As Integer, ByVal nData As Integer)
Private Declare Function vbInp Lib &quot;Win95io.dll&quot; (ByVal nPort As Integer) As Integer
Private Declare Sub Sleep Lib &quot;kernel32&quot; (ByVal dwMilliseconds As Long)
Private Sub Form_Load()
Dim Note As Long
Dim Frequencies As String, Durations As String
Dim Frequency As Long, Duration As Long
Frequencies = &quot;iiihfihfffhidadddfhihfffhihiiihfihffihfdadddfhihffhiki&quot;
Durations = &quot;aabbbfjaabbbbnaabbbfjaabcapaabbbfjaabbbbnaabbbfjaabcap&quot;
Const E4 = 329.6276
For Note = 1 To Len(Frequencies)
Frequency = E4 * 2 ^ ((Asc(Mid$(Frequencies, Note, 1)) - 96) / 12)
Duration = (Asc(Mid$(Durations, Note, 1)) - 96) * 200 - 10
Beep Frequency, Duration
Sleep 10
DoEvents
Next
Unload Me
End Sub
Sub Beep(Frequency As Long, Duration As Long)
'This procedure emulates the Beep API.
'It uses Win95io.dll for port I/O.

'Ports 66 and 67 control the onboard PIT.
'PIT base address = 40H = 64. (Range: 40H - 43H)
'Address of command register of PIT = 67.
'Address of Timer #2 = 66
'Timer #2 is the last timer of the PIT and is
'internally connected to the PC speaker.

'Port 97 controls the speaker connected to the PPI chip.

'Divide clock frequency by sound frequency to get the
'number of clock pulses the timer must produce.
'The timer is clocked by a frequency of 1193180 Hz derived
'from the crystal.
Dim Pulses As Long, LoByte As Integer, HiByte As Integer
Pulses = 1193180 / Frequency

'Split this value in two bytes (hi and lo).
'These bytes will be sent one-by-one to the PIT.
LoByte = Pulses Mod 256
HiByte = Pulses \ 256

'Now program the timer 2 in mode 3. (Square wave generator)
'The Command Word is determined as follows.

' 1 0 | 1 1 | 0 1 1 | 0
'Timer #2 | Lo-byte then Hi-byte serially | Mode 3(Square Wave gen.) | Binary data

'Thus the command word is 10110110b = B6h = 182.

'Send this command word to PIT command
'register located at address #67.
vbOut 67, &HB6 'B6h = 10110110b

'Now send count to the timer #2 by sending
'the lo and hi bytes to the timer serially.
vbOut 66, LoByte 'Send LoByte.
vbOut 66, HiByte 'Send HiByte.

'At this moment the timer has started sending square wave
'pulses at the required audio frequency to the PPI chip.

'Now turn on the speaker by setting the bits 0 and 1 of PPI chip.
'Port Address = 97. (61h)
Dim X As Integer
X = vbInp(97) 'Read byte value from the PPI.
X = X Or &H3 'Set the lower 2 bits.
vbOut 97, X 'Send the modified byte.

'wait for the required duration.
Sleep Duration

'Now turn the speaker off by masking the lower 2 bits.
X = vbInp(97) 'Read byte value from the PPI.
X = X And &HFC 'Mask the lower 2 bits. (&HFC= 11111100B)
vbOut 97, X 'Send the modified byte.
End Sub[/tt]