GFMidi/GFMidimod.bas

Attribute VB_Name = "GFMidimod"
Option Explicit
'(c)2003 by Louis. Simple MIDI functions for simple results.
'Partially a hack of 'Wilksey's Guitar Chord Finding Program'
'downloaded from www.pscode.com.
'GFMidi
Private Declare Function midiOutGetNumDevs Lib "winmm" () As Integer 'not in use
Private Declare Function midiOutGetDevCaps Lib "winmm.dll" Alias "midiOutGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As MIDIOUTCAPS, ByVal uSize As Long) As Long 'not in use
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
'GFMidi
Private Const MAXPNAMELEN = 32& '"Following Defs taken from MIDI Piano"
Private Const MMSYSERR_BASE = 0&
Private Const MMSYSERR_BADDEVICEID = (MMSYSERR_BASE + 2&)
Private Const MMSYSERR_INVALPARAM = (MMSYSERR_BASE + 11&)
Private Const MMSYSERR_NODRIVER = (MMSYSERR_BASE + 6&)
Private Const MMSYSERR_NOMEM = (MMSYSERR_BASE + 7&)
Private Const MMSYSERR_INVALHANDLE = (MMSYSERR_BASE + 5&)
Private Const MIDIERR_BASE = 64&
Private Const MIDIERR_STILLPLAYING = (MIDIERR_BASE + 1&)
Private Const MIDIERR_NOTREADY = (MIDIERR_BASE + 3&)
Private Const MIDIERR_BADOPENMODE = (MIDIERR_BASE + 6&)
'GFMidi
Private Type MIDIOUTCAPS
    wMid As Integer
    wPid As Integer
    vDriverVersion As Long
    szPname As String * MAXPNAMELEN
    wTechnology As Integer
    wVoices As Integer
    wNotes As Integer
    wChannelMask As Integer
    dwSupport As Long
End Type
'GFMidi
Dim MidiHandle As Long
Dim MidiChannel As Integer
Dim MidiVolume As Integer

'***INTERFACE SUBS***

Public Sub GFMidi_Initialize(ByVal MidiVolumeDefault As Integer, ByVal MidiChannelDefault As Integer)
    'on error resume next
    'preset
    MidiVolume = MidiVolumeDefault
    MidiChannel = MidiChannelDefault
    'begin
    Call midiOutOpen(MidiHandle, ‑1, 0, 0, 0)
End Sub

Public Sub GFMidi_PlayNote(ByVal Note As Integer)
    'on error resume next
    Dim MidiMsg As Long
    MidiMsg = &H90 + (Note * &H100) + (MidiVolume * &H10000) + MidiChannel
    Call midiOutShortMsg(MidiHandle, MidiMsg)
End Sub

Public Sub GFMidi_StopNote(ByVal Note As Integer)
    'on error resume next
    Dim MidiMsg As Long
    MidiMsg = &H80 + (Note * &H100) + MidiChannel
    Call midiOutShortMsg(MidiHandle, MidiMsg)
End Sub

Public Sub GFMidi_SetInstrument(ByVal Instrument As Integer)
    'on error resume next
    Dim MidiMsg As Long
    MidiMsg = (Instrument * 256) + &HC0 + MidiChannel + (0 * 256) * 256
    Call midiOutShortMsg(MidiHandle, MidiMsg)
End Sub

Public Sub GFMidi_Terminate()
    'on error resume next
    Call midiOutClose(MidiHandle)
End Sub

'***END OF INTERFACE SUBS***


[END OF FILE]