Forum AtoutFox : Re: VFP Midi in translation from VB code   

• Derniers messages
• Informations

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

jeu. 24 mars 2022, 12h06

janflorijn
Pays-Bas
atoutfox.public.association

Re: VFP Midi in translation from VB code

Bonjour,

Merci beaucoup à Chris Miller, il m'a donné une solution à ce problème. Vous pouvez voir le code ci-dessous :
******** Code provided by Chris Miller********************
#DEFINE MIM_DATA 963
#DEFINE MIM_MOREDATA 972
#DEFINE MM_MIM_DATA 963
#DEFINE MM_MIM_MOREDATA 972
#DEFINE MIDI_IO_STATUS 32
#DEFINE CALLBACK_WINDOW 65536
#DEFINE GWL_WNDPROC -4

ptrCallback=_Screen.hwnd
goMessageHandler = CreateObject("screenevents")
BINDEVENT(_Screen.hwnd, MIM_DATA, goMessageHandler,'HandleEvent')

nResult_midi_open = midiInOpen(@hDevice,nCme,ptrCallback, 0,CALLBACK_WINDOW+MIDI_IO_STATUS)

Define class screenevents as Custom
 nOldProc = 0

 function Init
 declare integer GetWindowLong in Win32API ;
 integer hWnd, integer nIndex
 declare integer CallWindowProc in Win32API ;
 integer lpPrevWndFunc, integer hWnd, integer Msg, ;
 integer wParam, integer lParam

  This.nOldProc = GetWindowLong(_screen.hWnd, GWL_WNDPROC)
 endfunc

 function HandleEvent(hWnd, Msg, wParam, lParam)
   * store the message data minus hwnd, which will be _screen.hwnd and is therefore constant.
         PUBLIC statust,dat1,dat2
      statust=STR(BITAND(lParam,255))
      dat1=STR(BITRSHIFT(BITAND(lParam,65280),8))
      dat2=STR(BITRSHIFT(BITAND(lParam,16711680),16))
      BEGIN TRANSACTION
      SELECT ymt
      APPEND BLANK IN ymt
      REPLACE stts WITH statust IN ymt
      REPLACE dt1 WITH dat1 IN ymt
      REPLACE dt2 WITH dat2 IN ymt
      END TRANSACTION
   return CallWindowProc(This.nOldProc, hWnd, Msg, wParam, lParam)
 endfunc
Enddefine


Salutions,

Jan Flikweert

Permalink : http://www.atoutfox.org/nntp.asp?ID=0000019961