Страница 1 из 1

Midi

Добавлено: 15 Июль 2017, 14:11
Admin
Я бы сказал... от нефиг делать.
Библиотеку взял здесь 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>')
  
Midi.zip
(153.55 КБ) 199 скачиваний