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]

Where and how is the definition of CreateCallbackFunc?

I expect there is the usage of an FLL or DLL that provides that. In your code this is as unclear as how DestroyCallbackFunc works.

I know a few such FLLs and DLLs exist. Carlos Alloatti has one mechanism for callbacks, Clavin Hsia promoted another mechanism and then there are some I would need to dig deeper to find them, related to multithreading, most of the time.

That's the core feature VB can do without any helper and VFP needs some C++ extension that can manage it. And that's likely where your code crashes as a callback is where you get the response. It's the usual mechanism of asynchronous concepts, you send out some MIID messages and specify a callback address. But that's not a VFP thing, i.e. a function or method of a VFP object has no memory address that the CPU can jump to, it has the address of the object code that needs to be interpreted by the VFP byte code interpreter. So even when you would manage to find out say the address where an FXP is loaded into RAM, this isn't able to be a callback address. There are bytes in that memory that won't make sense as assembly code.

Extensions in the form of DLLs and FLLs create a stub code that can be used as callback address and in themselves can take in parameters and call a VFP method or function with them as parameters or by providing variables in scope to the VFP callback code as local or private variables.

Chriss

 

[Jan Flikweert]

Chriss,

Thank you for your reply. I think your explanation is clear and important.

This next two lines refer to a library which has a function which returns a pointer to a callbackfunction

#INCLUDE vfp2c.h
SET LIBRARY TO vfp2c32.fll ADDITIVE

Previous library is called by:

FUNCTION Init
		THIS.Address = CreateCallbackFunc('Test_Callback_function','VOID','INTEGER,INTEGER,INTEGER,INTEGER,INTEGER',THIS)		
	ENDFUNC

In the code

loCallBack = CREATEOBJECT('cls_callback')

an object is created from cls_clallback. This class also contains a destroy function listed here:

FUNCTION Destroy
IF THIS.Address != 0
DestroyCallbackFunc(THIS.Address)
ENDIF
ENDFUNC

And midiout everything works, the callback works for midiin open succesfull and start but just does the actual midi input.

Kind regards,


Jan Flikweert

Indeed there are a few issues. Threading and referring by address to a function. The addressing issue can be solved by vfp2c32.fll

An idea I had was creating a com dll multithreading server.

An other idea I had was define a timer class.

Kind regards,

Jan Flikweert

 

[Chris Miller]

Thanks for clarifying the use of vfp2c32.fll. That's the solution to the callback problem from Calos Alloatti, I wasn't recognizing his FLL had these functions.

So actually you should be fine, unless you're having a wrong usage of callback parameters in some cases. The Test_Callback_function, I guess that's also as defined by Carlos Alloatti. It's quite a universal routine, as its parameterization also works for windows events, so for a totally different binding mechanism than callbacks, for BINDEVENT to windows messages.

But as versatile it is to have four integer parameters, it doesn't cover any and all callback parameterizations that could be needed.

It would make things much easier, if you'd program custom methods for the different callbacks, each with the right number and type of callback parameters. Or even more to the point, this isn't only more convenient, it's absolutley necessary for cases of parameterizations that are not covered by the paremeterization of 'INTEGER,INTEGER,INTEGER,INTEGER,INTEGER'.

The callback also doesn't even have to be in the cls_callback instance, the handler can be another class, so you can have one midi response handler class with multiple callback methods or even multiple handler classes or a family of classes,whetever fits better.

Carlos Alloattis cls_callback is just one example of usage of CreateCallbackFunc, it's not the only, and you don't have to fit in all responses into the Test_Callback_function, that actually overcomplicates things as you end up with this ovwerarching complicated DO CASE statement that tries to figure out which response to handle. You have obviously done that, instead of having separate callback methods each with an individual set of parameters. You might easily fail on the parameterizations, too, which cause the crashes.

Ad all that about the callback, an error could also already be in the the parameterization of midiInOpen:

Declare INTEGER midiInOpen In Winmm;
	INTEGER @hDevice, INTEGER nDevice,;
	INTEGER ptrCallback , INTEGER dwInstance, INTEGER dwFlags

