C# / VB.NET - [VB.NET] MIDI , errore con callback di funzione .

(copio e incollo da un altro forum in cui ho postato la domanda )
spero di non aver scritto cavolate nel titolo ,
purtroppo mi ritrovo con un problema di concetto , essendo passato io da poco a vb.net non ho capito ancora bene come funziona il concetto di delegate ed in generale il concetto di programmazione ad oggetti ( essendo io passato da programmazione ad eventi! ).

Iniziero' a leggere una guida avanzata ( sto leggendo quella di questo sito)

Pero' ... ho poco tempo , prima di rimettermi a studiare per l'universita' dovrei finire il programma, alla svelta ,quindi vi spiego il problema .

Ho trovato del codice in vb6 per utilizzare il mio controller midi per i miei soft .
aiutandomi con degli esempi presi su internet sono riuscito a farlo girare benone su vb.net utilizzando il metodo delegate ... da completo profano . Pero' c'e' un problema , la funzione richiamata dai delegate funziona solo se richiama a sua volta delle sub che caricano poco la cpu , quindi , a volte mi da' l'errore a volte no , sull 'help ho trovato esposta la causa e la soluzione , pero' essendo io alquanto profano in materia , in realta' non ho capito bene ne la causa ne la soluzione , il link e' questo : LINK

ora vi incollo il codice che fa funzionare il mio controller midi come joystick

in un modulo ho messo :

Module Module1

    Declare Function midiInGetNumDevs Lib "winmm.dll" () As Long
    Declare Function midiInGetDevCaps Lib "winmm.dll" Alias "midiInGetDevCapsA" (ByVal uDeviceID As Integer, ByRef lpCaps As MIDIINCAPS, ByVal uSize As Integer) As Integer

    'Api:
    Public Delegate Function Memorize_EventCallback(ByVal MidiInHandle As Integer, _
                                               ByVal Message As Integer, _
                                               ByVal Instance As Integer, _
                                               ByVal dw1 As Integer, _
                                               ByVal dw2 As Integer) As Integer

    Declare Function midiInOpen Lib "winmm.dll" (ByRef lphMidiIn As Integer, ByVal uDeviceID As Integer, ByVal dwCallback As Memorize_EventCallback, ByVal dwInstance As Integer, ByVal dwFlags As Integer) As Integer

    Declare Function midiInClose Lib "winmm.dll" (ByVal hMidiIn As Integer) As Integer
    Declare Function midiInStart Lib "winmm.dll" (ByVal hMidiIn As Integer) As Integer
    Declare Function midiInStop Lib "winmm.dll" (ByVal hMidiIn As Integer) As Integer
    Declare Function midiInReset Lib "winmm.dll" (ByVal hMidiIn As Integer) As Integer

    'la reference
    Public ri As Long

    Public Structure MIDIINCAPS
        Dim wMid As Short ' Manufacturer ID
        Dim wPid As Short ' Product ID
        Dim vDriverVersion As Integer ' Driver version
        Dim szPname As String ' Product Name
        Dim dwSupport As Integer ' Supported extras
    End Structure

    Public Const CALLBACK_FUNCTION = &H30000    'riferimento alla funzione

End Module

nella form principale invece ho piazzato all'evento LOAD

Dim a As Integer
        a = midiInGetNumDevs
            ListBox1.Items.Add("controller midi :" & a)
        If a = 1 Then
            midiInOpen(ri, 0, AddressOf MidiIn_Event, 0, CALLBACK_FUNCTION)
            midiInStart(ri)
            ListBox1.BackColor = Color.GreenYellow
        ElseIf a = 0 Then
            MsgBox("controller midi non connesso oppure piu di un controller connesso!")
            ListBox1.BackColor = Color.LightCoral
        End If 

ok ... e' poco preciso , ma per il mio uso va molto bene
e poi la funzione richiamata :

#Region "regione RICEVIMIDI"

    Public Function MidiIn_Event(ByVal MidiInHandle As Integer, ByVal Message As Integer, ByVal Instance As Integer, ByVal dw1 As Integer, ByVal dw2 As Integer) As Integer
        Dim a As String, b As String, c As String
        Dim out As Short
        If dw1 > 255 Then
            Call RiceviMidi(dw1)
        End If
    End Function


    Private Delegate Sub midiDelegate(ByVal code As Integer)

    Public Sub RiceviMidi(ByVal code As Integer)
        If Me.InvokeRequired Then
            Me.Invoke(New midiDelegate(AddressOf RiceviMidi), New Object() {code})
            Return
        End If
        Dim b As String, a As String, c As String
        a = code.ToString
        b = Strings.Left(Strings.Right("00000000" + Hex(a), 6), 4)
        c = Int("&H" + Strings.Right(b, 2))
                Call Joystick(c)
        End If
    End Sub

#End Region

la funzione joystick rileva quale tasto e' stato premuto e richiama una funzione del programma

allora il problema e' che dopo aver eseguito una serie di funzioni molto lunghe , richiamate in joystick , alla prima pressione del tasto tutto ok
, esegue le funzioni senza errori ,

