PureBasic Forums - English

Posted: **Wed Nov 26, 2003 4:40 pm**

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?

Posted: **Thu Nov 27, 2003 2:13 am**

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.

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
End

Regards
Einander

Posted: **Thu Nov 27, 2003 4:50 pm**

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?

Posted: **Thu Nov 27, 2003 6:26 pm**

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

Posted: **Thu Nov 27, 2003 10:33 pm**

einander wrote:Griz:
Here is a simple code to read and play on MIDI channel 0.
When the program is running, play on your MIDI keyboard.

Very nice, but i dont have MIDI keyboard.

There is no way to do the same with the PC keyboard?

Posted: **Fri Nov 28, 2003 1:07 am**

Ricardo:
This program reads MIDI input; if you want to play midi notes with the PC keyboard, it's enough with MIDI output.

I'll try to make some example, and share it here.

Regards
Einander

Posted: **Fri Nov 28, 2003 2:02 am**

Play midinotes without MIDI keyboard, using the mouse and only MIDI out.

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

Regards
Einander

Posted: **Fri Nov 28, 2003 8:13 am**

That's a nice Midi keyboard einander, it works great for me. I had to add mod() and even() procedures to get it running :

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

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!

Posted: **Fri Nov 28, 2003 12:55 pm**

Griz:
Is posible to combine both programs.

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?

Yes. You have 2 posibilities:

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

Posted: **Sat Aug 28, 2004 6:17 am**

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

Posted: **Fri May 12, 2006 4:44 pm**

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

Posted: **Thu Jul 06, 2006 10:23 am**

I like this program but how do I get the keys to send to other VST programs?

Posted: **Thu Jul 06, 2006 12:04 pm**

einander, thank you. This is a fun little program. I am hoping someone may make a keyboard map for this so I can practice like a piano.

This is fun!

Posted: **Thu Jul 06, 2006 1:13 pm**

very nice

Posted: **Thu Jul 06, 2006 7:32 pm**

Thanks!
I'm doing the PC keyboard map, but i'm stuck with the keyboard repeat rate.
Any hint to disable it programmatically?

PureBasic Forums - English

Midi Monitor

Midi Monitor

PB MIDI keyboard

midi requester

MIDI keyboard for PB 4.00

midi program to output in a channel to other VST