Solved: Sounding notes in VB6

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

starrman

ASKER

smegghead (nice handle!),

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

Starrman

Foyal

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

starrman

ASKER

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

Foyal

Let me dig through my stuff. I'll get back to you soon.

smegghead

You could install the driver for the PC speaker, then use it as if it was a soundcard.. sending midi messages to it..

Foyal

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

See 'ya this evening
Foyal

starrman

ASKER

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

starrman

ASKER

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

Foyal

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

Foyal

'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

starrman

ASKER

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

smegghead

Foyal,

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

Unless I'm mistaken ??

Smegg.

Foyal

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.

Foyal

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.

smegghead

Sorry, I was being dim.. I thought the initial question specified using the PC speaker....

my mistake !!!

Smg :p

starrman

ASKER

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

Foyal

Thanks...;>)