I see you put in 0 for nDevice and dwInstance, and I think that's questionable to work. You can try to put in 0 for anything you don't know what to pass in for, but at least when you have crashes, will need to consider that this is the root cause of the crashes.

Chriss

 

[Chris Miller]

One thing to relativize my comment about your parameterization of the ininital midiInOpen call. You might have that from somewhere else and simply trust it to be okay. It might also not even be the reaon for the crashes, the parameterization of the callback functions might be more important. I know cases where 0 is generally the right value to use, for example as hwnd of the Desktop as one special Window of the Windows OS. 0 might be some general midi device id. But that's where you have to dig in deeper into the midi API to know what you need to do.

Going back to the original cade there is a call:

midiInOpen(hMidiIn, DeviceID, ptrCallback, 0, CALLBACK_FUNCTION Or MIDI_IO_STATUS)

DeviceID seems to be something defined as property/field of the form this is part of. You have to look into all related VB code to know what it is, instead oof using 0 instead.

Chriss

 

[Jan Flikweert]

Hi Chris,

Thnaks for your two replies. I must studie them because they are important.

A few remarks. Here an example shipped with the library of Calos Alloatti:

		&& the C prototype for the callback function is
		&& BOOL CALLBACK EnumWindowsProc(HWND hwnd,LPARAM lParam)
		&& BOOL is clear ..
		&& CALLBACK is a preprocessor definition for "WINAPI" which in turn is a definition for "_stdcall"
		&& which specifies the calling convention of the funtion.
		&& You can just ignore this since the callback functions created by CreateCallbackFunc always use
		&& the _stdcall calling convention by design. (I've never seen a C Callback definition using another 
		&& calling convention)
		THIS.Address = CreateCallbackFunc('EnumWindowsCallback','BOOL','LONG, LONG',THIS)

The Test_Callback_function I created my own. The 5 used parameters are equal to the MidiInProc callback function of Winmm.
And this is also equal to the VB example:

    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

I am going to studie your post and replie.

Kind regards,

Jan Flikweert

 

[Jan Flikweert]

Chris,

Your remark about the 'zero' in MidiInOpen is correct. That should be the DeviceId of the MidiInput device. The effect of 'zero' is it uses the first device. The pointer to that device is stored in the first parameter: @hDevice.

The use of Do case in test_callback is a kind of trace/debug function. So I can see in which cases the callbacks works.

So I understand that the CreateCallbackFunc can be used outside a class difinition and point outside a class definition.

The strange thing is that the callback function reports MIM_OPEN, so the callback works.

Kind regards,

Jan Flikweert

 

[Jan Flikweert]

Chris,

An other point is MIDI_IO_STATUS and CALLBACK_FUNCTION.

I suppose that should be MIDI_IO_STATUS + CALLBACK_FUNCTION.

Kind regards,

Jan Flikweert

 

[Chris Miller]

That parameter signature looks very much like a windows message, not sure whether that means you could also handle all of this with BINDEVENT instead.

But try to do without MESSAGEBOXes. Because I think you have a wrong idea of what Autoyield does. You don't turn off further callbacks when you temporarily set this to .f. and when you're in a messagebox while yet another callback happend, that likely causes a crash.

Actually both things are related, as autoyield means different handling of windows messages/events, but callbacks and events are not the same. There is an overlap in that there are special callbacks for some windows messages you send via SendMessageCallback. I wonder whether that also would need a special and different handling in the vfp2c32.fll not yet foreseen.

Your callback code has to be nonblocking. Alternatively, if you only expect or accept one callback to the initial call, the first code should be the DestroyCallbackFunc() call, so further callbacks can't interrupt your handling. But then the question would be whether that crashes.

So in summary it's worth trying to do
DestroyCallbackFunc()

And while I write this another thing I wonder: Is it really valid to have the same callback address for all callbacks? It may be handled on the side of the called API function that it removes the callback after it calls it. So "closing the door" for all further callbacks, even before you do yourself.

You better get to having several callbacks for each call you make. You can still use your common code for the testing phase, but now you need multiple instances of cls_callback so each one will have its own address and enable its own destroy.

