! MIDI音源を利用して単音を出す

DECLARE EXTERNAL FUNCTION midiOpen
DECLARE EXTERNAL FUNCTION midiMsg
DECLARE EXTERNAL FUNCTION midiClose
DECLARE EXTERNAL FUNCTION midiGet

OPTION CHARACTER byte ! 文字サイズを１バイトにする
LET hmid$=REPEAT$("*",4) ! 四バイト分用意

SET WINDOW 0,100,0,100
SET TEXT font "MS ゴシック",38
PLOT TEXT ,AT 10,70:"音色番号"

DIM W$(2)
LET W$(1)="  音色変更"
LET W$(2)="  終了"

LET Note=64       !音階(&H00から&H7F(127))
LET Inst=54       !楽器No(ＧＭ音色番号に準拠？）
LET Vol=BVAL("7F",16)    !音量(&H00から&H7F(127))

IF midiGet<1 THEN STOP ! MIDIデバイスがなければ終了
LET n=midiOpen(hMid$, -1, 0, 0, 0)

! 文字列を数値に変換
LET hMidiOut=0
LET k=1
FOR i=1 TO 4
   LET hMidiOut = hMidiOut + k*ORD(hMid$(i:i))
   LET k = k*256
NEXT i

DO
   LET Q$=STR$(Inst)
   SET TEXT background "OPAQUE"
   SET TEXT font "MS ゴシック",80
   PLOT TEXT ,AT 20,50:Q$
    
   LET n=midiMsg(hMidiOut, BVAL("c0",16) + Inst * 256)
    
   LET n=midiMsg(hMidiOut, BVAL("90",16) + (Note+7)* 256 + Vol * 256 * 256)
   WAIT DELAY 0.6
   LET n=midiMsg(hMidiOut, BVAL("90",16) + (Note+7) * 256 + Vol * 0)
   WAIT DELAY 0.4
    
   LET n=midiMsg(hMidiOut, BVAL("90",16) + (Note+9) * 256 + Vol * 256 * 256)
   WAIT DELAY 0.6
   LET n=midiMsg(hMidiOut, BVAL("90",16) + (Note+9) * 256 + Vol * 0)
   WAIT DELAY 0.4  
    
   LET n=midiMsg(hMidiOut, BVAL("90",16) + (Note+12) * 256 + Vol * 256 * 256)
   WAIT DELAY 0.6
   LET n=midiMsg(hMidiOut, BVAL("90",16) + (Note+12) * 256 + Vol * 0)
   WAIT DELAY 0.4
    
   LET n=midiMsg(hMidiOut, BVAL("90",16) + (Note+14) * 256 + Vol * 256 * 256)
   WAIT DELAY 0.6
   LET n=midiMsg(hMidiOut, BVAL("90",16) + (Note+14) * 256 + Vol * 0)
   WAIT DELAY 0.4
    
   LET n=midiMsg(hMidiOut, BVAL("90",16) + (Note+16) * 256 + Vol * 256 * 256)
   WAIT DELAY 0.6
   LET n=midiMsg(hMidiOut, BVAL("90",16) + (Note+16) * 256 + Vol * 0)
   WAIT DELAY 0.4
    
   LET n=midiMsg(hMidiOut, BVAL("90",16) + (Note+14) * 256 + Vol * 256 * 256)
   WAIT DELAY 0.6
   LET n=midiMsg(hMidiOut, BVAL("90",16) + (Note+14) * 256 + Vol * 0)
   WAIT DELAY 0.4
    
   LET n=midiMsg(hMidiOut, BVAL("90",16) + (Note+9) * 256 + Vol * 256 * 256)
   WAIT DELAY 0.6
   LET n=midiMsg(hMidiOut, BVAL("90",16) + (Note+9) * 256 + Vol * 0)
   WAIT DELAY 0.4
    
   LET n=midiMsg(hMidiOut, BVAL("90",16) + (Note+12) * 256 + Vol * 256 * 256)
   WAIT DELAY 2
   LET n=midiMsg(hMidiOut, BVAL("90",16) + (Note+12) * 256 + Vol * 0)
   
   LOCATE CHOICE(W$):k
   IF k=1 THEN GOTO 10
   IF k=2 THEN EXIT DO
10    LET Inst = Inst - 1
   LOOP
   LET n=midiMsg(hMidiOut, BVAL("80",16) + Note * 256)
   LET n=midiClose(hMidiOut)
END

EXTERNAL FUNCTION midiOpen(lphMidiOut$,uDeviceID,dwCallback,dwInstance,dwFlags)
   ASSIGN "winmm.dll","midiOutOpen"
END FUNCTION

EXTERNAL FUNCTION midiMsg(hMid,Dt)
   ASSIGN "winmm.dll","midiOutShortMsg"
END FUNCTION

EXTERNAL FUNCTION midiClose(hMid)
   ASSIGN "winmm.dll","midiOutClose"
END FUNCTION 

EXTERNAL FUNCTION midiGet
   ASSIGN "winmm.dll","midiOutGetNumDevs"
END FUNCTION