quando pero' fatto questo vado a premere un tasto qualsiasi della tastiera midi ( uno qualsiasi , non per forza quello assegnato per eseguire altre funzioni ) , che richiama la funzione delegate di callback ( e0 giusto? ) , questa e' stata chiusa (? non so' perche') e mi appare l'errore CallbackOnCollectedDelegate .

potreste darmi una mano a risolvere il problema ??

grazie 1000

Se il tuo problema è un delegato che viene distrutto prima del necessario, potresti dichiararlo come variabile globale: questo gli assicurerebbe la vita eterna!!! muhahaha!! Almeno finché lo distruggi logicamente.

Private midiOpenDelegate As New Memorize_EventCallback(AddressOf MidiIn_Event)

i have the same problem, but i cant resolve, here is my project: docs.google.com/…

Any help would be great, thanx

Hi, i have the same problem but i cant resolved,could you help me??

here is my project docs.google.com/…

and here are my codes:

Form1

Delegate Sub DelegateForSomeSub(ByVal arg0 As String)
Public Class Form1
    

    Public Sub SomeSub(ByVal arg0 As String)
        If Me.InvokeRequired Then
            Debug.Print("invoke")
            Me.Invoke(New DelegateForSomeSub(AddressOf AppendText), arg0)
        Else
            Debug.Print("append")
            AppendText(arg0)
        End If
        'Debug.Print(arg0)

    End Sub

    Private Sub AppendText(ByVal arg0 As String)
        TextBox2.Text = arg0

    End Sub
    Private Sub Form1_Disposed(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Disposed
        midiInClose(hMidiIn)
    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        ' open the first available midi input device
        midiInOpen(hMidiIn, 0, AddressOf MidiInProc, 0, CALLBACK_FUNCTION)
        ' For explanation of parameters, see http://msdn.microsoft.com/en-us/library/ms711610
        midiInStart(hMidiIn)

    End Sub
End Class

And here is the Module 1 code

Module Module1


    'all the midi declarations
    Delegate Function MidiIn_Callback(ByVal hMidiIn As Integer, ByVal wMsg As UInteger, ByVal dwInstance As Integer, ByVal dwParam1 As Integer, ByVal dwParam2 As Integer) As Integer
    Public Declare Function midiInOpen Lib "winmm.dll" (ByRef lphMidiIn As Integer, ByVal uDeviceID As Integer, ByVal dwCallback As MidiIn_Callback, ByVal dwInstance As Integer, ByVal dwFlags As Integer) As Integer
    Public Declare Function midiInClose Lib "winmm.dll" (ByVal hMidiIn As Integer) As Integer
    Public Declare Function midiInStart Lib "winmm.dll" (ByVal hMidiIn As Integer) As Integer
    Public hMidiIn As Integer
    Public Const CALLBACK_FUNCTION As Integer = &H30000

    'these are public for debug purposes.
    Public frames As Int16
    Public seconds As Int16
    Public minutes As Int16
    Public hours As Int16
    Public timecode As Long
    Public byte1 As Byte
    Public byte2 As Byte
    Public nibble1 As Byte
    Public nibble2 As Byte

    

    Function MidiInProc(ByVal hMidiIn As Integer, ByVal wMsg As UInteger, ByVal dwInstance As Integer, ByVal dwParam1 As Integer, ByVal dwParam2 As Integer) As Integer

        'MTC is 2 bytes. Byte 1 is F1 (means its an MTC packet). Byte 2 is a frame counter & frame value
        byte1 = dwParam1 And &HFF
        'skip if it isnt a frame packet
        If byte1 <> &HF1 Then
            Return 0
            Exit Function
        End If

        'byte 2 is split into nibbles. MS Nibble is Message Type, LS Nibble is Message
        byte2 = dwParam1 >> 8
        nibble1 = byte2 And &HF
        nibble2 = byte2 >> 4

        'operate!
        Select Case nibble2
            Case 0  'frame lsb
                'mask
                frames = (frames And &HF0) Or nibble1
            Case 1  'frame msb
                'shift
                nibble1 = nibble1 << 4
                'apply
                frames = (frames And &HF) Or nibble1
            Case 2  'second lsb
                'apply
                seconds = (seconds And &HF0) Or nibble1
            Case 3  'second msb
                'shift
                nibble1 = nibble1 << 4
                'apply
                seconds = (seconds And &HF) Or nibble1
            Case 4  'minute lsb
                'apply
                minutes = (minutes And &HF0) Or nibble1
                frames = frames + 1
            Case 5  'second msb
                'shift
                nibble1 = nibble1 << 4
                'apply
                minutes = (minutes And &HF) Or nibble1
            Case 6  'hours lsb
                'apply
                hours = (hours And &HF0) Or nibble1
            Case 7  'hours msb
                'shift
                nibble1 = nibble1 << 4
                'apply
                hours = (hours And &HF) Or (nibble1 And &H1)
        End Select

        If nibble2 = 1 Or nibble2 = 5 Then
            DirectCast(My.Application.OpenForms.Item("Form1"), Form1).SomeSub(hours & ":" & minutes & ":" & seconds & ":" & frames & " -- " & nibble2)
        End If
    End Function
End Module

thanks

Pablo.