Chriss

 

[Jan Flikweert]

Chris,

It is a winapi function based on WINMM.dll.

I removed messageboxes and autoyield.

I have in the class a destroy method containg DestroyCallbackFunc, but I will check how that can be used.

Destroying and creating a new pointer will be executed from the callback function. BINDEVENT is an option to destroycallbacfunc and create a new object with new address.

I tried to create a dll. See the attached project. This causes a dll error. Probably due to 32/64 bit?

In early days I tried BINDEVENT, but it needs two events. A callbackfunction is one. I will try that again.

Here after the code from which I will continue trying above points.

Kind regards,

Jan Flikweert

#INCLUDE winmmeapi.h
* Extended Window Styles
#DEFINE WS_EX_DLGMODALFRAME    1
#DEFINE WS_EX_NOPARENTNOTIFY   4
#DEFINE WS_EX_TOPMOST          8
#DEFINE WS_EX_ACCEPTFILES     16
#DEFINE WS_EX_TRANSPARENT     32
#DEFINE WS_EX_MDICHILD        64
#DEFINE WS_EX_TOOLWINDOW     128
#DEFINE WS_EX_WINDOWEDGE     256
#DEFINE WS_EX_CLIENTEDGE     512
#DEFINE WS_EX_CONTEXTHELP   1024

#DEFINE WS_EX_CONTROLPARENT 0x10000
#DEFINE WS_EX_STATICEDGE  0x20000
#DEFINE WS_EX_APPWINDOW  0x40000

#DEFINE SW_NORMAL  1
#DEFINE WS_OVERLAPPED 0
#DEFINE WS_CAPTION  0xC00000
#DEFINE WS_SYSMENU  0x80000
#DEFINE WS_THICKFRAME  0x40000
#DEFINE WS_MINIMIZEBOX  0x20000
#DEFINE WS_MAXIMIZEBOX  0x10000

#DEFINE MAXPNAMELEN 32
#DEFINE MIDI_STATUS_PLAYNOTE 9
#DEFINE MIDI_STATUS_PATCH 12
#DEFINE CALLBACK_NULL 0
#DEFINE  CALLBACK_FUNCTION    196608        &&  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_ALLOCATED 4
#DEFINE MMSYSERR_INVALHANDLE 5
#DEFINE MHDR_DONE  1
#DEFINE MHDR_PREPARED  2
#DEFINE MHDR_INQUEUE  4
#DEFINE MHDR_ISSTRM  8
DO declare
PUBLIC nCme

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" && Please replace with your midi in device
			nCme=nIndex
		ENDCASE
	ENDIF
NEXT
#INCLUDE vfp2c.h
SET LIBRARY TO vfp2c32.fll ADDITIVE && Library with callback funtion
PUBLIC loCallback AS object, nDevice AS integer,hDevice AS INTEGER,ptrCallback,nResult_midi AS INTEGER
PUBLIC statusbyte AS Long,DataByte1 AS LONG,DataByte2 AS LONG,MonitorActive AS Logical,HideMidiSysMessages AS Logical,dwInstance,uMsg
ptrCallback= CreateCallbackFunc('MidiInProc','INTEGER','INTEGER,UINTEGER,INTEGER,INTEGER,INTEGER',NULL)
nDevice=nCme
hDevice=nDevice
dwInstance=0
nResult_midi_open = midiInOpen(@hDevice,nDevice,ptrCallback, dwInstance,CALLBACK_FUNCTION+MIDI_IO_STATUS)
MESSAGEBOX("Result open midi in: "+STR(nResult_midi_open))  &&Returns at startup "0".
nResult_midi_start = midiInStart(hDevice)
MESSAGEBOX("Result midi in start: "+STR(nResult_midi_start)) &&Returns at startup: "0".
testkeypress=.t.
DO WHILE testkeypress=.t.
	ON KEY testkeypress=.f.
	sleep(1)
ENDDO

