ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

Forum AtoutFox : midi message out winmm.dll a externe usb midi device   

Sujet

rss Flux RSS des derniers messages

Vous devez vous identifier pour pouvoir poser une question ou répondre.

sam. 28 mars 2020, 10h39

janflorijn
Pays-Bas Pays-Bas

atoutfox.public.association

midi message out winmm.dll a externe usb midi device

Bonjour,

L'exemple suivant fonctionne bien pour les sons intégrés. J'ai besoin d'envoyer un message à un périphérique USB-MIDI externe. Je n'ai pas besoin d'un changepatch, seulement des notes on et off, volume et vélocité.

Dans l'exemple Test, envoyez une note ici après avoir essayé quelque chose.

Comment changer ça?

Sincères amitiés,

Jan Flikweert

*play notes.prg
Close All
Clear All
oForm = Createobject("Tform")
oForm.Show(1)
WAIT "Don't forget to press [ESC] in order to exit." WINDOW NOWAIT NOCLEAR
On Key Label ESC Do CLOSEOUT
Read Events

Procedure CLOSEOUT
nFrmClose=1
For i = 1 To _Screen.FormCount
  If Type("_SCREEN.FORMS(nFrmClose)") == "O"
    _Screen.Forms(nFrmClose).Release()
  Else
    nFrmClose = nFrmClose  + 1
  Endif
Endfor
Set Sysmenu To Default
Modify Window Screen
Set Message To
Set Classlib To
Release All Extended
On Key
On Error
Clear Events
Release All
Close All
WAIT CLEAR
Return

Define Class Tform As Form
  Protected midi
  midi=Null
  Height=182
  Width=316
  AutoCenter=.T.
  Caption="Play MIDI Notes"
  MaxButton=.F.
  MinButton=.F.

  Add Object Label1 As Label With AutoSize=.T.,;
    BackStyle=0, Caption="Sound:"Height=17,;
    Left=14, Top=20, Width=31

  Add Object cmbProgram As ComboBox With Left=62,;
    Top=15, Width=120, Height=24, Style=2

  Add Object Label2 As Label With AutoSize=.T.,;
    BackStyle=0, Caption="Note (0 to 127)"Height=17,;
    Left=14, Top=62, Width=31

  Add Object txtNote As Spinner With Height=24,;
    KeyboardHighValue=127, KeyboardLowValue=0, Left=12,;
    SpinnerHighValue=127, SpinnerLowValue=0,;
    Top=86, Width=85, Value=48

  Add Object Label3 As Label With AutoSize=.T.,;
    BackStyle=0, Caption="Velocity:"Height=17,;
    Left=120, Top=62, Width=46

  Add Object txtVelocity As Spinner With Height=24,;
    KeyboardHighValue=200, KeyboardLowValue=20, Left=108,;
    SpinnerHighValue=200, SpinnerLowValue=20, Top=86,;
    Width=85, Value=100

  Add Object cmdPlay As CommandButton With Top=86,;
    Left=200, Height=27, Width=48,;
    Caption="Play"Default=.T.

  Add Object cmdStop As CommandButton With Top=86,;
    Left=250, Height=27, Width=48,;
    Caption="Stop"Default=.T.

  Add Object cmdDemo As CommandButton With Top=140,;
    Left=12, Height=27, Width=100,;
    Caption="Demo Sound"Default=.T.

  Procedure Init
  This.midi = Createobject("TMidiNote")
  Thisform.ChangePatch

  Procedure cmbProgram.Init
  Local nIndex
  For nIndex=0 To 127
    This.AddItem("Program " + Ltrim(Str(nIndex)))
  Next
  This.ListIndex=1

  Procedure cmbProgram.InteractiveChange
  Thisform.ChangePatch

  Procedure cmdDemo.Click
  Thisform.PlayDemoSound

  Procedure cmdPlay.Click
  Thisform.PlayNote

  Procedure cmdStop.Click
  Thisform.StopNote

  Procedure PlayDemoSound
  This.midi.ChangePatch(117)
  This.midi.PlayNote(54, 100)
  Sleep(150)
  This.midi.PlayNote(50, 100)
  Sleep(100)
  This.midi.PlayNote(48, 100)
  Sleep(70)
  This.midi.PlayNote(44, 100)

  DoEvents
  This.ChangePatch

  Procedure ChangePatch
  Local nProgram
  nProgram = This.cmbProgram.ListIndex-1
  This.midi.ChangePatch(m.nProgram)

  Procedure StopNote
  Local nNote
  nNote = This.txtNote.Value
  This.midi.StopNote(m.nNote)

  Procedure PlayNote
  Local nNote, nVelocity
  nNote = This.txtNote.Value
  nVelocity = This.txtVelocity.Value
  This.midi.PlayNote(nNote, nVelocity)

Enddefine

