We help IT Professionals succeed at work.

Sounding notes in VB6

starrman
starrman asked
on
1,875 Views
Last Modified: 2010-05-18
Is there a way to produce a simple tone (comprising pitch & duration) using VB6?
Comment
Watch Question

Put this into a module !!

Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Option Explicit

Public Sub PlayGood()
    Dim F%
    For F = 1600 To 1700 Step 20
        Beep F, 10
    Next F
End Sub

Public Sub PlayBad()
    Beep 200, 150
    Beep 100, 150
End Sub


This only works on NT and Win2000

Smegg

Author

Commented:
smegghead (nice handle!),

Good solution but I should have mentioned that I need it at least for win98, preferably multiplatform...apologies...

Starrman

Commented:
There is no simple tone in Windows.
Sorry. Get ready for some serious API programming.

Author

Commented:
Foyal,
I don't mind using API calls to resolve the problem but woudn't know where to begin.  When you say "Get ready for some serious API programming" do you mean  there's a solution but it's complex - if so, is it something you can help me achieve?

Starrman

Commented:
Let me dig through my stuff. I'll get back to you soon.
You could install the driver for the PC speaker, then use it as if it was a soundcard.. sending midi messages to it..

Commented:
midOutShortMsg API call is the answer... I'll have it all worked out later today... gotta run

See 'ya this evening
Foyal

Author

Commented:
Smegghead,
Thanks for the suggestion - have to admit - I'd have no idea how to implement this.
Starrman

Author

Commented:
Foyal,

That sounds very promising.  I look forward to your solution and, because the amount of points for this question is fairly measly I'll award more for your efforts.  Thanks.

Starrman

Commented:
I already have it worked out.. I just don't have time to post... I WILL put the answer onling later today.
See 'ya
Foyal

Commented:
'This is a killer!!!
'You want a tone??? you can have any kind your heart desires.

'Note values are from 0 to 127: Middle C = 60


'Module code-----------------------------------
Option Explicit

Public Const MAXPNAMELEN = 32             ' Maximum product name length

' Error values for functions used in this sample. See the function for more information
Public Const MMSYSERR_BASE = 0
Public Const MMSYSERR_BADDEVICEID = (MMSYSERR_BASE + 2)     ' device ID out of range
Public Const MMSYSERR_INVALPARAM = (MMSYSERR_BASE + 11)     ' invalid parameter passed
Public Const MMSYSERR_NODRIVER = (MMSYSERR_BASE + 6)        ' no device driver present
Public Const MMSYSERR_NOMEM = (MMSYSERR_BASE + 7)           ' memory allocation error

Public Const MMSYSERR_INVALHANDLE = (MMSYSERR_BASE + 5)     ' device handle is invalid
Public Const MIDIERR_BASE = 64
Public Const MIDIERR_STILLPLAYING = (MIDIERR_BASE + 1)      ' still something playing
Public Const MIDIERR_NOTREADY = (MIDIERR_BASE + 3)          ' hardware is still busy
Public Const MIDIERR_BADOPENMODE = (MIDIERR_BASE + 6)       ' operation unsupported w/ open mode

Public Const MOD_MIDIPORT = 1   '  output port
Public Const MOD_SYNTH = 2      '  generic internal synth
Public Const MOD_SQSYNTH = 3    '  square wave internal synth
Public Const MOD_FMSYNTH = 4    '  FM internal synth
Public Const MOD_MAPPER = 5     '  MIDI mapper

Public Const MIDICAPS_VOLUME = &H1         '  supports volume control
Public Const MIDICAPS_LRVOLUME = &H2         '  separate left-right volume control
Public Const MIDICAPS_CACHE = &H4
Public Const MIDICAPS_STREAM = &H8               '  driver supports midiStreamOut directly