*READ EVENTS
nResult_midi_in_stop = midiInStop(hDevice)
MESSAGEBOX("Midi in stop result:"+STR(nResult_midi_in_stop ))
nResult_midi_in_close = midiInClose(hDevice)
MESSAGEBOX("Midi in close result:"+STR(nResult_midi_in_close ))
*------------------------------------[Do some cleanup]
SET SYSMENU TO DEFAULT
CLEAR EVENTS
RELEASE ALL EXTENDED
ON KEY
ON ERROR
RELEASE ALL
CLOSE ALL

FUNCTION MidiInProc(hDevice,uMsg,dwInstance,DataByte1,DataByte2)
	IF BITAND(DataByte1,240)=240
	ELSE
	DO CASE
		case uMsg=MIM_OPEN
			?"MIM_OPEN"
		case uMsg=MIM_CLOSE
			?"MIM_CLOSE"
		case (uMsg=MIM_OPEN) AND (BITAND(DataByte1,240)<>240)
			stts=BITAND(DataByte1,255)
			dt1=BITRSHIFT(BITAND(DataByte1,65280),8)
			dt2=BITRSHIFT(BITAND(DataByte1,16711680),16)
			?STR(stts)
		case uMsg=MIM_LONGDATA
			?"MIM_LONGDATA"
		case uMsg=MIM_LONGERROR
			?"MIM_LONGERROR"
		case (uMsg=MIM_MOREDATA) AND (BITAND(DataByte1,240)<>240)
			stts=BITAND(DataByte1,255)
			dt2=BITRSHIFT(BITAND(DataByte1,16711680),16)
			dt1=BITRSHIFT(BITAND(DataByte1,65280),8)
			?STR(stts)
		OTHERWISE
			?"Otherwise"
	ENDCASE
ENDIF
ENDFUNC

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

*-------------------------------------------Define some functions
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  
       
*---------------------------Declarations WINAPI
PROCEDURE declare
Declare INTEGER midiInStart In Winmm integer hmi
Declare INTEGER midiInStop In Winmm integer hmi
Declare INTEGER midiInGetNumDevs In Winmm
Declare INTEGER midiInClose In Winmm Integer hmi
Declare Sleep In kernel32 Integer dwMilliseconds
Declare INTEGER midiInGetDevCaps In Winmm;
	INTEGER uDeviceID, STRING @lpMidiInCaps,;
	INTEGER cbMidiInCaps
Declare INTEGER midiInOpen In "winmm.dll";
INTEGER @lphMidiIn ,  INTEGER uDeviceID , INTEGER dwCallback , INTEGER dwInstance , INTEGER dwFlags

 

[Chris Miller]

You got a load of misunderstandings here, but I'll try to address them one by one:

I have in the class a destroy method containg DestroyCallbackFunc, but I will check how that can be used.

I know, I've seen that, but when you enter the callback you ddon'T destroy the object, thus the callback can be called multiple times, and it may be okay, When you're in a modal state due to MESSAGEBOX that might cause a crash. It's an option to destroy the callback when you destroy the object, but you could do it as early as you can, once you got your callback, within the callback routine. That means you're not subject to further callbacks. Especially if you have one object per call, waiting for its callback and the destroying the possibility for further callbacks as early as you can.

It's just a proposed soution, so far you're not showing how and when you destroy the callback object, you seem to reuse it for all your calls. And that's likely also a reason for the crashes.

Your try to get it more stable with a DLL is not the first step I'd take, when you generate one callback object per call, you have an individual adress and you don't trip over your own toes.

Chriss

 

[Chris Miller]

In early days I tried BINDEVENT, but it needs two events. A callbackfunction is one.

Well, no. Actually any event is like a callback, just without a call in the first place. It happens. It's an event. Like key down event. You bind to it.
There are specific events that happen, because you first also cause something that in turn causes an expected event, by using SendMessage calls.
If Midi doesn't work that way, it doesn't work that way, I just observed a similar parameter specification as in Bindevents for windows messages. That doesn't say it is better or easier or more stable to use Bindevents().

Chriss

 

[Chris Miller]

I tried to create a dll. See the attached project. This causes a dll error. Probably due to 32/64 bit?

Why? I'd first try to get this stable, then you can go the step towards a DLL. Do you expect more stable results from a DLL?

