Midi Monitor
Midi Monitor
I would like to write a small Midi monitor which displays the notes being passed through Midi in realtime. Does anyone have a code sample that would get me started in the right direction?
Griz:
Here is a simple code to read and play on MIDI channel 0.
When the program is running, play on your MIDI keyboard.
Hope this helps to get started.
Regards
Einander
Here is a simple code to read and play on MIDI channel 0.
When the program is running, play on your MIDI keyboard.
Hope this helps to get started.
Code: Select all
;MIDI IN & OUT
;By Einander - 27 Nov -2003
;************************************************
;Only works with a MIDI Keyboard attached
;************************************************
Global Chromatic$
Chromatic$="C C#D EbE F F#G AbA BbB C "
Procedure.s MIDI_Note(Note) ; returns note's name
ProcedureReturn Mid(Chromatic$,(Note % 12)*2+1,2)
EndProcedure
Procedure MIDIin(hMi, wMsg, 0, Data1, Data2)
Select wMsg ; process MIDI in events
Case #MM_MIM_DATA
Status = Data1 & 255
If Status =144
NT=(Data1 >> 8) & 255
Vel= (Data1 >> 16) & 255
If Vel
Debug "Note On"
Else
Debug "Note Off"
EndIf
Debug " Note : "+MIDI_note(nt)+" "+Str(nt)
Debug " Vel : " + Str(Vel)
EndIf
EndSelect
EndProcedure
;_______________________________________________________________________________________
Instrument=24 ;************* choose any instrument from 0 to 127 **************
OutDev.L : InDev.L
PokeL(@OutDev, 0) : PokeL(@InDev, 1)
If MIDIInOpen_(@hMi, InDev, @MIDIin(), 0, #CALLBACK_FUNCTION) = #MMSYSERR_NOERROR
If MIDIInStart_(hMi) <> #MMSYSERR_NOERROR : MessageRequester("Error","Can't start MIDI IN",0) :End: EndIf
Else
MessageRequester("Error","Can't open MIDI IN",0) : End
EndIf
MIDIOutOpen_(@hMo, OutDev, 0, 0, 0)
MidiOutShortMsg_(hMo, 192 | instrument<<8 )
If hMi And hMo
If MIDIConnect_(hMi, hMo, 0) = 0
Debug "MIDI OK! Play MIDI KEYBOARD"
Else
MessageRequester("Error","Can't connect MIDI",0) :End:
EndIf
EndIf
OpenWindow(0, x,y,600,400, #WS_OVERLAPPEDWINDOW | #PB_Window_WindowCentered, "PB MIDI Test")
Repeat
EventID.l = WaitWindowEvent()
Until EventID = #PB_EventCloseWindow
MIDIDisconnect_(hMi, hMo, 0)
While MIDIInClose_(hMi) = #MIDIERR_STILLPLAYING : Wend
While MIDIOutClose_(hMo) = #MIDIERR_STILLPLAYING : Wend
EndEinander
Thank you for the great code einander! It's a very nice start and I appreciate it.
When I play on my midi keyboard, the notes/velocities appear in your program. However, when I play a Midi file they do not. My intention was to be able to "watch" midi events playing in realtime. For example, to make a music staff with notes representing the current midi channel data being played. Your program does this - but only from my midi keyboard. Any ideas on accomplishing this when I play a Midi file on my computer? Even when I tell Windows to use my Midi keyboard for midi output, I do not see the notes/events appearing in your program (unless I press the keys myself).
I guess what I'm saying is ... can we bypass "Only works with a MIDI Keyboard attached" somehow?
When I play on my midi keyboard, the notes/velocities appear in your program. However, when I play a Midi file they do not. My intention was to be able to "watch" midi events playing in realtime. For example, to make a music staff with notes representing the current midi channel data being played. Your program does this - but only from my midi keyboard. Any ideas on accomplishing this when I play a Midi file on my computer? Even when I tell Windows to use my Midi keyboard for midi output, I do not see the notes/events appearing in your program (unless I press the keys myself).
I guess what I'm saying is ... can we bypass "Only works with a MIDI Keyboard attached" somehow?
Griz:
This example is very short and is only for monitoring the keyboard input.
To monitoring a midifile is necessary a MIDI parser.
I'ts not too complicated to program, but you must first understand SMF, the standard MIDIfile format, to deal with Data Chunks, Headers, Variable Lenght format and other MIDIfile stuff.
Is a very interesting work; the MIDI File Spec is old but still useful.
http://ourworld.compuserve.com/homepage ... y/midi.htm
You can do a search in Google with "MIDI file parser" to found the basics, and here is a starting point:
http://www.ec.vanderbilt.edu/computermu ... urces.html
Ask if you have doubts!
Regards
Einander
This example is very short and is only for monitoring the keyboard input.
To monitoring a midifile is necessary a MIDI parser.
I'ts not too complicated to program, but you must first understand SMF, the standard MIDIfile format, to deal with Data Chunks, Headers, Variable Lenght format and other MIDIfile stuff.
Is a very interesting work; the MIDI File Spec is old but still useful.
http://ourworld.compuserve.com/homepage ... y/midi.htm
You can do a search in Google with "MIDI file parser" to found the basics, and here is a starting point:
http://www.ec.vanderbilt.edu/computermu ... urces.html
Ask if you have doubts!
Regards
Einander
PB MIDI keyboard
Play midinotes without MIDI keyboard, using the mouse and only MIDI out.
Regards
Einander
Code: Select all
; PB MIDI Keyboard - by Einander
; Edited april 19 - 2005 : changes for PB 3.93
; Added: change MIDI instruments
; Thanks Danilo for the MIDIout routines
Enumeration
#Container
#MouseOver
#Sustain
#Sound
#Close
EndEnumeration
Global _hWnd,_hMIDIout, _KBD, _Keep$, _Detach,_MX,_MY,_MK,_KeyTest
Global _xKbd, _yKbd, w_KBD, _WhiteKeyWidth, _WhiteKeyHeight, _Wid2, _Wid3, _Wid4, _Wid5, _OctaveWidth, H2
Global _Chromatic$
#DarkGray = $6E6E6E
Dim KNote.b(6)
KNote(0)=0:KNote(1)=2:KNote(2)=4 : KNote(3)=5
KNote(4)=7:KNote(5)=9:KNote(6)=11
; Choose here your sharp / flat preferences - 2 chars for each Note
_Chromatic$ = "C C#D EbE F F#G AbA BbB C " ; mixed # b
; _Chromatic$="C DbD EbE F GbG AbA BbB C " ;all flats
; _Chromatic$="C C#D D#E F F#G G#A A#B C " ;all sharps
Procedure Get(SRC, X, Y, WI, HE) ; Get source image - returns image handle
IMGdc = CreateCompatibleDC_(SRC)
hIMG = CreateImage(0, WI, HE)
SelectObject_(IMGdc, hIMG)
BitBlt_(IMGdc, 0, 0, WI, HE, SRC, X, Y, #SRCCOPY)
ProcedureReturn IMGdc
EndProcedure
Procedure Put(SRC, X, Y, DEST, MODE) ; Draws image from SRC TO DEST (DEST = GetDC_(SrcID))
BitBlt_(DEST, X, Y, w_KBD, _WhiteKeyHeight, SRC, 0, 0, MODE)
EndProcedure
Procedure.s MIDI_NT(Note) ; naming one Note
ProcedureReturn Mid(_Chromatic$, (Note % 12) * 2 + 1, 2)
EndProcedure
Procedure.s MIDI_2_Notes(Note$) ; naming multiple Notes
For i = 0 To Len(Note$) - 1
Note = PeekB(@Note$ + i)
Nt$ + Trim(Mid(_Chromatic$, (Note % 12) * 2 + 1, 2)) + Str(Note / 12) + " "
Next i
ProcedureReturn Nt$
EndProcedure
Procedure MIDI_KBD() ; returns selected MIDINote
mx = WindowMouseX() : my = WindowMouseY()
r.rect\right=w_KBD-1:r\bottom=_WhiteKeyHeight
If PtInRect_(r,mx,my)
Octave = (_MX / _WhiteKeyWidth) / 7 * 12 ; octave
Note=Octave+KNote((_MX / _WhiteKeyWidth) % 7 ) ;White Key
Side= (_MX / _Wid2)%14 ;position on the left ot right half of each white Key
If _MY>H2 Or Side=0 Or Side=5 Or Side=6 Or Side=13 : ProcedureReturn Note ; white Key
ElseIf Side=1 Or Side=3 Or Side=7 Or Side=9 Or Side=11 : ProcedureReturn Note + 1 ;left black Key
Else
ProcedureReturn Note - 1 ;right black Key
EndIf
EndIf
ProcedureReturn -1
EndProcedure
Procedure DrawKBD(Note, KeySelected) ; draw MIDI Keys
If KeySelected = #black : KeyColor = #white : Else : KeyColor = KeySelected : EndIf
Octave = Note / 12
NT = Note % 12
X = Octave * _OctaveWidth
If NT = 1 Or NT = 3 Or NT = 6 Or NT = 8 Or NT = 10
If NT > 5 : A = 1 : EndIf
X + (NT + A) * _Wid2 + 1
Box (X + _Wid3, 1, _Wid2, H2 - 3, KeySelected)
Else
Select NT
Case 0 : Box(X + 1, 0, _Wid5, H2, KeyColor)
Case 2 : X + _WhiteKeyWidth : Box(X + _Wid3, 0, _Wid4, H2, KeyColor)
Case 4 : X + _WhiteKeyWidth * 2 : Box(X + _Wid3, 0, _Wid5, H2, KeyColor)
Case 5 : X + _WhiteKeyWidth * 3 : Box(X + 1, 0, _Wid5, H2, KeyColor)
Case 7 : X + _WhiteKeyWidth * 4 : Box(X + _Wid3, 0, _Wid4, H2, KeyColor)
Case 9 : X + _WhiteKeyWidth * 5 : Box(X + _Wid3, 0, _Wid4, H2, KeyColor)
Case 11 : X + _WhiteKeyWidth * 6 : Box(X + _Wid3, 0, _Wid5, H2, KeyColor)
EndSelect
Box (X + 1, 0 + H2, _WhiteKeyWidth - 1, H2, KeyColor)
EndIf
If Note = 127 : Box(X + _Wid3, 0, _Wid5, H2, KeyColor) : EndIf
EndProcedure
Procedure SetSound(Channel, sound) ; Sound from 0 to 127
midiOutShortMsg_(_hMIDIout, $C0 | Channel | sound<< 8 )
EndProcedure
Procedure PlayNote(Channel, Note, Loudness) ; Loudness 0 = no sound
midiOutShortMsg_(_hMIDIout,$90 | Channel | Note << 8 | Loudness << 16 )
EndProcedure
Procedure AllOff() ; All Notes off - silence
For i=0 To 15
midiOutShortMsg_(_hMIDIout, $B0 | i | $7B00 )
Next
EndProcedure
Procedure.s SortString(A$)
Le = Len(A$) - 1
Dim Sort.b(Le)
For i = 0 To Le
Sort(i) = PeekB(@A$ + i)
Next
SortArray.b(Sort(), 0)
For i = 0 To Le
PokeB(@A$ + i, Sort(i))
Next
ProcedureReturn A$
EndProcedure
Procedure KeepNote(Note, Sustain)
If Note > - 1
A$ = Chr(Note)
If FindString(_Keep$, A$, 1) = 0
_Keep$ = _Keep$ + A$
EndIf
EndIf
If Len(_Keep$) > Sustain
For i = 1 To Len(_Keep$) - Sustain
PlayNote(1, Asc(Mid(_Keep$, i, 1)), 0)
Next i
_Keep$ = Right(_Keep$, Sustain)
EndIf
If Len(_Keep$)
StatusBarText(0, 1, "Sustained: " + MIDI_2_Notes(SortString(_Keep$)) + " < Ctrl > Or right MouseButton To stop sustain.")
Else
StatusBarText(0, 1, "Sustained: None")
EndIf
EndProcedure
Procedure Callback(0, Msg, wParam, lParam)
Result = #PB_ProcessPureBasicEvents
Select Msg
Case #WM_MOUSEMOVE
GetCursorPos_(p.POINT)
ScreenToClient_(_hWnd, p)
_MX=p\X : _MY=p\Y
Case #WM_LBUTTONDOWN
If _MK = 2 : _MK = 3 : Else : _MK = 1 : EndIf
Case #WM_LBUTTONUP
If _MK = 3 : _MK = 2 : Else : _MK = 0 : EndIf
Case #WM_RBUTTONDOWN
If _MK = 1 : _MK = 3 : Else : _MK = 2 : EndIf
Case #WM_RBUTTONUP
If _MK = 3 : _MK = 1 : Else : _MK = 0 : EndIf
Case #WM_KeyDOWN
_KeyTest=EventwParam()
Case #WM_PAINT
Box(0, 0, w_KBD + 1, _WhiteKeyHeight + 2, #DarkGray) ; background & space between Keys
Put(_KBD, 0, 0, GetDC_(WindowID()), #SRCCOPY) ; redraw _KBD
Case #PB_EventCloseWindow : End
EndSelect
ProcedureReturn Result
EndProcedure
; _______________________________________-
_X = GetSystemMetrics_(#SM_CXSCREEN)
_xKbd = 25 : _yKbd = 120 ; Key width it's up to screen width
_WhiteKeyWidth = (_X - 200) / 77 : _WhiteKeyWidth + (_WhiteKeyWidth & 1) ; white Key width always even
_WhiteKeyHeight = 70 ; white Key height
w_KBD = _WhiteKeyWidth * 75 ; Keyboard width
H2 = _WhiteKeyHeight / 2 ; half Key height, to find black or white Keys
_Wid2 = _WhiteKeyWidth / 2 ; half Key width, for black Keys
_Wid3 = _WhiteKeyWidth / 3 ; black Keys position
_Wid4 = _WhiteKeyWidth - _Wid3 * 2 + 1 ; ditto
_Wid5 = _WhiteKeyWidth - _Wid3 ; ditto
_OctaveWidth = _WhiteKeyWidth * 7 ; 7 Keys = one octave width
Sustain = 1
_hWnd = OpenWindow(0, _xKbd, _yKbd, w_KBD, _WhiteKeyHeight + 42, #PB_Window_SystemMenu, " PB MIDI Keyboard 0.01")
Dim Sound.s(127)
Restore Sounds
For i=0 To 127
Read Sound(i)
Next
CreateGadgetList(_hWnd)
ContainerGadget(#Container, 4, WindowHeight() - 40, WindowWidth()-200, 20 )
CheckBoxGadget(#MouseOver, 60, 0, 200, 18, "Mouse Over")
ButtonGadget (#Close,300,2,80,18,"Close")
SpinGadget (#Sound,400,2,140,18,0,127)
SetGadgetState(#MouseOver, 0)
SpinGadget(#Sustain, 2, 0, 30, 18, 0, 12)
SetGadgetState(#Sustain, Sustain)
SetGadgetText(#Sustain, Str(Sustain))
SetGadgetText(#Sound,"Sound "+Str(sound+1)+" "+Sound(0)+" ")
CloseGadgetList()
WinDC = GetDC_(_hWnd)
SetWindowPos_(_hWnd, #hWnd_TOPMOST, 0, 0, 0, 0, #SWP_NOMOVE | #SWP_NOSIZE) ; always on top
CreateStatusBar(0, _hWnd) ; selected Note info
AddStatusBarField(WindowWidth()/3)
AddStatusBarField(WindowWidth()/2)
StartDrawing(WindowOutput())
Box(0, 0, w_KBD + 1, _WhiteKeyHeight + 2, #DarkGray) ; background & space between Keys
MouseOver = 0
Loudness = 120 ; choose from 0 To 127 : Loudness 0 = no sound
For i = 0 To 127 ; draw full MIDIKeyboard
DrawKBD(i, #black)
Next i
_KBD = Get(WinDC, 0, 0, w_KBD, _WhiteKeyHeight) ; get MIDIKeyboard image
If midiOutOpen_(@_hMIDIout, 0, 0, 0, 0) = #MMSYSERR_NOERROR
SetWindowCallback(@Callback())
LastNote=-2
Repeat
Ev = WaitWindowEvent()
Note = MIDI_KBD()
If Ev = #PB_Event_Gadget
Select EventGadgetID()
Case #Sustain
Sustain = GetGadgetState(#Sustain)
SetGadgetText(#Sustain, Str(Sustain))
KeepNote(-1, Sustain)
WindowEvent() ; avoid endless event-loops
Case #Sound
sound=GetGadgetState(#Sound)
SetGadgetText(#Sound,"Sound "+Str(sound+1)+" "+Sound(sound)+" ")
SetSound(1, sound) ; many sound cards have sounds only from 0 to 108
Case #MouseOver
MouseOver = Abs(MouseOver - 1) ; switch 1/0
SetGadgetState(#MouseOver, MouseOver)
Case #Close : Break
EndSelect
EndIf
If _MK=2 Or GetAsyncKeyState_(#VK_LCONTROL) = -$7FFF
AllOff() : _Keep$ = "" : StatusBarText(0, 1, "")
KeepNote(-1, 0)
ElseIf GetAsyncKeyState_(#VK_MENU) = -$7FFF ; ALT Key
MouseOver = Abs(MouseOver - 1) ; switch 1 / 0
SetGadgetState(#MouseOver, MouseOver)
EndIf
If Note < 0 ; no selected Key
StatusBarText(0, 0, "")
Else
If _MK=1
If Note<>LastNote
PlayNote(1, Note, 0)
PlayNote(1, Note, Loudness)
KeepNote(Note, Sustain)
EndIf
LastNote=Note
Else
LastNote=-2
EndIf
If Note + 1 <> _Detach ; +1 because NT= 0 is a legal MIDInote
StatusBarText(0, 0, MIDI_NT(Note) + Str(Note / 12) + " : MIDI Note " + Str(Note))
If _Detach
DrawKBD(_Detach - 1, #black)
If GetGadgetState(#Sustain) = 0 : PlayNote(1, _Detach - 1, 0) : EndIf
EndIf
If MouseOver = 1
PlayNote(1, Note, Loudness) : KeepNote(Note, Sustain)
EndIf
DrawKBD(Note, #red)
EndIf
_Detach = Note + 1
EndIf
Until Ev = #PB_Event_CloseWindow
midiOutClose_(_hMIDIout)
Else
MessageRequester("ERROR", "No MIDI device found", 0)
EndIf
CloseWindow(0)
End
DataSection
Sounds:
Data.s "Piano 1", "Piano 2","Piano 3","Honky-tonk","E.Piano 1","E.Piano 2","Harpsichord","Clavinet"
Data.s "Celesta","Glockenspiel", "Music Box","Vibraphone","Marimba","Xylophone","Tubular bell","Dulcimer"
Data.s "Organ 1","Organ 2","Organ 3","Church org. 1","Reed Organ","French Accordion","Harmonica","Bandoneon"
Data.s "Nylon-str Gt","Steel-str Gt","Jazz Gt","Clean Gt","Muted Gt","Overdrive Gt","Distortion Gt","Gt. Harmonics"
Data.s "Acoustic Bass","Fingered Basss","Picked Bass","Fretless Bass","Slap Bass 1","Slap Bass 2","Synth Bass 1","Synth Bass 2"
Data.s "Violin","Viola","Cello","Contrabass","Tremolo Strings","Pizzicato","Harp","Timpani"
Data.s "Strings","Slow Strings","Syn Strings 1","Syn Strings 2"," Choir Aahs","Voice Oohs","SynVox","Orchestra Hit"
Data.s "Trumpet","Trombone","Tuba","Muted Trumpet","French Horn","Brass 1","Synth Brass 1","Synth Brass 2"
Data.s "Soprano Sax","Alto Sax","Tenor Sax","Baritone Sax","Oboe","English Horn","Basson","Clarinet"
Data.s "Piccolo","Flute","Recorder","Pan Flute","Bottle Blow","Shakuhachi","Whistle","Ocarina"
Data.s "Square Wave","Saw Wave","Syn. Calliope","Chiffer Lead","Charang","Solo Vox","5th Saw Wave","Bass&Lead"
Data.s "Fantasia","Warm Pad","PolySynth","Space Voice","Bowed Glass","Metal Pad","Halo Pad","Sweep Pad"
Data.s "Ice Rain","sound Track","Crystal","Atmosphere","Brightness","Goblin","Echo Drops","Star Theme"
Data.s "Sitar","Banjo","Shamisen","Koto","Kalimba","Bag Pipe","Fiddle","Shanai"
Data.s "Tinkle bell","Agogo","Steel Drums","Woodblock","Taiko","Melo Tom 1","Synth Drum","Reverse Cymb"
Data.s "Gt. FretNoise","Breath Noise","Seashore","Bird","Telephone 1","Helicopter","Applause","Gun Shot"
EndDataSection
Einander
Last edited by einander on Tue Apr 19, 2005 11:37 am, edited 2 times in total.
That's a nice Midi keyboard einander, it works great for me. I had to add mod() and even() procedures to get it running :
Perhaps you might combine your two programs so you have a virtual midi keyboard that is both midi in and out? I suppose if I sent a midi song to my real midi keyboard and then sent it's midi out data to my computer ... your program would show the events no?
Thanks!
Code: Select all
Procedure Mod(a,b)
If b = 0: b = 1:EndIf
ProcedureReturn a-a/b*b
EndProcedure
Procedure Even(num)
Protected n.f
n.f=num : n=n/2
If num/2=n
ProcedureReturn 1
Else
ProcedureReturn 0
EndIf
EndProcedure
Thanks!
Griz:
Is posible to combine both programs.
1) send the events from the outside one by one, MIDI in reads and MIDI out plays them when it's received.
2) send the whole song as a MIDIfile, a MIDI parser reads each event and send it to MIDIout keeping track of time.
In both cases, this program can show the events.
Regards
Einander
Is posible to combine both programs.
Yes. You have 2 posibilities:I suppose if I sent a midi song to my real midi keyboard and then sent it's midi out data to my computer ... your program would show the events no?
1) send the events from the outside one by one, MIDI in reads and MIDI out plays them when it's received.
2) send the whole song as a MIDIfile, a MIDI parser reads each event and send it to MIDIout keeping track of time.
In both cases, this program can show the events.
Regards
Einander
midi requester
hi there, i'm a pure beginner, and tried your progs out, on several computers. the small one by einander showed me the message "error, no midi", the one by nicthequick showed me a wait window... i tried it both on
win2k and 98. is it written for xp only?
many thanx
moby
win2k and 98. is it written for xp only?
many thanx
moby
MIDI keyboard for PB 4.00
Code: Select all
; PB MIDI Keyboard - by Einander
;Translated for PB 4.00
;Edited: Added PC Keyboard input
; To Do: disable Keyboard Repeat Rate; Assign keyboard layouts for another instruments
Enumeration
#Container
#MouseOver
#Sustain
#Instrument
#ShutUp
#Quit
#Img
#ImGad
EndEnumeration
Global _Drawing,_hMIDIout, _KBD, _Keep$, _Detach,_MX,_MY,_MK,_KeyTest
Global _xKbd, _yKbd, w_KBD, _WhiteKeyWidth, _WhiteKeyHeight, _Wid2, _Wid3, _Wid4, _Wid5, _OctaveWidth, H2
Global _Chromatic$
#Gleam =$AF8F8F
Global Dim KNote.b(6)
KNote(0)=0:KNote(1)=2:KNote(2)=4 : KNote(3)=5
KNote(4)=7:KNote(5)=9:KNote(6)=11
; Choose here your sharp / flat preferences - 2 chars for each Note
_Chromatic$ = "C C#D EbE F F#G AbA BbB C " ; mixed # b
; _Chromatic$="C DbD EbE F GbG AbA BbB C " ;all flats
; _Chromatic$="C C#D D#E F F#G G#A A#B C " ;all sharps
Macro StopDraw ;- StopDraw
If _Drawing:StopDrawing():_Drawing=0:EndIf
EndMacro
Macro DraWIN(win=0) ;-DraWIN(Win=0)
StopDraw
_Drawing=StartDrawing(WindowOutput(win))
EndMacro
Macro DrawIMG(ImgNum) ;- DrawIMG(ImgNum)
StopDraw
_Drawing=StartDrawing(ImageOutput(ImgNum))
EndMacro
Macro MIDI_NT(Note) ; naming one Note
Mid(_Chromatic$, (Note % 12) * 2 + 1, 2)
EndMacro
Procedure.s MIDI_2_Notes(Note$) ; naming multiple Notes
For i = 0 To Len(Note$) - 1
Note = PeekB(@Note$ + i)
Nt$ + Trim(Mid(_Chromatic$, (Note % 12) * 2 + 1, 2)) + Str(Note / 12) + " "
Next i
ProcedureReturn Nt$
EndProcedure
Procedure GetNote() ; returns selected MIDINote
R.RECT\right=w_KBD-1:R\bottom=_WhiteKeyHeight
If PtInRect_(R,_MX,_MY)
Octave = (_MX / _WhiteKeyWidth) / 7 * 12 ; octave
Note=Octave+KNote((_MX / _WhiteKeyWidth) % 7 ) ;White Key
Side= (_MX / _Wid2)%14 ;position on the left ot right half of each white Key
If _MY>H2 Or Side=0 Or Side=5 Or Side=6 Or Side=13 : ProcedureReturn Note ; white Key
ElseIf Side=1 Or Side=3 Or Side=7 Or Side=9 Or Side=11 : ProcedureReturn Note + 1 ;left black Key
Else
ProcedureReturn Note - 1 ;right black Key
EndIf
EndIf
ProcedureReturn -1
EndProcedure
Procedure DrawKBD(NT, KeySelected) ; draw MIDI Keys
If NT < 128
DrawIMG(#Img)
If KeySelected = #Black : KeyColor = #White : Else : KeyColor = KeySelected : EndIf
Octave = NT / 12
NT % 12
x = Octave * _OctaveWidth
If NT = 1 Or NT = 3 Or NT = 6 Or NT = 8 Or NT = 10 ; black keys
If NT > 5 : A = 1 : EndIf
x + (NT + A) * _Wid2 + 1
Box (x + _Wid3-1, 1,_Wid2, H2-1 , #Gleam)
Box (x + _Wid3, 2, _Wid2-2, H2 - 4, KeySelected)
Else ; white keys
Select NT
Case 0 : Box(x + 1, 0, _Wid5, H2, KeyColor)
Case 2 : x + _WhiteKeyWidth : Box(x + _Wid3, 0, _Wid4, H2, KeyColor)
Case 4 : x + _WhiteKeyWidth * 2 : Box(x + _Wid3, 0, _Wid5, H2, KeyColor)
Case 5 : x + _WhiteKeyWidth * 3 : Box(x + 1, 0, _Wid5, H2, KeyColor)
Case 7 : x + _WhiteKeyWidth * 4 : Box(x + _Wid3, 0, _Wid4, H2, KeyColor)
Case 9 : x + _WhiteKeyWidth * 5 : Box(x + _Wid3, 0, _Wid4, H2, KeyColor)
Case 11 : x + _WhiteKeyWidth * 6 : Box(x + _Wid3, 0, _Wid5, H2, KeyColor)
EndSelect
Box (x + 1, 0 + H2, _WhiteKeyWidth - 1, H2, KeyColor)
EndIf
If NT = 127 : Box(x + _Wid3, 0, _Wid5, H2, KeyColor) : EndIf
DraWIN()
SetGadgetState(#ImGad,ImageID(#Img))
EndIf
EndProcedure
Macro SetInstrument(Channel, Instrument) ;- SetInstrument - from 0 to 127
MidiOutShortMsg_(_hMIDIout, $C0 | Channel | Instrument<< 8 )
EndMacro
Macro PlayNote(Channel, Note, Loudness) ;- PlayNote - Loudness 0 = no sound
MidiOutShortMsg_(_hMIDIout,$90 | Channel | Note << 8 | Loudness << 16 )
EndMacro
Macro AllOff ;- AllOff - All Notes off - silence
For i=0 To 15
MidiOutShortMsg_(_hMIDIout, $B0 | i | $7B00 )
Next
EndMacro
Procedure.s SortString(A$)
LE = Len(A$) - 1
Dim Sort.b(LE)
For i = 0 To LE
Sort(i) = PeekB(@A$ + i)
Next
SortArray.b(Sort(), 0)
For i = 0 To LE
PokeB(@A$ + i, Sort(i))
Next
ProcedureReturn A$
EndProcedure
Procedure KeepNote(Note, Sustain)
If Note > - 1
A$ = Chr(Note)
If FindString(_Keep$, A$, 1) = 0
_Keep$ + A$
EndIf
EndIf
If Len(_Keep$) > Sustain
For i = 1 To Len(_Keep$) - Sustain
PlayNote(1, Asc(Mid(_Keep$, i, 1)), 0)
Next i
_Keep$ = Right(_Keep$, Sustain)
EndIf
If Len(_Keep$)
StatusBarText(0, 1, "Sustained: " + MIDI_2_Notes(SortString(_Keep$)) + " < Ctrl > Or right MouseButton To stop sound.")
Else
StatusBarText(0, 1, "Sustained: None")
EndIf
EndProcedure
; _______________________________________-
_X = GetSystemMetrics_(#SM_CXSCREEN)
_xKbd = 25 : _yKbd = 120 ; Key width it's up to screen width
_WhiteKeyWidth = (_X - 200) / 77 : _WhiteKeyWidth + (_WhiteKeyWidth & 1) ; white Key width always even
_WhiteKeyHeight = 70 ; white Key height
w_KBD = _WhiteKeyWidth * 75 ; Keyboard width
H2 = _WhiteKeyHeight / 2 ; half Key height, to find black or white Keys
_Wid2 = _WhiteKeyWidth / 2 ; half Key width, for black Keys
_Wid3 = _WhiteKeyWidth / 3 ; black Keys position
_Wid4 = _WhiteKeyWidth - _Wid3 * 2 + 1 ; ditto
_Wid5 = _WhiteKeyWidth - _Wid3 ; ditto
_OctaveWidth = _WhiteKeyWidth * 7 ; 7 Keys = one octave width
Sustain = 1
hwnd = OpenWindow(0, _xKbd, _yKbd, w_KBD, _WhiteKeyHeight + 42, " PB MIDI Keyboard ", #PB_Window_SystemMenu)
StickyWindow(0,1)
Dim Instrument.s(127)
Restore GeneralMidiInstruments
For i=0 To 127
Read Instrument(i)
Next
Instrument=88
CreateGadgetList(hwnd)
CreateImage(#Img,WindowWidth(0),WindowHeight(0)-40)
ImageGadget(#ImGad,0,0,0,0,ImageID(#Img))
ContainerGadget(#Container, 10, WindowHeight(0) - 40, WindowWidth(0)-200, 20 )
TextGadget(#PB_Any,10,2,50,20,"Sustain")
SpinGadget(#Sustain, 50, 2, 30, 18, 0, 12)
CheckBoxGadget(#MouseOver, 120, 2, 80, 18, "Mouse Over")
SetGadgetState(#MouseOver, 0)
ButtonGadget (#ShutUp,230,2,80,18,"Stop Sound")
SpinGadget (#Instrument,400,2,140,18,0,127)
SetGadgetText(#Instrument,LSet(Str(Instrument+1)+" : "+Instrument(Instrument),40))
SetGadgetState(#Instrument,Instrument)
SetGadgetState(#Sustain, Sustain)
SetGadgetText(#Sustain, Str(Sustain) )
SetGadgetText(#Instrument,LSet(Str(Instrument+1)+" : "+Instrument(Instrument),40))
ButtonGadget (#Quit,600,2,80,18,"Quit")
CloseGadgetList()
GadgetToolTip(#MouseOver,"Alt Key to switch")
GadgetToolTip(#ShutUp,"Ctrl Key to stop Sound")
GadgetToolTip(#Sustain,"Simultaneous sounding notes")
GadgetToolTip(#Instrument,"128 General Midi Instruments")
CreateStatusBar(0, hwnd) ; selected Note info
AddStatusBarField(WindowWidth(0)/3)
AddStatusBarField(WindowWidth(0)/2)
Loudness = 120 ; choose from 0 To 127 : Loudness 0 = no sound
DrawIMG(#Img)
Box(0, 0, w_KBD + 1, _WhiteKeyHeight + 2,$673D06) ; background & space between Keys
For i = 0 To 127 ; draw each key - full MIDIKeyboard
DrawKBD(i, #Black)
Next i
If MidiOutOpen_(@_hMIDIout, 0, 0, 0, 0) = #MMSYSERR_NOERROR
LastNote=-2
SetInstrument(1, Instrument) ; many sound cards have Instruments only from 0 to 108, so some keys may be muted
Repeat
EV = WaitWindowEvent()
_MX=WindowMouseX(0)
_MY=WindowMouseY(0)
_MK=Abs(GetAsyncKeyState_(#VK_LBUTTON) +GetAsyncKeyState_(#VK_RBUTTON)*2+GetAsyncKeyState_(#VK_MBUTTON)*3)/$8000
If EV = #PB_Event_Gadget
Select EventGadget()
Case #Sustain
Sustain = GetGadgetState(#Sustain)
SetGadgetText(#Sustain, Str(Sustain))
KeepNote(-1, Sustain)
WindowEvent() ; avoid endless event-loops
Case #Instrument
Instrument=GetGadgetState(#Instrument)
SetGadgetText(#Instrument,LSet(Str(Instrument+1)+" : "+Instrument(Instrument),40))
SetInstrument(1, Instrument) ; many sound cards have Instruments only from 0 to 108, so some keys may be muted
Case #ShutUp :AllOff
Case #MouseOver
MouseOver= Abs(MouseOver - 1) ; switch 1/0
SetGadgetState(#MouseOver, MouseOver)
Case #Quit : Break
EndSelect
ElseIf EV= #WM_KEYDOWN Or EV=#WM_KEYUP
If _Keep$
AllOff
_Keep$=""
EndIf
SetWindowTitle(0,_Keep$)
If EV=#WM_KEYDOWN
vol=Loudness
RGB=#Green
Else
RGB=#Black
vol=0
EndIf
Select EventwParam()
Case 27:End
; PC Keyboard config ; assign Midinotes to each Key
Case 226 : NT=48 ; C ;row zxcv...
Case 90 : NT=50 ; D
Case 88 : NT=52 ;E
Case 67 : NT=53 ;F
Case 86 : NT=55 ;G
Case 66 : NT=57 ;A
Case 78 : NT=59 ;B
Case 77 : NT=60 ;C
Case 188 : NT=62 ;D
Case 190 : NT=64 ;E
Case 189 : NT=65 ;F
Case 16 : : NT=67 ;G
Case 65 : NT=49 ;C# ;row asdf...
Case 83 : NT=51 ;D#
Case 68 : NT=53 ;F
Case 70 : NT=54 ;F#
Case 71 : NT=56 ;G#
Case 72 : NT=58 ;A#
Case 74 : NT=60 ;C
Case 75 : NT=61 ;C#
Case 76 : NT=63 ;D#
Case 192 : NT=65 ;F
;Case 222 : NT=65 ; deadkey
Case 81 : NT=67 ;G ;row qwert...
Case 87 : NT=69 ;A
Case 69 : NT=71 ;B
Case 82 : NT=72 ;C
Case 84 : NT=74 ;D
Case 89 : NT=76 ;E
Case 85 : NT=77 ;F
Case 73 : NT=79 ;G
Case 79 : NT=81 ;A
Case 80 : NT=83 ;B
Case 186 : NT=84 ;C
;Case 187 : NT=85 ; deadkey , 2 hits to sound
Case 49 : NT=66 ;F# ;row 1234...
Case 50 : NT=68 ;G#
Case 51 : NT=70 ;A#
Case 52 : NT=72 ;C
Case 53 : NT=73 ;C#
Case 54 : NT=75 ;D#
Case 55 : NT=77 ;F
Case 56 : NT=78 ;F#
Case 57 : NT=80 ;G#
Case 48 : NT=82 ;A#
Case 219 : NT=84 ;C
Case 221 : NT=85 ;C#
EndSelect
PlayNote(1,NT,vol)
DrawKBD(NT,RGB)
If vol
StatusBarText(0, 1, "Key "+Str(EventwParam())+" - MidiNote : "+Str(NT))
Else
StatusBarText(0, 1, "")
EndIf
EndIf
If _MK=2 Or GetAsyncKeyState_(#VK_LCONTROL) = -$7FFF
AllOff : _Keep$ = "" : StatusBarText(0, 1, "")
KeepNote(-1, 0)
ElseIf GetAsyncKeyState_(#VK_MENU) = -$7FFF ; ALT Key
MouseOver=Abs(MouseOver - 1) ; switch 1 / 0
SetGadgetState(#MouseOver, MouseOver)
EndIf
Note=GetNote()
If Note < 0 ; no selected Key
StatusBarText(0, 0, "")
Else
If _MK=1
If Note<>LastNote
PlayNote(1, Note, 0)
PlayNote(1, Note, Loudness)
KeepNote(Note, Sustain)
EndIf
LastNote=Note
Else
LastNote=-2
EndIf
If Note + 1 <> _Detach ; +1 because NT= 0 is a legal MIDInote
StatusBarText(0, 0, MIDI_NT(Note) + Str(Note / 12) + " : MIDI Note " + Str(Note))
If _Detach
DrawKBD(_Detach - 1, #Black)
If GetGadgetState(#Sustain) = 0 : PlayNote(1, _Detach - 1, 0) : EndIf
EndIf
If MouseOver = 1
PlayNote(1, Note, Loudness) : KeepNote(Note, Sustain)
EndIf
DrawKBD(Note,#Red ) ; mouse pressed note
EndIf
_Detach = Note + 1
EndIf
Until EV = #PB_Event_CloseWindow
MidiOutClose_(_hMIDIout)
Else
MessageRequester("ERROR", "No MIDI device found", 0)
EndIf
CloseWindow(0)
End
;<<<<<<<<<<<<<<<<<<<<
DataSection
GeneralMidiInstruments:
Data.s "Piano 1", "Piano 2","Piano 3","Honky-tonk","E.Piano 1","E.Piano 2","Harpsichord","Clavinet"
Data.s "Celesta","Glockenspiel", "Music Box","Vibraphone","Marimba","Xylophone","Tubular bell","Dulcimer"
Data.s "Organ 1","Organ 2","Organ 3","Church org. 1","Reed Organ","French Accordion","Harmonica","Bandoneon"
Data.s "Nylon-str Gt","Steel-str Gt","Jazz Gt","Clean Gt","Muted Gt","Overdrive Gt","Distortion Gt","Gt. Harmonics"
Data.s "Acoustic Bass","Fingered Basss","Picked Bass","Fretless Bass","Slap Bass 1","Slap Bass 2","Synth Bass 1","Synth Bass 2"
Data.s "Violin","Viola","Cello","Contrabass","Tremolo Strings","Pizzicato","Harp","Timpani"
Data.s "Strings","Slow Strings","Syn Strings 1","Syn Strings 2"," Choir Aahs","Voice Oohs","SynVox","Orchestra Hit"
Data.s "Trumpet","Trombone","Tuba","Muted Trumpet","French Horn","Brass 1","Synth Brass 1","Synth Brass 2"
Data.s "Soprano Sax","Alto Sax","Tenor Sax","Baritone Sax","Oboe","English Horn","Basson","Clarinet"
Data.s "Piccolo","Flute","Recorder","Pan Flute","Bottle Blow","Shakuhachi","Whistle","Ocarina"
Data.s "Square Wave","Saw Wave","Syn. Calliope","Chiffer Lead","Charang","Solo Vox","5th Saw Wave","Bass&Lead"
Data.s "Fantasia","Warm Pad","PolySynth","Space Voice","Bowed Glass","Metal Pad","Halo Pad","Sweep Pad"
Data.s "Ice Rain","sound Track","Crystal","Atmosphere","Brightness","Goblin","Echo Drops","Star Theme"
Data.s "Sitar","Banjo","Shamisen","Koto","Kalimba","Bag Pipe","Fiddle","Shanai"
Data.s "Tinkle bell","Agogo","Steel Drums","Woodblock","Taiko","Melo Tom 1","Synth Drum","Reverse Cymb"
Data.s "Gt. FretNoise","Breath Noise","Seashore","Bird","Telephone 1","Helicopter","Applause","Gun Shot"
EndDataSection
Last edited by einander on Sat Jul 08, 2006 9:16 am, edited 2 times in total.
midi program to output in a channel to other VST
I like this program but how do I get the keys to send to other VST programs?