'User-defined variable the stores information about the MIDI output device.
Type MIDIOUTCAPS
   wMid As Integer                   ' Manufacturer identifier of the device driver for the MIDI output device
                                     ' For a list of identifiers, see the Manufacturer Indentifier topic in the
                                     ' Multimedia Reference of the Platform SDK.
   
   wPid As Integer                   ' Product Identifier Product of the MIDI output device. For a list of
                                     ' product identifiers, see the Product Identifiers topic in the Multimedia
                                     ' Reference of the Platform SDK.
   
   vDriverVersion As Long            ' Version number of the device driver for the MIDI output device.
                                     ' The high-order byte is the major version number, and the low-order byte is
                                     ' the minor version number.
                                     
   szPname As String * MAXPNAMELEN   ' Product name in a null-terminated string.
   
   wTechnology As Integer            ' One of the following that describes the MIDI output device:
                                     '     MOD_FMSYNTH-The device is an FM synthesizer.
                                     '     MOD_MAPPER-The device is the Microsoft MIDI mapper.
                                     '     MOD_MIDIPORT-The device is a MIDI hardware port.
                                     '     MOD_SQSYNTH-The device is a square wave synthesizer.
                                     '     MOD_SYNTH-The device is a synthesizer.
                                     
   wVoices As Integer                ' Number of voices supported by an internal synthesizer device. If the
                                     ' device is a port, this member is not meaningful and is set to 0.
                                     
   wNotes As Integer                 ' Maximum number of simultaneous notes that can be played by an internal
                                     ' synthesizer device. If the device is a port, this member is not meaningful
                                     ' and is set to 0.
                                     
   wCurrChannelMask As Integer           ' CurrChannels that an internal synthesizer device responds to, where the least
                                     ' significant bit refers to CurrChannel 0 and the most significant bit to CurrChannel
                                     ' 15. Port devices that transmit on all CurrChannels set this member to 0xFFFF.
                                     
   dwSupport As Long                 ' One of the following describes the optional functionality supported by
                                     ' the device:
                                     '     MIDICAPS_CACHE-Supports patch caching.
                                     '     MIDICAPS_LRMIDIVolume-Supports separate left and right MIDIVolume control.
                                     '     MIDICAPS_STREAM-Provides direct support for the midiStreamOut function.
                                     '     MIDICAPS_MIDIVolume-Supports MIDIVolume control.
                                     '
                                     ' If a device supports MIDIVolume changes, the MIDICAPS_MIDIVolume flag will be set
                                     ' for the dwSupport member. If a device supports separate MIDIVolume changes on
                                     ' the left and right CurrChannels, both the MIDICAPS_MIDIVolume and the
                                     ' MIDICAPS_LRMIDIVolume flags will be set for this member.
End Type

Declare Function midiOutGetNumDevs Lib "winmm" () As Integer
' This function retrieves the number of MIDI output devices present in the system.
' The function returns the number of MIDI output devices. A zero return value means
' there are no MIDI devices in the system.

Declare Function midiOutGetDevCaps Lib "winmm.dll" Alias "midiOutGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As MIDIOUTCAPS, ByVal uSize As Long) As Long
' This function queries a specified MIDI output device to determine its capabilities.
' The function requires the following parameters;
'     uDeviceID-     unsigned integer variable identifying of the MIDI output device. The
'                    device identifier specified by this parameter varies from zero to one
'                    less than the number of devices present. This parameter can also be a
'                    properly cast device handle.
'     lpMidiOutCaps- address of a MIDIOUTCAPS structure. This structure is filled with
'                    information about the capabilities of the device.
'     cbMidiOutCaps- the size, in bytes, of the MIDIOUTCAPS structure. Use the Len
'                    function with the MIDIOUTCAPS variable as the argument to get
'                    this value.
'
' The function returns MMSYSERR_NOERROR if successful or one of the following error values:
'     MMSYSERR_BADDEVICEID    The specified device identifier is out of range.
'     MMSYSERR_INVALPARAM     The specified pointer or structure is invalid.
'     MMSYSERR_NODRIVER       The driver is not installed.
'     MMSYSERR_NOMEM          The system is unable to load mapper string description.

Declare Function midiOutClose Lib "winmm.dll" (ByVal MIDIHwndOut As Long) As Long
' The function closes the specified MIDI output device. The function requires a
' handle to the MIDI output device. If the function is successful, the handle is no
' longer valid after the call to this function. A successful function call returns
' MMSYSERR_NOERROR.

' A failure returns one of the following:
'     MIDIERR_STILLPLAYING  Buffers are still in the queue.
'     MMSYSERR_INVALHANDLE  The specified device handle is invalid.
'     MMSYSERR_NOMEM        The system is unable to load mapper string description.

