Visual Basic 6 - MidiIn Systeme esclusive

Buonasera a tutti,
cerco aiuto al fine di terminare l'aquisifione dei codici midi provenienti da un mixer audio digitale in formarmato SysEx.

Ho realizzato un modulo che però non mi funziona come callback ma che devo ogni volta richiamare per caricare nel buffer il codice.

Option Explicit

Dim mInDev As Integer

Dim DispBuffStr(0 To 254) As midiBuffer

'Sleep (3000) '// Will pause for 3 seconds
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'Function declarations for midi in
Declare Function midiInGetNumDevs Lib "winmm.dll" () As Long
Declare Function midiInGetDevCaps Lib "winmm.dll" Alias "midiInGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As MIDIINCAPS, ByVal uSize As Long) As Long
Declare Function midiInOpen Lib "winmm.dll" (lphMidiIn As Long, ByVal uDeviceID As Long, ByVal dwCallback As Any, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
Declare Function midiInPrepareHeader Lib "winmm.dll" (ByVal hMidiIn As Long, lpMidiInHdr As MIDIHDR, ByVal uSize As Long) As Long
Declare Function midiInAddBuffer Lib "winmm.dll" (ByVal hMidiIn As Long, lpMidiInHdr As MIDIHDR, ByVal uSize As Long) As Long
Declare Function midiInStart Lib "winmm.dll" (ByVal hMidiIn As Long) As Long
Declare Function midiInStop Lib "winmm.dll" (ByVal hMidiIn As Long) As Long
Declare Function midiInReset Lib "winmm.dll" (ByVal hMidiIn As Long) As Long
Declare Function midiInUnprepareHeader Lib "winmm.dll" (ByVal hMidiIn As Long, lpMidiInHdr As MIDIHDR, ByVal uSize As Long) As Long
Declare Function midiInClose Lib "winmm.dll" (ByVal hMidiIn As Long) As Long
Declare Function midiInGetErrorText Lib "winmm.dll" Alias "midiInGetErrorTextA" (ByVal err As Long, ByVal lpText As String, ByVal uSize As Long) As Long
'Declare Function midiInGetID Lib "winmm.dll" (ByVal hMidiIn As Long, lpuDeviceID As Long) As Long
'Declare Function midiInMessage Lib "winmm.dll" (ByVal hMidiIn As Long, ByVal msg As Long, ByVal dw1 As Long, ByVal dw2 As Long) As Long

Public Const MAXPNAMELEN = 32 ' max product name length (including NULL)
Public Const MIDI_MAPPER = -1
Public Const IN_BUFFER_LEN = 255 'midiInString Buffer

'Use with midiInGetDevCaps
Type MIDIINCAPS
wMid As Integer
wPid As Integer
vDriverVersion As Long
szPname As String * MAXPNAMELEN
End Type

Type MIDIHDR ' MIDI data block header
lpData As Long 'Address of MIDI data
dwBufferLength As Long 'Size of the buffer
dwBytesRecorded As Long 'Actual amount of data in the buffer. This value should be less than or equal to the value given in the dwBufferLength member
dwUser As Long 'Custom user data
dwFlags As Long 'Flags giving information about the buffer
'MHDR_DONE
'Set by the device driver to indicate that it is finished with the buffer and is returning it to the application
'MHDR_INQUEUE
'Set by Windows to indicate that the buffer is queued for playback
'MHDR_ISSTRM
'Set to indicate that the buffer is a stream buffer.
'MHDR_PREPARED
'Set by Windows to indicate that the buffer has been prepared by using the midiInPrepareHeader or midiOutPrepareHeader function
lpNext As Long 'Reserved - do not use
reserved As Long 'Reserved - do not use
dwOffset As Long 'Offset into the buffer when a callback is performed
dwReserved(4) As Long 'Reserved - do not use
End Type

Type MIDIEVENT
dwDeltaTime As Long ' Ticks since last event
dwStreamID As Long ' Reserved; must be zero
dwEvent As Long ' Event type and parameters
dwParms(1) As Long ' Parameters if this is a long event
End Type

Type MIDIPROPTEMPO
cbStruct As Long
dwTempo As Long
End Type

Type MIDIPROPTIMEDIV
cbStruct As Long
dwTimeDiv As Long
End Type

Type MIDISTRMBUFFVER
dwVersion As Long 'Stream buffer format version
dwMid As Long 'Manufacturer ID as defined in MMREG.H
dwOEMVersion As Long 'Manufacturer version for custom ext
End Type

Type MMTIME
wType As Long
u As Long
End Type

'user added
Type midiBuffer
syxType As String * 4
midiData As String * 255
End Type

Public Const CALLBACK_TYPEMASK = &H70000 ' callback type mask
Public Const CALLBACK_NULL = &H0 ' no callback
Public Const CALLBACK_WINDOW = &H10000 ' dwCallback is a HWND
Public Const CALLBACK_TASK = &H20000 ' dwCallback is a HTASK
Public Const CALLBACK_FUNCTION = &H30000 ' dwCallback is a FARPROC

Dim midiInString(IN_BUFFER_LEN) As Byte ' Make sure this is big enough!
Dim lpMidiHeader As Long
Dim midiInHdr As MIDIHDR
Dim inMidiOpen As Boolean
Dim hInMidi As Long 'Holds address of MIDIHDR

Dim tmp As Long

Global var_MidiInRxStatus As Boolean

Public Function Memorize_Event(ByVal MidiInHandle As Long, ByVal wMsg As Long, ByVal Instance As Long, ByVal dw1 As Long, ByVal dw2 As Long) As Long
'configured as shown in MidiInProc notes
'NOTE: Do not put code in this function If using
'callback for sysex. See MidiInProc remarks.
End Function

Public Function fnc_MidiInOpen()

Dim ct As Integer
Dim Length As Integer

Length = IN_BUFFER_LEN

For ct = 0 To Length - 1
midiInString(ct) = 0 'c++ end of string char
Next ct

With midiInHdr
.lpData = VarPtr(midiInString(0)) ' Undocumented feature!
.dwBufferLength = Length
.dwBytesRecorded = Length - 1 ' Was Length - only used for MIDI in
.dwUser = 0
.dwFlags = 0
End With

tmp = midiInOpen(hInMidi, mInDev, AddressOf Memorize_Event, 0, CALLBACK_FUNCTION)

tmp = midiInPrepareHeader(hInMidi, midiInHdr, LenB(midiInHdr))

End Function

Public Function fnc_MidiInRxStart()
var_MidiInRxStatus = True

Call fnc_MidiInRxMsg
End Function

Public Function fnc_MidiInRxStop()
var_MidiInRxStatus = False
End Function

Private Function fnc_MidiInRxMsg()
'On Error Resume Next

Do While var_MidiInRxStatus = True
'Starts midi input on dev
tmp = midiInStart(hInMidi)

'send an input buffer to midi input dev
tmp = midiInAddBuffer(hInMidi, midiInHdr, LenB(midiInHdr))

'allow time to receive data
Sleep (5) 'enter milliseconds

If midiInHdr.dwBytesRecorded > 0 Then Call fnc_MidiInRxView
' tmp = midiInReset(hInMidi)

' tmp = midiInStop(hInMidi)
Loop

End Function

Function fnc_MidiInClose()
tmp = midiInClose(hInMidi)
End Function

Function fnc_MidiInRxView()
Dim ct As Integer, mimdata As String

DoEvents
For ct = 0 To midiInHdr.dwBytesRecorded - 1
If midiInString(ct) <> 247 Then 'not F7 EOX
mimdata = mimdata & Hex(midiInString(ct)) & " "
Else
mimdata = mimdata & Hex(midiInString(ct))
End If
Next ct

sysexIO.lblMidiInRxMsg.Caption = mimdata
If midiInHdr.dwBytesRecorded > 7 Then sysexIO.List1.AddItem (mimdata)
End Function

Qualcuno mi riesce a dare una mano, il mio problema è che attivato in questo modo spesso mi perdo i dati di MidiIn.

Grazie per la collaborazione
Marcello

usa i programmi midi già forniti.. anke io ho una console midi..

Il problema e che devo generare delle macro in risposta a delle funzioni midi, non ho trovato niente che fa al caso mio in commercio.

SCusate x l'..
ma ke console hai??

Digital Mixer Yamaha DM2000

e te vorresti creare un programma x impostare le funzioni midi di una BESTIA del genere??

ps. l'ho trovato a 9500 €.. Ma dico un mixer a 9500 € siamo normali..???
Guardate ke prezzi..

mercatinomusicale.com/ann/search.asp/idr_7/idc_75/search_dm2000/

Le impostazioni da pc a mixer le faccio gia, mi manca il pezzo di programma nel senso inverso.