Библиотеку взял здесь http://openmidiproject.osdn.jp/index_en.html
Писать на API лениво
Код: Выделить всё
PROGRAM
MAP
MODULE('MIDIIOd.dll')
MIDIOut_Open(*CSTRING pszDeviceName),LONG,C,RAW,NAME('MIDIOut_OpenA')
MIDIOut_PutMIDIMessage(LONG pMIDIOut, *CSTRING pMessage, LONG lLen),LONG,C,RAW,NAME('MIDIOut_PutMIDIMessage')
MIDIOut_Close(LONG pMIDIOut),C,RAW,NAME('MIDIOut_Close')
END
MODULE('')
Sleep(LONG),PASCAL
END
END
ITEMIZE(60)
CNote EQUATE
CdNote EQUATE
DNote EQUATE
DdNote EQUATE
ENote EQUATE
FNote EQUATE
FdNote EQUATE
GNote EQUATE
GdNote EQUATE
ANote EQUATE
AdNote EQUATE
BNote EQUATE
END
MidiClass CLASS,TYPE
MIDIOut LONG
Construct PROCEDURE
Destruct PROCEDURE
PutMessage PROCEDURE(STRING Msg),LONG,PROC
Wait PROCEDURE(LONG mSec)
SimplePlay PROCEDURE(LONG Note, LONG mSec=500)
END
Midi MidiClass
CODE
Midi.SimplePlay(FdNote)
Midi.SimplePlay(CdNote)
Midi.SimplePlay(FdNote)
Midi.SimplePlay(FdNote)
Midi.SimplePlay(CdNote)
Midi.SimplePlay(FdNote)
Midi.SimplePlay(ANote)
Midi.SimplePlay(GNote)
MidiClass.Construct PROCEDURE
cstr CSTRING(100)
CODE
cstr = 'Microsoft GS Wavetable Synth'
SELF.MIDIOut = MIDIOut_Open(cstr)
IF SELF.MIDIOut = 0
MESSAGE('Error on open: ' & cstr)
END
MidiClass.Destruct PROCEDURE
CODE
IF SELF.MIDIOut
MIDIOut_Close(SELF.MIDIOut)
END
MidiClass.PutMessage PROCEDURE(STRING Msg)!,LONG,PROC
cstr &CSTRING
ret LONG
CODE
cstr &= NEW CSTRING(LEN(Msg)+1)
cstr = Msg
ret = MIDIOut_PutMIDIMessage(SELF.MIDIOut, cstr, LEN(cstr))
DISPOSE(cstr)
RETURN ret
MidiClass.Wait PROCEDURE(LONG mSec)
CODE
Sleep(mSec)
MidiClass.SimplePlay PROCEDURE(LONG Note, LONG mSec=500)
CODE
Midi.PutMessage('<90h>'&CHR(Note)&'<64h>')
SELF.Wait(mSec)
Midi.PutMessage('<90h>'&CHR(Note)&'<00h>')