Declare Function midiOutOpen Lib "winmm.dll" (lpMIDIHwndOut As Long, ByVal uDeviceID As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
' The function opens a MIDI output device for playback. The function requires the
' following parameters
'     lphmo-               Address of an MIDIHwndOUT handle. This location is filled with a
'                          handle identifying the opened MIDI output device. The handle
'                          is used to identify the device in calls to other MIDI output
'                          functions.
'     uDeviceID-           Identifier of the MIDI output device that is to be opened.
'     dwCallback-          Address of a callback function, an event handle, a thread
'                          identifier, or a handle of a window or thread called during
'                          MIDI playback to process messages related to the progress of
'                          the playback. If no callback is desired, set this value to 0.
'     dwCallbackInstance-  User instance data passed to the callback. Set this value to 0.
'     dwFlags-Callback flag for opening the device. Set this value to 0.
'
' The function returns MMSYSERR_NOERROR if successful or one of the following error values:
'     MIDIERR_NODEVICE-       No MIDI port was found. This error occurs only when the mapper is opened.
'     MMSYSERR_ALLOCATED-     The specified resource is already allocated.
'     MMSYSERR_BADDEVICEID-   The specified device identifier is out of range.
'     MMSYSERR_INVALPARAM-    The specified pointer or structure is invalid.
'     MMSYSERR_NOMEM-         The system is unable to allocate or lock memory.

Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal MIDIHwndOut As Long, ByVal dwMsg As Long) As Long
' This function sends a short MIDI message to the specified MIDI output device. The function
' requires the handle to the MIDI output device and a message is packed into a doubleword
' value with the first byte of the message in the low-order byte. See the code sample for
' how to create this value.
'
' The function returns MMSYSERR_NOERROR if successful or one of the following error values:
'     MIDIERR_BADOPENMODE-  The application sent a message without a status byte to a stream handle.
'     MIDIERR_NOTREADY-     The hardware is busy with other data.
'     MMSYSERR_INVALHANDLE- The specified device handle is invalid.
'end module code------------------------------

'form code------------------------------------

'didn't write code to select bass index yet...
'controls:
'lblKey(0 to 35): 36 label controls, tag = "0", no caption, colored and sized like piano keys
'layout starts with c (full key)
'
'cboChannel: combo box, style=2-dropdown list
'cboDevice: combo box, style=2-dropdown list
'cboVoice: combo box, style=2-dropdown list
'hsVolume: range 0 to 127
'cmdInfo: command button
'cmdReset: command button
'


Option Explicit

Const INVALID_NOTE = -1             ' Code for keyboard keys that we don't handle

Dim FavDevice As Long                ' best device found in list      
Dim NumDevices As Long              ' number of midi output devices
Dim CurrDevice As Long              ' current midi device

Dim MIDIHwnd As Long                ' midi output handle

Dim MidiMessage As Long             ' midi output message buffer
Dim CurrChannel As Integer          ' current midi output channel

Dim MIDIVolume(0 To 16) As Integer  ' volume per channel
Dim BassIndex(0 To 16) As Integer   ' lowest keyboard note per channel
Dim MIDIVoice(0 To 16) As Integer   ' voice per channel
Dim MIDIBalance(0 To 16) As Integer ' balance (pan) per channel

Private Sub cboChannel_Click()
   
    CurrChannel = cboChannel.ListIndex
   
    cboVoice.ListIndex = MIDIVoice(CurrChannel)
    hsVolume.Value = MIDIVolume(CurrChannel)
    If hsVolume.Value = 0 Then hsVolume.Value = 102
    hsBalance.Value = MIDIBalance(CurrChannel)
    If hsBalance.Value = 0 Then hsBalance.Value = 64
   
End Sub

Private Sub cboDevice_Click()
   
    Dim S As String
    Dim T As Long
    Dim caps As MIDIOUTCAPS
   
    T = midiOutClose(MIDIHwnd)
   
    CurrDevice = cboDevice.ListIndex - 1
   
    T = midiOutOpen(MIDIHwnd, CurrDevice, 0, 0, 0)
   
    If (T <> 0) Then
        MsgBox "Couldn't open midi out: " & cboDevice.Text
    End If
   
End Sub

