Jan Flikweert
Programmer
Hi all,
I am working on a midiin solution using WINAPI winmm.dll. I mange to open,start and close midiinput. I do not manage to get response on midiinput messages, except that VFP crashes. Here I have the ost important parts of a VB example, hoping this will help.
I can provide the not fully working solution. For those who are interested I have a solution using MIDI-OX. The goal of my project is creating a Virtual Pipe Organ using REAPER (a digital audio workstation) and Garritan Aria audio player. Using MIDI-OX this works. Now with winmm.dll
Who can give me a help, a hint?
And here the VFP code:
Kind regards,
Jan Flikweert
I am working on a midiin solution using WINAPI winmm.dll. I mange to open,start and close midiinput. I do not manage to get response on midiinput messages, except that VFP crashes. Here I have the ost important parts of a VB example, hoping this will help.
I can provide the not fully working solution. For those who are interested I have a solution using MIDI-OX. The goal of my project is creating a Virtual Pipe Organ using REAPER (a digital audio workstation) and Garritan Aria audio player. Using MIDI-OX this works. Now with winmm.dll
Who can give me a help, a hint?
Code:
Public Declare Function midiInOpen Lib "winmm.dll" (ByRef hMidiIn As Integer, ByVal uDeviceID As Integer, ByVal dwCallback As MidiInCallback, ByVal dwInstance As Integer, ByVal dwFlags As Integer) As Integer
Public Delegate Function MidiInCallback(ByVal hMidiIn As Integer, ByVal wMsg As UInteger, ByVal dwInstance As Integer, ByVal dwParam1 As Integer, ByVal dwParam2 As Integer) As Integer
Public ptrCallback As New MidiInCallback(AddressOf MidiInProc)
Public Const CALLBACK_FUNCTION As Integer = &H30000
Public Const MIDI_IO_STATUS = &H20
Function MidiInProc(ByVal hMidiIn As Integer, ByVal wMsg As UInteger, ByVal dwInstance As Integer, ByVal dwParam1 As Integer, ByVal dwParam2 As Integer) As Integer
If MonitorActive = True Then
TextBox1.Invoke(New DisplayDataDelegate(AddressOf DisplayData), New Object() {dwParam1})
End If
End Function
Private Sub ComboBox1_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles ComboBox1.SelectedIndexChanged
ComboBox1.Enabled = False
Dim DeviceID As Integer = ComboBox1.SelectedIndex
midiInOpen(hMidiIn, DeviceID, ptrCallback, 0, CALLBACK_FUNCTION Or MIDI_IO_STATUS)
midiInStart(hMidiIn)
MonitorActive = True
Button2.Text = "Stop monitor"
End SubAnd here the VFP code:
Code:
CLOSE ALL
CLEAR ALL
#DEFINE MAXPNAMELEN 32
#DEFINE MIDI_STATUS_PLAYNOTE 9
#DEFINE MIDI_STATUS_PATCH 12
#DEFINE CALLBACK_NULL 0
#DEFINE CALLBACK_FUNCTION 0x30000 && dwCallback is a FARPROC
#DEFINE CALLBACK_NULL 0x0 && no callback
#DEFINE CALLBACK_TASK 0x20000 && dwCallback is a HTASK
#DEFINE CALLBACK_TYPEMASK 0x70000 && callback type mask
#DEFINE CALLBACK_WINDOW 0x10000 && dwCallback is a HWND
#DEFINE MIM_CLOSE 962
#DEFINE MIM_OPEN 961
#DEFINE MIM_DATA 963
#DEFINE MIM_MOREDATA 972
#DEFINE MIM_LONGDATA 964
#DEFINE MIDI_IO_STATUS 32
#DEFINE MIDI_ERROR 965
#DEFINE MIDI_LONGERROR 966
#DEFINE MMSYSERR_ERROR 1
#DEFINE MMSYSERR_BADDEVICEID 2
#DEFINE MMSYSERR_NOTENABLED 3
#DEFINE MMSYSERR_ALLOCATED 4
#DEFINE MMSYSERR_INVALHANDLE 5
#DEFINE MMSYSERR_NODRIVER 6
#DEFINE MMSYSERR_NOMEM 7
#DEFINE MMSYSERR_NOTSUPPORTED 8
#DEFINE MMSYSERR_BADERRNUM 9
#DEFINE MMSYSERR_INVALFLAG 10
#DEFINE MMSYSERR_INVALPARAM 11
#DEFINE MMSYSERR_HANDLEBUSY 12
#DEFINE MMSYSERR_INVALIDALIAS 13
#DEFINE MMSYSERR_BADDB 14
#DEFINE MMSYSERR_KEYNOTFOUND 15
#DEFINE MMSYSERR_READERROR 16
#DEFINE MMSYSERR_WRITEERROR 17
#DEFINE MMSYSERR_DELETEERROR 18
#DEFINE MMSYSERR_VALNOTFOUND 19
#DEFINE MMSYSERR_NODRIVERCB 20
#DEFINE MMSYSERR_BASE 0
PUBLIC result AS LONG,HMIDIOUT AS LONG ,outHandle AS LONG, inHandle AS LONG, hDevice AS Long,Vrsltn,Hrsltn
Vrsltn=Sysmetric(2)
Hrsltn=Sysmetric(1)
_SCREEN.WIDTH=SYSMETRIC(1)
_SCREEN.HEIGHT=SYSMETRIC(2)
#INCLUDE vfp2c.h
SET LIBRARY TO vfp2c32.fll ADDITIVE
DO declare
*PUBLIC nloopmidia,nCME
PUBLIC Cmeout
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)
DO CASE
CASE oMidiOutCaps.szPname=="CME U2MIDI" && Please replace with your midi input device
nCmeout=nIndex+1
ENDCASE
ENDIF
NEXT
PUBLIC nCmein, HDMIIN
nCount = midiInGetNumDevs()
FOR nIndex=0 TO nCount-1
nBufsize = 1024
cBuffer = REPLICATE(CHR(0), nBufsize)
IF midiInGetDevCaps(nIndex, @cBuffer, nBufsize) = 0
LOCAL oMidiInCaps As MIDIINCAPS
oMidiInCaps = CREATEOBJECT("MIDIINCAPS",@cBuffer)
DO CASE
CASE oMidiInCaps.szPname=="CME U2MIDI"
nCmein=nIndex+1
ENDCASE
ENDIF
NEXT
PUBLIC loCallback,dwInstance,ptrCallback
PUBLIC iMsg,lParam1,lParam2
dwInstance=0
loCallBack = CREATEOBJECT('cls_callback')
ptrCallback=loCallBack.Address
nResult1 = midiInOpen(@hDevice,0, ptrCallback, 0, CALLBACK_FUNCTION + MIDI_IO_STATUS )
MESSAGEBOX("Midi In Open: "+STR(nResult1))
nResult2 = midiInStart(hDevice)
MESSAGEBOX("Midi In Start:"+STR(nResult2))
nResult2 = midiInStart(hDevice)
*!* test=.t.
*!* DO WHILE test=.t.
*!* ON KEY test=.f.
*!* sleep(10)
*!* ENDDO
READ EVENTS
MidiInStop(hDevice)
MidiInReset(hDevice)
midiInClose(hDevice)
loCallBack.Destroy
CLEAR EVENTS
*DEFINE CLASS cls_callback AS Exception
DEFINE CLASS cls_callback AS Session
Address = 0
Datasession=2
FUNCTION Init
THIS.Address = CreateCallbackFunc('Test_Callback_function','VOID','INTEGER,INTEGER,INTEGER,INTEGER,INTEGER',THIS)
ENDFUNC
FUNCTION Destroy
IF THIS.Address != 0
DestroyCallbackFunc(THIS.Address)
ENDIF
ENDFUNC
FUNCTION Test_Callback_function(hDevice,iMsg,dwInstance,lParam1,lParam2)
DO CASE
CASE hDevice>0
_VFP.AutoYield = .F.
MESSAGEBOX(STR(hDevice))
_VFP.AutoYield = .T.
CASE lParam1>0
_VFP.AutoYield = .F.
MESSAGEBOX(STR(lParam1))
_VFP.AutoYield = .T.
CASE lParam2>0
_VFP.AutoYield = .F.
MESSAGEBOX(STR(lParam2))
_VFP.AutoYield = .T.
CASE iMsg=MIM_DATA
_VFP.AutoYield = .F.
MESSAGEBOX("Data: De callback functie werd gebruikt voor data input."+CHR(13)+STR(lParam1))
_VFP.AutoYield = .T.
CASE iMsg=MIM_OPEN
_VFP.AutoYield = .F.
MESSAGEBOX("Open: De callback functie werd gebruikt voor open input.")
_VFP.AutoYield = .T.
CASE iMsg=MIM_CLOSE
_VFP.AutoYield = .F.
MESSAGEBOX("Open: De callback functie werd gebruikt voor close input.")
_VFP.AutoYield = .T.
CASE iMsg=MIM_MOREDATA
_VFP.AutoYield = .F.
MESSAGEBOX("More: De callback functie werd gebruikt voor more input."+CHR(13)+STR(lParam1))
_VFP.AutoYield = .F.
CASE iMsg= MIM_LONGDATA
_VFP.AutoYield = .F.
MESSAGEBOX("Data: De callback functie werd gebruikt voor long data input."+CHR(13)+STR(lParam1))
_VFP.AutoYield = .T.
CASE iMsg= MIDI_ERROR
_VFP.AutoYield = .F.
MESSAGEBOX("Error")
_VFP.AutoYield = .T.
CASE iMsg= MIDI_LONGERROR
_VFP.AutoYield = .F.
MESSAGEBOX("Error")
_VFP.AutoYield = .T.
OTHERWISE
_VFP.AutoYield = .F.
MESSAGEBOX("Other: "+STR(lParam1))
_VFP.AutoYield = .T.
ENDCASE
ENDFUNC
ENDDEFINE
DEFINE CLASS MIDIINCAPS 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 midiInStart In Winmm integer hmi
Declare INTEGER midiInStop In Winmm integer hmi
Declare Integer midiOutGetNumDevs In Winmm
Declare INTEGER midiInGetNumDevs In Winmm
Declare Integer midiOutClose In Winmm Integer hmo
Declare INTEGER midiInClose In Winmm Integer hmi
Declare Integer midiOutReset In Winmm Integer hmo
Declare INTEGER midiInReset In Winmm integer hmi
Declare Sleep In kernel32 Integer dwMilliseconds
DECLARE INTEGER midiOutGetDevCaps IN Winmm;
INTEGER uDeviceID, STRING @lpMidiOutCaps,;
INTEGER cbMidiOutCaps
Declare INTEGER midiInGetDevCaps In Winmm;
INTEGER uDeviceID, STRING @lpMidiInCaps,;
INTEGER cbMidiInCaps
Declare Integer midiOutOpen In Winmm;
INTEGER @lphmo, Integer uDeviceID, Integer dwCallback,;
INTEGER dwCallbackInstance, Integer dwFlags
Declare INTEGER midiInOpen In Winmm;
INTEGER @hDevice, INTEGER nDevice,;
INTEGER ptrCallback , INTEGER dwInstance, INTEGER dwFlags
Declare Integer midiOutShortMsg In Winmm;
INTEGER hmo, Long dwMsg
Declare INTEGER midiInMessage In Winmm;
INTEGER hmi, Long midiInMsg , Integer para1 , integer para2
RETURNKind regards,
Jan Flikweert
