Winmm Midiin translate from VB to VFP 2

[Jan Flikweert]

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?

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 Sub

And here the VFP 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
RETURN

Kind regards,

Jan Flikweert

 

[Chris Miller]

I changed you name to loopMIDI port and I still get the error.

I never heard of pragma warnings from the VFP compiler. Are you perhaps using "VFP 10"?

Chriss

 

[Jan Flikweert]

Chriss,

I changed you name to loopMIDI port and I still get the error

I suppose there are 2 issues.

One: The program used on your system does not return DataByte1+DataByte2 on the VFP screen after pressing a key in VMPK. Even after changing the name in loopMIDI port. The strange thing is this code works here fine. So, I suppose in order to get it working again for you is: "search the difference between us". Is loopMIDI running?

Two: Starting returns messages 4+5.

After pressing ALT+F4 the program does not close and the midi ports are not closed. Restarting result in messages 4+5.
Restarting VFP will solve this. This is, because after pressing ALT+F4 the program keeps hanging in the next "read events".
"Cancelling" the program from the VFP main menu [program]+[cancel] does not execute the code after READ EVENTS.

I reported the pragma warning on GITHUB to VFP2C32. I suppose it is a known coding issue.

Kind regards,


Jan Flikweert

 

[Chris Miller]

returns messages 4+5.
Well, they are 0 when I restart VFP and use the normal callback type.

So that's clear, no problem.

And yes, loopMIDI is running, otherwise there would be no device "loopMIDI Port" and I already see that in VMPK configuration, if it's not there I can't configure it as MIDI out so it gets to midi monitor or the VFP code. All works fine with the VB midi monitor, still.

Don't scratch your head, it works for you.

Chriss