Private Sub cmdInfo_Click()
   
    Dim caps As MIDIOUTCAPS
    Dim S As String
    Dim S2 As String
   
    midiOutGetDevCaps CurrDevice, caps, Len(caps)
   
    With caps
   
        S = S & "Manufacturer: " & .wMid & vbCrLf
        S = S & "Product ID: " & .wPid & vbCrLf
        S = S & "Driver Version: " & .vDriverVersion & vbCrLf
        S = S & "Product Name: " & Trim(Mid(.szPname, 1, InStr(.szPname, Chr(0)) - 1)) & vbCrLf
       
        Select Case .wTechnology
            Case MOD_FMSYNTH: S2 = "FM Synthesizer"
            Case MOD_MAPPER: S2 = "Microsoft MIDI Mapper"
            Case MOD_MIDIPORT: S2 = "MIDI Hardware Port"
            Case MOD_SQSYNTH: S2 = "Square Wave Synthesizer"
            Case MOD_SYNTH: S2 = "Synthesizer"
            Case Else: S2 = ""
        End Select
       
        If S2 <> "" Then S = S & "Technology: " & S2 & vbCrLf
        If .wVoices <> 0 Then S = S & "Voices: " & .wVoices & vbCrLf
        If .wNotes <> 0 Then S = S & "Notes: " & .wNotes & vbCrLf        
        If .dwSupport = MIDICAPS_VOLUME And MIDICAPS_LRVOLUME Then
            S2 = "Stereo Volume Control"
        ElseIf .dwSupport = MIDICAPS_VOLUME Then
            S2 = "Volume Control"
        Else
            S2 = ""
        End If
       
        If S2 <> "" Then S = S & "Supports: " & S2
       
        MsgBox S, , "Current Device Information"  
   
    End With
   
End Sub

Private Sub cmdReset_Click()
   
    cboVoice.ListIndex = 0
    hsVolume.Value = 102
    hsBalance.Value = 64
    BassIndex(CurrChannel) = 60
   
End Sub


Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
   
    If KeyCode = vbKeyUp Then
        If CurrChannel > 0 Then cboChannel.ListIndex = cboChannel.ListIndex - 1
        Exit Sub
    End If
   
    If KeyCode = vbKeyDown Then
        If CurrChannel < 15 Then cboChannel.ListIndex = cboChannel.ListIndex + 1
        Exit Sub
    End If
   
    StartNote NoteFromKey(KeyCode)
   
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
   
   StopNote NoteFromKey(KeyCode)
   
End Sub

Private Sub Form_Unload(Cancel As Integer)
   
    Dim T As Long
   
    T = midiOutClose(MIDIHwnd)

End Sub

Private Sub StartNote(Index As Integer)
   
   If (Index = INVALID_NOTE) Then
      Exit Sub
   End If
   
   If (lblKey(Index).Tag = "1") Then
      Exit Sub
   End If
   
   lblKey(Index).Tag = "1"
   shpKeySelected(Index).Visible = True
   
   MidiMessage = &H90 + ((BassIndex(CurrChannel) + Index) * &H100) + (MIDIVolume(CurrChannel) * &H10000) + CurrChannel
   
   midiOutShortMsg MIDIHwnd, MidiMessage
   
End Sub

Private Sub StopNote(Index As Integer)
   
   If (Index = INVALID_NOTE) Then
      Exit Sub
   End If
   
   lblKey(Index).Tag = "0"
   shpKeySelected(Index).Visible = False
   
   MidiMessage = &H80 + ((BassIndex(CurrChannel) + Index) * &H100) + CurrChannel
   
   midiOutShortMsg MIDIHwnd, MidiMessage
   
End Sub

' Get the note corresponding to a keyboard key
Private Function NoteFromKey(key As Integer)
   NoteFromKey = INVALID_NOTE
   Select Case key
   Case vbKeyZ
      NoteFromKey = 0
   Case vbKeyS
      NoteFromKey = 1
   Case vbKeyX
      NoteFromKey = 2
   Case vbKeyD
      NoteFromKey = 3
   Case vbKeyC
      NoteFromKey = 4
   Case vbKeyV
      NoteFromKey = 5
   Case vbKeyG
      NoteFromKey = 6
   Case vbKeyB
      NoteFromKey = 7
   Case vbKeyH
      NoteFromKey = 8
   Case vbKeyN
      NoteFromKey = 9
   Case vbKeyJ
      NoteFromKey = 10
   Case vbKeyM
      NoteFromKey = 11
   Case 188 ' comma
      NoteFromKey = 12
   Case vbKeyL
      NoteFromKey = 13
   Case 190 ' period
      NoteFromKey = 14
   Case 186 ' semicolon
      NoteFromKey = 15
   Case 191 ' forward slash
      NoteFromKey = 16
   End Select

