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

Forum AtoutFox : Re: 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, 15h06

janflorijn
Pays-Bas Pays-Bas

atoutfox.public.association

Re: midi message out winmm.dll a externe usb midi device

Bonjour,

Ici une progamme a lister midi devices:

*list_midi_devices.prg
Close All
Clear All
DO declare

LOCAL nCount, nIndex, nBufsize, cBuffer

nCount = midiOutGetNumDevs()
FOR nIndex=0 TO nCount-1
  nBufsize = 1024
  cBuffer = REPLICATE(CHR(0), nBufsize)

  IF midiOutGetDevCaps(nIndex, @cBuffer, nBufsize) = 0
    LOCAL oMidiOutCaps As MIDIOUTCAPS
    oMidiOutCaps = CREATEOBJECT("MIDIOUTCAPS",@cBuffer)
    MESSAGEBOX("Index: "+STR(nIndex)+CHR(13)+"wMid: "+STR(oMidiOutCaps.wMid)+CHR(13)+;
  "wPid: "+STR(oMidiOutCaps.wPid)+CHR(13)+;
  "Driver Version: "+STR(oMidiOutCaps.vDriverVersion)+CHR(13)+;
  "Naam: "+oMidiOutCaps.szPname+CHR(13)+;
  "Technologie: "+STR(oMidiOutCaps.wTechnology)+CHR(13)+;
  "Voices: "+STR(oMidiOutCaps.wVoices)+CHR(13)+;
  "Notes: "+STR(oMidiOutCaps.wNotes)+CHR(13)+;
  "Channel Mask: "+STR(oMidiOutCaps.wChannelMask)+CHR(13)+;
  "dwSupport: "+STR(oMidiOutCaps.dwSupport)+CHR(13),0)

  ENDIF
NEXT
* end of main
WAIT "Don't forget to press [ESC] in order to exit." WINDOW NOWAIT NOCLEAR
On Key Label ESC Do CLOSEOUT

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 MIDIOUTCAPS As Session
#DEFINE MAXPNAMELEN 32
  wMid=0
  wPid=0
  vDriverVersion=0
  szPname=""
  wTechnology=0
  wVoices=0
  wNotes=0
  wChannelMask=0
  dwSupport=0

PROCEDURE Init(cBuffer)
  THIS.wMid = buf2word(SUBSTR(cBuffer, 1, 2))
  THIS.wPid = buf2word(SUBSTR(cBuffer, 3, 2))
  THIS.vDriverVersion = buf2dword(SUBSTR(cBuffer, 5, 4))

  THIS.szPname = SUBSTR(cBuffer, 9, MAXPNAMELEN) + CHR(0)
  THIS.szPname = SUBSTR(THIS.szPname, 1, AT(CHR(0),THIS.szPname)-1)

  THIS.wTechnology = buf2word(SUBSTR(cBuffer, MAXPNAMELEN+9, 2))
  THIS.wVoices = buf2word(SUBSTR(cBuffer, MAXPNAMELEN+11, 2))
  THIS.wNotes = buf2word(SUBSTR(cBuffer, MAXPNAMELEN+13, 2))
  THIS.wChannelMask = buf2word(SUBSTR(cBuffer, MAXPNAMELEN+15, 2))
  THIS.dwSupport = buf2dword(SUBSTR(cBuffer, MAXPNAMELEN+17, 4))

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

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 midiOutGetDevCaps IN Winmm;
    INTEGER uDeviceID, STRING @lpMidiOutCaps,;
    INTEGER cbMidiOutCaps

  DECLARE INTEGER midiOutShortMsg IN Winmm;
    INTEGER hmo, LONG dwMsg
RETURN


Permalink : http://www.atoutfox.org/nntp.asp?ID=0000019590
20 087 messages dans le forum • Liste complète des messages

Publicité

Les pubs en cours :


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