A DLL is in-process, you're still using the address space of your main VFP process, there is a difference in threading model, but you're not failing on the topic of multithreading. Callbacks are also possible in a single threaded process. Otherwise you could forget to bind to multiple events in a VFP EXE.

32bit vs 64bit: Well, VFP is 32bit, be it IDE, EXE or DLL. There's no change there, too.

Chriss

 

[Jan Flikweert]

Chris,

In the past I tried dll and bindevent.
At the same time I am working non dll. In short the next code I tried using bindevent, destroy and create new object:

PUBLIC dwInstance,ptrCallback
loCallBack = CREATEOBJECT('cls_callback')
new_callback = CREATEOBJECT('cls_new_callback')
BINDEVENT(loCallBack,"Destroy",new_callback ,"create_new",1)
ptrCallback=loCallBack.Address
nResult1 = midiInOpen(@hDevice,nDevice, ptrCallback, dwInstance, CALLBACK_FUNCTION+MIDI_IO_STATUS )
DEFINE CLASS cls_new_callback AS Session
	Datasession=2
	FUNCTION create_new
		loCallBack = CREATEOBJECT('cls_callback')
		ptrCallback=loCallBack.Address
		?"Create new executed."
	ENDFUNC
ENDDEFINE
DEFINE CLASS cls_callback AS Session
	Address = 0
	Datasession=2
	FUNCTION Init
		THIS.Address = CreateCallbackFunc('MidiIn_Proc','VOID','INTEGER,INTEGER,INTEGER,INTEGER,INTEGER',THIS)
	ENDFUNC

	FUNCTION Destroy
		IF THIS.Address != 0
			DestroyCallbackFunc(THIS.Address)
			?"Destroy executed."
		ENDIF
	ENDFUNC
	
	FUNCTION MidiIn_Proc(hDevice,iMsg,dwInstance,lParam1,lParam2)
	?"Function called"
	IF BITAND(lParam1,240)=240
		?"240"	
		This.Destroy()
	ELSE
		?"Executing Msg"
		DO CASE
			case iMsg=MIM_OPEN
				?"MIM_OPEN"
				This.Destroy()
			case iMsg=MIM_CLOSE
				?"MIM_CLOSE"
				This.Destroy()
			case (iMsg=MIM_DATA) AND (BITAND(lParam1,240)<>240)
				stts=BITAND(lParam1,255)
				dt1=BITRSHIFT(BITAND(lParam1,65280),8)
				dt2=BITRSHIFT(BITAND(lParam1,16711680),16)
				?STR(stts)
				This.Destroy()
			case iMsg=MIM_LONGDATA
				?"MIM_LONGDATA"
				This.Destroy()
			case iMsg=MIM_LONGERROR
				?"MIM_LONGERROR"
				This.Destroy()
			case (iMsg=MIM_MOREDATA) AND (BITAND(lParam1,240)<>240)
				stts=BITAND(lParam1,255)
				dt2=BITRSHIFT(BITAND(lParam1,16711680),16)
				dt1=BITRSHIFT(BITAND(lParam1,65280),8)
				?STR(stts)
				This.Destroy()
			OTHERWISE
				?"Otherwise"
				This.Destroy()
		ENDCASE
	ENDIF
	ENDFUNC
ENDDEFINE

This still not works.

Kind regards,

Jan Flikweert

 

[Jan Flikweert]

Chris,

Here are two important links regarding the winapi's

MidiInOpen
MidiInProc placeholder

The midiinopen function points to a callback procedure. There is also a way to use a single thread and a window handle.

Kind regards,

Jan Flikweert

 

[Chris Miller]

I see, so you can pass in CALLBACK_WINDOW as fdwOpen parameter of midiInOpen, when passing _screen.hwnd as dwCallback, for example, and the callbacks then would come in as messages sent to _screen.

Then you can use Bindevents.

I'd not go for that when you're already close to getting callbacks done. Have you tried one callback object per call? Destroying itself after the callback? Instead of Messagebox or ?, let its callback store the parameter values to a dbf. Non blocking code that finishes very fast when processing the callback is important to not crash.