End Function

Private Sub Form_Click()

    Unload Me

End Sub

Private Sub Form_Load()
   
    Dim i As Long
    Dim j As Integer
    Dim caps As MIDIOUTCAPS
   
    For i = 0 To 36
        lblKey(i).Tag = "0"        
    Next i
       
    cboDevice.AddItem "MIDI Mapper"
   
    NumDevices = midiOutGetNumDevs()
       
    FavDevice = -1
   
    For i = 0 To (NumDevices - 1)
        midiOutGetDevCaps i, caps, Len(caps)
        cboDevice.AddItem caps.szPname
        Select Case caps.wTechnology
            Case MOD_FMSYNTH: j = 3
            Case MOD_MAPPER: j = 4
            Case MOD_MIDIPORT: j = 0
            Case MOD_SQSYNTH: j = 1
            Case MOD_SYNTH: j = 2
            Case Else: j = 0
        End Select
        If j = 2 Then
            FavDevice = j - 1
            Exit For
        End If
    Next i
   
    cboChannel.AddItem " 0"
    cboChannel.AddItem " 1"
    cboChannel.AddItem " 2"
    cboChannel.AddItem " 3"
    cboChannel.AddItem " 4"
    cboChannel.AddItem " 5"
    cboChannel.AddItem " 6"
    cboChannel.AddItem " 7"
    cboChannel.AddItem " 8"
    cboChannel.AddItem " 9"
    cboChannel.AddItem "10"
    cboChannel.AddItem "11"
    cboChannel.AddItem "12"
    cboChannel.AddItem "13"
    cboChannel.AddItem "14"
    cboChannel.AddItem "15"
   
   
    cboVoice.AddItem "  0 - Acoustic Grand Piano"
    cboVoice.AddItem "  1 - Bright Acoustic Piano"
    cboVoice.AddItem "  2 - Electric Grand Piano"
    cboVoice.AddItem "  3 - Honky -tonk Piano"
    cboVoice.AddItem "  4 - Rhodes Piano"
    cboVoice.AddItem "  5 - Chorus Piano"
    cboVoice.AddItem "  6 - Harpsichord"
    cboVoice.AddItem "  7 - Clavinet"
    cboVoice.AddItem "  8 - Celesta"
    cboVoice.AddItem "  9 - Glockenspiel"
    cboVoice.AddItem " 10 - Music Box"
    cboVoice.AddItem " 11 - Vibraphone"
    cboVoice.AddItem " 12 - Marimba"
    cboVoice.AddItem " 13 - Xylophone"
    cboVoice.AddItem " 14 - Tubular Bells"
    cboVoice.AddItem " 15 - Dulcimer"
    cboVoice.AddItem " 16 - Hammond Organ"
    cboVoice.AddItem " 17 - Percuss. Organ"
    cboVoice.AddItem " 18 - Rock Organ"
    cboVoice.AddItem " 19 - Church Organ"
    cboVoice.AddItem " 20 - Reed Organ"
    cboVoice.AddItem " 21 - Accordion"
    cboVoice.AddItem " 22 - Harmonica"
    cboVoice.AddItem " 23 - Tango Accordion"
    cboVoice.AddItem " 24 - Acoustic Guitar (nylon)"
    cboVoice.AddItem " 25 - Acoustic Guitar (steel)"
    cboVoice.AddItem " 26 - Electric Guitar (jazz)"
    cboVoice.AddItem " 27 - Electric Guitar (clean)"
    cboVoice.AddItem " 28 - Electric Guitar (muted)"
    cboVoice.AddItem " 29 - Overdriven Guitar"
    cboVoice.AddItem " 30 - Distortion Guitar"
    cboVoice.AddItem " 31 - Guitar Harmonics"
    cboVoice.AddItem " 32 - Acoustic Bass"
    cboVoice.AddItem " 33 - Electric Bass (finger)"
    cboVoice.AddItem " 34 - Electric Bass (pick)"
    cboVoice.AddItem " 35 - Fretless Bass"
    cboVoice.AddItem " 36 - Slap Bass 1"
    cboVoice.AddItem " 37 - Slap Bass 2"
    cboVoice.AddItem " 38 - Synth Bass 1"
    cboVoice.AddItem " 39 - Synth Bass 2"
    cboVoice.AddItem " 40 - Violin"
    cboVoice.AddItem " 41 - Viola"
    cboVoice.AddItem " 42 - Cello"
    cboVoice.AddItem " 43 - Contra Bass"
    cboVoice.AddItem " 44 - Tremolo Strings"
    cboVoice.AddItem " 45 - Pizzicato Strings"
    cboVoice.AddItem " 46 - Orchestral Harp"
    cboVoice.AddItem " 47 - Timpani"
    cboVoice.AddItem " 48 - String Ensemble 1"
    cboVoice.AddItem " 49 - String Ensemble 2"
    cboVoice.AddItem " 50 - Synth Strings 1"
    cboVoice.AddItem " 51 - Synth Strings 2"
    cboVoice.AddItem " 52 - Choir Aahs"
    cboVoice.AddItem " 53 - Voice Oohs"
    cboVoice.AddItem " 54 - Synth Voice"
    cboVoice.AddItem " 55 - Orchestra Hit"
    cboVoice.AddItem " 56 - Trumpet"
    cboVoice.AddItem " 57 - Trombone"
    cboVoice.AddItem " 58 - Tuba"
    cboVoice.AddItem " 59 - Muted Trumpet"
    cboVoice.AddItem " 60 - French Horn"
    cboVoice.AddItem " 61 - Brass Section"
    cboVoice.AddItem " 62 - Synth Brass 1"
    cboVoice.AddItem " 63 - Synth Brass 2"
    cboVoice.AddItem " 64 - Soprano Sax"
    cboVoice.AddItem " 65 - Alto Sax"
    cboVoice.AddItem " 66 - Tenor Sax"
    cboVoice.AddItem " 67 - Baritone Sax"
    cboVoice.AddItem " 68 - Oboe"
    cboVoice.AddItem " 69 - English Horn"
    cboVoice.AddItem " 70 - Bassoon"
    cboVoice.AddItem " 71 - Clarinet"
    cboVoice.AddItem " 72 - Piccolo"
    cboVoice.AddItem " 73 - Flute"
    cboVoice.AddItem " 74 - Recorder"
    cboVoice.AddItem " 75 - Pan Flute"
    cboVoice.AddItem " 76 - Bottle Blow"
    cboVoice.AddItem " 77 - Shaku"
    cboVoice.AddItem " 78 - Whistle"
    cboVoice.AddItem " 79 - Ocarina"
    cboVoice.AddItem " 80 - Lead 1 (square)"
    cboVoice.AddItem " 81 - Lead 2 (saw tooth)"
    cboVoice.AddItem " 82 - Lead 3 (calliope lead)"
    cboVoice.AddItem " 83 - Lead 4 (chiff lead)"
    cboVoice.AddItem " 84 - Lead 5 (charang)"
    cboVoice.AddItem " 85 - Lead 6 (voice)"
    cboVoice.AddItem " 86 - Lead 7 (fifths)"
    cboVoice.AddItem " 87 - Lead 8 (bass + lead)"
    cboVoice.AddItem " 88 - Pad 1 (new age)"
    cboVoice.AddItem " 89 - Pad 2 (warm)"
    cboVoice.AddItem " 90 - Pad 3 (poly synth)"
    cboVoice.AddItem " 91 - Pad 4 (choir)"
    cboVoice.AddItem " 92 - Pad 5 (bowed)"
    cboVoice.AddItem " 93 - Pad 6 (metallic)"
    cboVoice.AddItem " 94 - Pad 7 (halo)"
    cboVoice.AddItem " 95 - Pad 8 (sweep)"
    cboVoice.AddItem " 96 - FX 1 (rain)"
    cboVoice.AddItem " 97 - FX 2 (sound track)"
    cboVoice.AddItem " 98 - FX 3 (crystal)"
    cboVoice.AddItem " 99 - FX 4 (atmosphere)"
    cboVoice.AddItem "100 - FX 5 (bright)"
    cboVoice.AddItem "101 - FX 6 (goblins)"
    cboVoice.AddItem "102 - FX 7 (echoes)"
    cboVoice.AddItem "103 - FX 8 (sci-fi)"
    cboVoice.AddItem "104 - Sitar"
    cboVoice.AddItem "105 - Banjo"
    cboVoice.AddItem "106 - Shamisen"
    cboVoice.AddItem "107 - Koto"
    cboVoice.AddItem "108 - Kalimba"
    cboVoice.AddItem "109 - Bagpipe"
    cboVoice.AddItem "110 - Fiddle"
    cboVoice.AddItem "111 - Shanai"
    cboVoice.AddItem "112 - Tinkle Bell"
    cboVoice.AddItem "113 - Agogo"
    cboVoice.AddItem "114 - Steel Drums"
    cboVoice.AddItem "115 - Wood block"
    cboVoice.AddItem "116 - Taiko Drum"
    cboVoice.AddItem "117 - Melodic Tom"
    cboVoice.AddItem "118 - Synth Drum"
    cboVoice.AddItem "119 - Reverse Cymbal"
    cboVoice.AddItem "120 - Guitar Fret Noise"
    cboVoice.AddItem "121 - Breath Noise"
    cboVoice.AddItem "122 - Seashore"
    cboVoice.AddItem "123 - Bird Tweet"
    cboVoice.AddItem "124 - Telephone Ring"
    cboVoice.AddItem "125 - Helicopter"
    cboVoice.AddItem "126 - Applause"
    cboVoice.AddItem "127 - Gunshot"
   
    If FavDevice <> -1 Then
        cboDevice.ListIndex = FavDevice
    Else
        cboDevice.ListIndex = 0
    End If
    cboChannel.ListIndex = 0
    BassIndex(CurrChannel) = 60 '(start keyboard at middle c)
       
