PureBasic Forums - English

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