I assume you there by could get a recording of midi data while playing a midi device. Depends on what midi commmands you send to a device. Maybe inversely you control a midi device to play a song.

All these single API function declarations don't tell the overall working of the commands. midiInOpen seems to need a follow up call of midiInStart as the next logical step to let it actually work. When comparing that to low level file operations, midiInOpen is like FOPEN, but that does nothing in itself if you don't follow up with FREADs or FGETs and if you don't end it with an FCLOSE. So do you have an examples in VB that is a full implementation of a wroking process?

So I wonder if I can help you further with what you're trying here, as I don't have any midi devices that I could play with. You're not reporting back how my suggestions did or did not improve the stability.

Chriss

 

[Jan Flikweert]

Chris,

I was working with BINDEVENT and just cleared "?", messagebox and not needed do case parts, messageboxes and things which are not needed. I added a table. This table does not contain any record.

I have a digital organ so inputting midi is no problem. Even with the next code VFP crashes which means VFP is closed. As stated with no records in DBF.

For me it does not matter if the solution is CALLBACK_WINDOW or CALLBACK_FUNCTION. Using BINDEVENT and CALLBACK_WINDOW sounds easy.

loCallBack = CREATEOBJECT('cls_callback')
new_callback = CREATEOBJECT('cls_new_callback')
BINDEVENT(loCallBack,"Destroy",new_callback ,"create_new",1)
ptrCallback=loCallBack.Address
DEFINE CLASS cls_new_callback AS Session
	Datasession=2
	FUNCTION create_new
		SELECT midi_log
		BEGIN TRANSACTION
		APPEND BLANK IN midi_log
		REPLACE msg WITH "does it react"
		TABLEUPDATE(.t.)
		END TRANSACTION
		USE
		loCallBack = CREATEOBJECT('cls_callback')
		ptrCallback=loCallBack.Address
	ENDFUNC
ENDDEFINE
DEFINE CLASS cls_callback AS Session
	Address = 0
	Datasession=2
	FUNCTION Init
		THIS.Address = CreateCallbackFunc('MidiIn_Proc','INTEGER','INTEGER,INTEGER,INTEGER,INTEGER,INTEGER',THIS)
	ENDFUNC

	FUNCTION Destroy
		IF THIS.Address != 0
			DestroyCallbackFunc(THIS.Address)
		ENDIF
	ENDFUNC
	
	FUNCTION MidiIn_Proc(hDevice,iMsg,dwInstance,lParam1,lParam2)
	dwInstance=dwInstance+1
	IF BITAND(lParam1,240)=240
		This.Destroy()
	ELSE
		DO CASE
			case (iMsg=MIM_DATA) AND (BITAND(lParam1,240)<>240)
				stts=BITAND(lParam1,255)
				dt1=BITRSHIFT(BITAND(lParam1,65280),8)
				dt2=BITRSHIFT(BITAND(lParam1,16711680),16)
				This.Destroy()
			case (iMsg=MIM_MOREDATA) AND (BITAND(lParam1,240)<>240)
				stts=BITAND(lParam1,255)
				dt2=BITRSHIFT(BITAND(lParam1,16711680),16)
				dt1=BITRSHIFT(BITAND(lParam1,65280),8)
				This.Destroy()
		ENDCASE
	ENDIF
	ENDFUNC
ENDDEFINE

Kind regards,

Jan Flikweert

 

[Jan Flikweert]

Chris,

Here an complete example from VB. Note that is imports System.threading. I think MidiInStart/Stop stands alone.
It seems to me all about MidiInopen and the callback function placeholder MidiInProc.

Imports System.Threading
Imports System.Runtime.InteropServices