End Sub

Private Sub Form_Resize()
   
    If Me.WindowState <> vbMinimized Then
       
        picMain.Move (Me.ScaleWidth - picMain.Width) \ 2, (Me.ScaleHeight - picMain.Height) \ 2
       
    End If
   
End Sub

Private Sub lblKey_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

   StartNote Index
   
End Sub

Private Sub lblKey_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
       
   StopNote Index
       
End Sub

Private Sub hsVolume_Change()
   
    MIDIVolume(CurrChannel) = hsVolume.Value    
   
End Sub


Private Sub cboVoice_Click()
   
    Dim msg As Long
    Dim T As Long
   
    MIDIVoice(CurrChannel) = cboVoice.ListIndex
       
    msg = (MIDIVoice(CurrChannel) * 256) + &HC0 + CurrChannel
       
    T = midiOutShortMsg(MIDIHwnd, msg)
   
End Sub

'Enjoy
'See 'ya
'Foyal

Author

Commented:
Foyal,
It could be a few days before I get my head around this one...the code you have produced is certainly a far cry from the simple beep that I was after - however, I am delighted at the possibilities that this hints at.  Thank you very much.  I could hardly have expected a more detailed solution.  I hope I have the nouse to get it to work!!!
I'll let you know when I've got it working...
Starrman
Commented:
This one is on us!
(Get your first solution completely free - no credit card required)
UNLOCK SOLUTION
Foyal,

