oForm = CREATEOBJECT("Tform")
oForm.Show(1)
* end of main
 
DEFINE CLASS Tform AS form
PROTECTED midi
    midi=NULL
    Height=182
    Width=316
    AutoCenter=.T.
    Caption="Play MIDI Notes"
    MaxButton=.F.
    MinButton=.F.
 
    ADD OBJECT Label1 AS Label WITH AutoSize=.T.,;
        BackStyle=0, Caption="Sound:", Height=17,;
        Left=14, Top=20, Width=31
 
    ADD OBJECT cmbProgram As ComboBox WITH Left=62,;
        Top=15, Width=120, Height=24, Style=2
 
    ADD OBJECT Label2 AS Label WITH AutoSize=.T.,;
        BackStyle=0, Caption="Note (0 to 127)", Height=17,;
        Left=14, Top=62, Width=31
 
    ADD OBJECT txtNote AS Spinner WITH Height=24,;
        KeyboardHighValue=127, KeyboardLowValue=0, Left=12,;
        SpinnerHighValue=127, SpinnerLowValue=0,;
        Top=86, Width=85, Value=48
 
    ADD OBJECT Label3 AS Label WITH AutoSize=.T.,;
        BackStyle=0, Caption="Velocity:", Height=17,;
        Left=120, Top=62, Width=46
 
    ADD OBJECT txtVelocity AS Spinner WITH Height=24,;
        KeyboardHighValue=200, KeyboardLowValue=20, Left=108,;
        SpinnerHighValue=200, SpinnerLowValue=20, Top=86,;
        Width=85, Value=100
 
    ADD OBJECT cmdPlay AS CommandButton WITH Top=86,;
        Left=200, Height=27, Width=48,;
        Caption="Play", Default=.T.
 
    ADD OBJECT cmdStop AS CommandButton WITH Top=86,;
        Left=250, Height=27, Width=48,;
        Caption="Stop", Default=.T.
 
    ADD OBJECT cmdDemo AS CommandButton WITH Top=140,;
        Left=12, Height=27, Width=100,;
        Caption="Demo Sound", Default=.T.
 
PROCEDURE Init
    THIS.midi = CREATEOBJECT("TMidiNote")
    ThisForm.ChangePatch
 
PROCEDURE cmbProgram.Init
    LOCAL nIndex
    FOR nIndex=0 TO 127
        THIS.AddItem("Program " + LTRIM(STR(nIndex)))
    NEXT
    THIS.ListIndex=1
 
PROCEDURE cmbProgram.InteractiveChange
    ThisForm.ChangePatch
 
PROCEDURE cmdDemo.Click
    ThisForm.PlayDemoSound
 
PROCEDURE cmdPlay.Click
    ThisForm.PlayNote
 
PROCEDURE cmdStop.Click
    ThisForm.StopNote
 
PROCEDURE PlayDemoSound
    THIS.midi.ChangePatch(117)
    THIS.midi.PlayNote(54, 100)
    Sleep(150)
    THIS.midi.PlayNote(50, 100)
    Sleep(100)
    THIS.midi.PlayNote(48, 100)
    Sleep(70)
    THIS.midi.PlayNote(44, 100)
 
    DOEVENTS
    THIS.ChangePatch
 
PROCEDURE ChangePatch
    LOCAL nProgram
    nProgram = THIS.cmbProgram.ListIndex-1
    THIS.midi.ChangePatch(m.nProgram)
 
PROCEDURE StopNote
    LOCAL nNote
    nNote = THIS.txtNote.Value
    THIS.midi.StopNote(m.nNote)
 
PROCEDURE PlayNote
    LOCAL nNote, nVelocity
    nNote = THIS.txtNote.Value
    nVelocity = THIS.txtVelocity.Value
    THIS.midi.PlayNote(nNote, nVelocity)
 
ENDDEFINE
 
DEFINE CLASS TMidiNote As Session
#DEFINE MIDI_STATUS_PLAYNOTE 9
#DEFINE MIDI_STATUS_PATCH 12
PROTECTED hDevice, channel
    hDevice=0
    channel=0
 
PROCEDURE Init(lDeclare)
    THIS.declare
    IF NOT THIS.OpenDevice()
        RETURN .F.
    ENDIF
 
PROCEDURE Destroy
    THIS.CloseDevice
 
PROTECTED FUNCTION OpenDevice() As Boolean
    IF midiOutGetNumDevs() = 0
        MESSAGEBOX("No Midi Devices found.",;
            48, "MIDI Error")
        RETURN .F.
    ENDIF
 
    LOCAL hDevice, nResult
    hDevice=0
    nResult = midiOutOpen(@hDevice, 0,0,0,0)
    THIS.hDevice = m.hDevice
    IF nResult <> 0
        MESSAGEBOX("Call to midiOutOpen failed: " +;
            TRANSFORM(nResult), 48, "MIDI Error")
    ENDIF
RETURN (m.nResult=0)
 
PROTECTED PROCEDURE CloseDevice
    IF THIS.hDevice <> 0
        = midiOutReset(THIS.hDevice)
        = midiOutClose(THIS.hDevice)
        THIS.hDevice = 0
    ENDIF
 
PROCEDURE SendMIDICommand(b1, b2, b3, b4)
    IF THIS.hDevice <> 0
        LOCAL nMsg, nResult
        nMsg = THIS.channel + BITLSHIFT(m.b1,4) +;
            BITLSHIFT(m.b2,8) +;
            BITLSHIFT(m.b3,16) + BITLSHIFT(m.b4,24)
 
        nResult = midiOutShortMsg(THIS.hDevice, m.nMsg)
        IF nResult <> 0
            MESSAGEBOX("Call to midiOutShortMsg failed: " +;
                TRANSFORM(nResult), 48, "MIDI Error")
        ENDIF
    ENDIF
 
PROCEDURE PlayNote(nNote, nVelocity)
    THIS.SendMIDICommand(MIDI_STATUS_PLAYNOTE,;
        nNote, nVelocity, 0)
 
PROCEDURE StopNote(nNote)
    THIS.SendMIDICommand(MIDI_STATUS_PLAYNOTE,;
        m.nNote, 0, 0)
 
PROCEDURE ChangePatch(nPatchNo)
    THIS.SendMIDICommand(MIDI_STATUS_PATCH,;
        nPatchNo, 0, 0)
 
PROCEDURE declare
    DECLARE INTEGER midiOutGetNumDevs IN Winmm
    DECLARE INTEGER midiOutClose IN Winmm INTEGER hmo  
    DECLARE INTEGER midiOutReset IN Winmm INTEGER hmo  
    DECLARE Sleep IN kernel32 INTEGER dwMilliseconds
 
    DECLARE INTEGER midiOutOpen IN Winmm;
        INTEGER @lphmo, INTEGER uDeviceID, INTEGER dwCallback,;
        INTEGER dwCallbackInstance, INTEGER dwFlags
 
    DECLARE INTEGER midiOutShortMsg IN Winmm;
        INTEGER hmo, LONG dwMsg    
 
ENDDEFINE