Public Class Form1

    Public Declare Function midiInGetNumDevs Lib "winmm.dll" () As Integer
    Public Declare Function midiInGetDevCaps Lib "winmm.dll" Alias "midiInGetDevCapsA" (ByVal uDeviceID As Integer, ByRef lpCaps As MIDIINCAPS, ByVal uSize As Integer) As Integer
    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 Declare Function midiInStart Lib "winmm.dll" (ByVal hMidiIn As Integer) As Integer
    Public Declare Function midiInStop Lib "winmm.dll" (ByVal hMidiIn As Integer) As Integer
    Public Declare Function midiInReset Lib "winmm.dll" (ByVal hMidiIn As Integer) As Integer
    Public Declare Function midiInClose Lib "winmm.dll" (ByVal hMidiIn 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

    Public Delegate Sub DisplayDataDelegate(dwParam1)

    Public Structure MIDIINCAPS
        Dim wMid As Int16 ' Manufacturer ID
        Dim wPid As Int16 ' Product ID
        Dim vDriverVersion As Integer ' Driver version
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=32)> Dim szPname As String ' Product Name
        Dim dwSupport As Integer ' Reserved
    End Structure

    Dim hMidiIn As Integer
    Dim StatusByte As Byte
    Dim DataByte1 As Byte
    Dim DataByte2 As Byte
    Dim MonitorActive As Boolean = False
    Dim HideMidiSysMessages As Boolean = False

    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 DisplayData(dwParam1)
        If ((HideMidiSysMessages = True) And ((dwParam1 And &HF0) = &HF0)) Then
            Exit Sub
        Else
            StatusByte = (dwParam1 And &HFF)
            DataByte1 = (dwParam1 And &HFF00) >> 8
            DataByte2 = (dwParam1 And &HFF0000) >> 16
            TextBox1.AppendText(String.Format("{0:X2} {1:X2} {2:X2}{3}", StatusByte, DataByte1, DataByte2, vbCrLf))
        End If
    End Sub

    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        Me.Show()
        If midiInGetNumDevs() = 0 Then
            MsgBox("No MIDI devices connected")
            Application.Exit()
        End If

        Dim InCaps As New MIDIINCAPS
        Dim DevCnt As Integer

        For DevCnt = 0 To (midiInGetNumDevs - 1)
            midiInGetDevCaps(DevCnt, InCaps, Len(InCaps))
            ComboBox1.Items.Add(InCaps.szPname)
        Next DevCnt
    End Sub

    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

    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        TextBox1.Clear()
    End Sub

    Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
        If MonitorActive = False Then
            midiInStart(hMidiIn)
            MonitorActive = True
            Button2.Text = "Stop monitor"
        Else
            midiInStop(hMidiIn)
            MonitorActive = False
            Button2.Text = "Start monitor"
        End If
    End Sub

    Private Sub Button3_Click(sender As System.Object, e As System.EventArgs) Handles Button3.Click
        If HideMidiSysMessages = False Then
            HideMidiSysMessages = True
            Button3.Text = "Show System messages"
        Else
            HideMidiSysMessages = False
            Button3.Text = "Hide System messages"
        End If
    End Sub

    Private Sub Form1_FormClosed(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
        MonitorActive = False
        midiInStop(hMidiIn)
        midiInReset(hMidiIn)
        'midiInClose(hMidiIn)
        Application.Exit()
    End Sub

End Class

Kind regards,

Jan Flikweert

 

[Jan Flikweert]

Chris,

Using BINDEVENTS, _SCREEN.HWnd and CALLBACK_WINDOW. How should the command BINDEVENTS be? Where is the message stored in the _SCREEN.HWnd?
Where is the received message stored? F.e. BINDEVENTS(_SCREEN,"HWnd",somecustomclass,"process midi in")?
Kind regards,

Jan Flikweert

 

[Jan Flikweert]

Chris,

I assume you there by could get a recording of midi data while playing a midi device. Depends on what midi commmands you send to a device. Maybe inversely you control a midi device to play a song.

I do not quit understand this quote. I use midi for live performance at home. Input comes live from my digital organ and a keyboard. It's input comes through midi in my computer. The computer processes that sound and send the sound back to the speaker of my digital organ. The result is a amazing good sound.

When you want to play with midi it can be done playing midi files and send it's output to a virtual midi port. For an example see the attached MIDI file. Additional you need two programs:
Program Midi Editor
Loop Midi Virutal Midi ports

I will search for a exe file from the VB Monitor example.

Kind regards,

Jan Flikweert