for this solution you either need a sound card or a driver for the PC speaker.

Unless I'm mistaken ??

Smegg.

Commented:
You have to have a sound card. Unless you build your own computer (which isn't cost effective anymore), I don't think you can get one that doesn't have a sound card anymore. So that shouldn't be a problem.

Commented:
There are tons more stuff you can do with the midi messages. In fact, I believe you can write a full tilt software controller that can do about everything in the general midi specs. The code I sent you isn't finished by any means. But it will create various sounds on all the available channels and allow you to select from the devices on your system.
Sorry, I was being dim.. I thought the initial question specified using the PC speaker....

my mistake !!!

Smg :p

Author

Commented:
Foyal,
I have finally got round to trying your code and although I don't pretend to understand exactly what it's doing it is working fine- I can definately use your solution to solve my problem.  In fact, there is so much more than I asked for that many new possibilities have opened...
I have had a few problems, some of the controls referenced in the code are not in your description of the form - no problem - but I can't seem to make the balance work and I have no idea what 'shpKeySelected(Index)' refers to or 'picmain' (resize event).  Seems to work quite happily if commented out...sorry if my lack of understanding is a bit painful but the details of the code are eluding my full understanding...
Many thanks, doubltless this beginning will open up a new stream of questions from me at some point.  Hope your around to help me with them!!

starrman

Commented:
Thanks...;>)

Gain unlimited access to on-demand training courses with an Experts Exchange subscription.

Get Access
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Empower Your Career
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE

Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Unlock the solution to this question.
Join our community and discover your potential

Experts Exchange is the only place where you can interact directly with leading experts in the technology field. Become a member today and access the collective knowledge of thousands of technology experts.

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.