Define Class TMidiNote As Session
  #Define MIDI_STATUS_PLAYNOTE 9
  #Define MIDI_STATUS_PATCH 12
  Protected hDevice, channel
  hDevice=12
  channel=0

  Procedure Init(lDeclare)
  This.Declare
  If Not This.OpenDevice()
    Return .F.
  Endif

  Procedure Destroy
  This.CloseDevice

  Protected Function OpenDevice() As Boolean
    If midiOutGetNumDevs() = 0
      Messagebox("No Midi Devices found.",;
        48, "MIDI Error")
      Return .F.
    Endif

    Local hDevice, nResult
    hDevice=12
    nResult = midiOutOpen(@hDevice, 0,0,0,0)
    This.hDevice = m.hDevice
    If nResult <> 0
      Messagebox("Call to midiOutOpen failed: " +;
        TRANSFORM(nResult), 48, "MIDI Error")
    Endif
    Return (m.nResult=0)

  Protected Procedure CloseDevice
    If This.hDevice <> 0
      = midiOutReset(This.hDevice)
      = midiOutClose(This.hDevice)
      This.hDevice = 0
    Endif

  Procedure SendMIDICommand(b1, b2, b3, b4)
  If This.hDevice <> 0
    Local nMsg, nResult
    nMsg = This.channel + Bitlshift(m.b1,4) +;
      BITLSHIFT(m.b2,8) +;
      BITLSHIFT(m.b3,16) + Bitlshift(m.b4,24)
    nResult = midiOutShortMsg(This.hDevice, m.nMsg)
    If nResult <> 0
      Messagebox("Call to midiOutShortMsg failed: " +;
        TRANSFORM(nResult), 48, "MIDI Error")
    Endif
  Endif

  Procedure PlayNote(nNote, nVelocity)
  This.SendMIDICommand(MIDI_STATUS_PLAYNOTE,;
    nNote, nVelocity, 127)

  Procedure StopNote(nNote)
  This.SendMIDICommand(MIDI_STATUS_PLAYNOTE,;
    m.nNote, 0, 0)

  Procedure ChangePatch(nPatchNo)
  This.SendMIDICommand(MIDI_STATUS_PATCH,;
    nPatchNo, 0, 0)

  Procedure Declare
  Declare Integer midiOutGetNumDevs In Winmm
  Declare Integer midiOutClose In Winmm Integer hmo
  Declare Integer midiOutReset In Winmm Integer hmo
  Declare Sleep In kernel32 Integer dwMilliseconds

  Declare Integer midiOutOpen In Winmm;
    INTEGER @lphmo, Integer uDeviceID, Integer dwCallback,;
    INTEGER dwCallbackInstance, Integer dwFlags

  Declare Integer midiOutShortMsg In Winmm;
    INTEGER hmo, Long dwMsg
  Return

Define Class MIDIOUTCAPS As Session
  #Define MAXPNAMELEN 32
  wMid=0
  wPid=0
  vDriverVersion=0
  szPname=""
  wTechnology=0
  wVoices=0
  wNotes=0
  wChannelMask=0
  dwSupport=0


Enddefine
Function buf2dword(cBuffer)
Return Asc(Substr(cBuffer, 1,1)) + ;
  BitLShift(Asc(Substr(cBuffer, 2,1)),  8) +;
  BitLShift(Asc(Substr(cBuffer, 3,1)), 16) +;
  BitLShift(Asc(Substr(cBuffer, 4,1)), 24)

Function buf2word(lcBuffer)
Return Asc(Substr(lcBuffer, 1,1)) + ;
  Asc(Substr(lcBuffer, 2,1)) * 256


*Test send note
*Command button method click
Local nMsg, nResult
Do Declare
#DEFINE MIDI_STATUS_PLAYNOTE 9
#DEFINE MIDI_STATUS_PATCH 12
#DEFINE CALLBACK_NULL 0
PUBLIC result AS LONG,HMIDIOUT AS LONG ,outHandle AS LONG, inHandle AS LONG, hDevice AS Long
hDevice=11
*!*  outHandle =11
*!*  nResult = midiOutOpen(@outHandle, 0, 0, 0, CALLBACK_NULL)
*!*  If nResult <> 0
*!*    Messagebox("Call to midiOutOpen failed: " +;
*!*      TRANSFORM(nResult), 48, "MIDI Error")
*!*  Endif
nMsg = 1 + Bitlshift(9,4) +;
  BITLSHIFT(36,8) +;
  BITLSHIFT(100,16) + Bitlshift(100,24)
nResult = midiOutShortMsg(@hDevice, nMsg)
MESSAGEBOX("De boodschap:"+STR(nMsg),0)
sleep(150)
If nResult <> 0
  Messagebox("Noot spelen mislukt: " +;
    TRANSFORM(nResult), 48, "MIDI Error")
Endif
nMsg = 1 + Bitlshift(9,4) +;
  BITLSHIFT(36,8) +;
  BITLSHIFT(0,16) + Bitlshift(0,24)
nResult = midiOutShortMsg(@hDevice, nMsg)
If nResult <> 0
  Messagebox("Noot uit zetten mislukt: " +;
    TRANSFORM(nResult), 48, "MIDI Error")
Endif
sleep(150)
IF hDevice <> 0
  = midiOutReset(hDevice)
  = midiOutClose(hDevice)
  hDevice = 0
ENDIF


Permalink : http://www.atoutfox.org/nntp.asp?ID=0000019587
19 660 messages dans le forum • Liste complète des messages

www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2020.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0-SP2-HF3