PB MIDI Clavier

einander · Message par **einander** » ven. 07/juil./2006 8:09

; PB MIDI Clavier  - par Einander   
; PB 4.00 
; Entrée de clavier supplémentaire de PC  
; Pour faire : neutraliser le taux de répétition de clavier ; Assigner les dispositions de clavier pour des autres 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

;Choisir ici votre préférences - 2 caractères pour chaque 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 = 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 ; assigner Midinotes à chaque clef 
            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

[/code]

Backup · Message par **Backup** » ven. 07/juil./2006 8:59

pas mal du tout ce petit clavier !

un peux lent, mais c'est pas mal

Flype · Message par **Flype** » sam. 08/juil./2006 10:07

le clavier d'einander qui va avec le source ci dessus :

SPH · Message par **SPH** » mar. 11/juil./2006 3:11

J'ai essayé d'extraire de tout ce code la partie la plus basique pour jouer un son mais je n'y suis pâs arrivé. Quelqu'un a t'il cela sous la main ??

Backup · Message par **Backup** » mar. 11/juil./2006 9:18

SPH a écrit :J'ai essayé d'extraire de tout ce code la partie la plus basique pour jouer un son mais je n'y suis pâs arrivé. Quelqu'un a t'il cela sous la main ??

Franchement tu m'epate toi !

t'es capable de donner des cours d'assembleur, et tu bloque sur des truc tout simple !!

einander · Message par **einander** » mar. 11/juil./2006 12:57

Salut SPH. Essai ceci:

Code : Tout sélectionner

Global hMO

Structure MIDIData
    By1.b
    By2.b
    By3.b
    Null.b
EndStructure
dMsg.MIDIData
dMsg\Null=0

Procedure MIDI_init() 
    midi.MIDIOUTCAPS
    devices=midiOutGetNumDevs_()
    For devnum=-1 To devices-1
        If midiOutGetDevCaps_(devnum,@midi,SizeOf(MIDIOUTCAPS))=0
            If midi\wVoices>0
                midiport=devnum
            EndIf
         EndIf
    Next 
    midiOutOpen_(@hMO,midiport,0,0,0)
EndProcedure

MIDI_init() 

Note.b=48
Vel.b=127
Channel.b=1
Instrument.b=1

dMsg\By1=$BF+Channel
dMsg\By2=Instrument
midiOutShortMsg_(hMO,PeekW(dMsg))
 
For x=1 To 30
    dMsg\By3=Vel
    dMsg\By2=Note
    dMsg\By1=$8F+Channel
    result=midiOutShortMsg_(hMO,PeekL(dMsg))
    Delay(150)
    dMsg\By1=$7F+Channel
    midiOutShortMsg_(hMO,PeekL(dMsg))
    Note+2
Next 
 
midiOutClose_(hMO)

Zorro · Message par **Zorro** » ven. 16/déc./2016 10:03

Mis en Pb 5.50 :

Code : Tout sélectionner

; PB MIDI Clavier  - par Einander   
; PB 4.00
; Entrée de clavier supplémentaire de PC 
; Pour faire : neutraliser le taux de répétition de clavier ; Assigner les dispositions de clavier pour des autres instruments
; Mis en Purebasic V 5.50 by Zorro

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

;Choisir ici votre préférences - 2 caractères pour chaque 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,_MY<<32+_MX)
    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 = 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(Sort(), #PB_Sort_Ascending)
  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 + 142, "    PB MIDI Keyboard ", #PB_Window_SystemMenu)
StickyWindow(0,1)
   
Dim Instrument.s(127)
Restore GeneralMidiInstruments
For i=0 To 127
  Read.s 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 ; assigner Midinotes à chaque clef
        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

GallyHC · Message par **GallyHC** » ven. 16/déc./2016 10:36

Bonjour,

Fonctionne aussi sur PB 5.44 LTS

, merci pour les modifications apportées.

Cordialement,
GallyHC

Micoute · Message par **Micoute** » ven. 16/déc./2016 10:42

C'est dommage que tu ne l'aies réglé pour le clavier français

TazNormand · Message par **TazNormand** » ven. 16/déc./2016 11:44

@Micoute : tu peux modifier la partie du code qui intercepte le clavier avec ceci :

Code : Tout sélectionner

    Debug EventwParam()
      Select EventwParam()
        Case 27:End
          ; PC Keyboard config ; assigner Midinotes à chaque clef
        Case 226 : NT=48     ; C     ;row zxcv...
        Case 87   : 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 192   : NT=60     ;C
        Case 188   : NT=62   ;D
        Case 190   : NT=64   ;E
        Case 189   : NT=65   ;F
        Case 16 :   : NT=67   ;G
         
        Case 81 : 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 77   : NT=65   ;F
          ;Case 222   : NT=65    ; deadkey
         
        Case 65 : NT=67       ;G  ;row qwert...
        Case 90   : 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

J'ai mis un Debug juste avant le "Select" qui permet de connaitre le "code" de la touche appuyée, et comme je n'ai pas de clavier QWERTY sous la main et que j'ai la pas le temps( et la flemme) de chercher la disposition des touches sur un clavier UK/US, je te laisse interpréter les codes lors d'appui sur les touches.

J'ai juste modifié la partie QW vers AZ et le M qui il me semble se trouve à côté du N chez les UK/US, reste les touches "exotiques" (ù*!:;) à mapper correctement pour l'AZERTY

GallyHC · Message par **GallyHC** » ven. 16/déc./2016 12:38

Bonjour,

Toujours plus simple de demander une modification que de chercher par soit même.... Déjà Zorro a fait que ce soit compatible avec les nouvelles versions de PB. Après en fonction de ce que l'on veut, on modifie a nos besoins. Même si c'est toujours mieux pour certain d'avoir que du code mâché à 100%.

Cordialement,
GallyHC

Ar-S · Message par **Ar-S** » ven. 16/déc./2016 12:43

Sympa ce clavier. Merci pour la conversion Zorro..
Notez que vous pouvez virer ligne 180 la CreateGadgetList(hwnd) qui ne sert plus à rien.

Micoute · Message par **Micoute** » ven. 16/déc./2016 13:41

Ne vous fâchez pas, il y à longtemps que je l'ai transcrite pour le clavier azerty, ce n'était qu'une petite boutade, pareil que quand j'avais dis à Ar_s que son programme ne calculait pas la section des conducteurs dans son logiciel de loi d'Ohm, juste pour jeter un froid.

PureBasic

PB MIDI Clavier

PB MIDI Clavier

Re: PB MIDI Clavier

Re: PB MIDI Clavier

Re: PB MIDI Clavier

Re: PB MIDI Clavier

Re: PB MIDI Clavier

Re: PB MIDI Clavier

Re: PB MIDI Clavier