Controlando Excel a través del controlador Midi

vba winmm

Question

Tengo uno de estos http://mustech.jpsystemsinc.netdna-cdn.com/wp-content/uploads/2008/12/kontrol.gif de nanoKontrol y quería usar los controles deslizantes para controlar Excel, como uno de las barras de desplazamiento de control de formulario de Excel.

Logré modificar este código para VBA, pero es extremadamente inestable. ¿Alguien puede ayudarme a estabilizarlo? Creo que la función MidiIn_Event puede fallar si no regresa lo suficientemente rápido, pero puedo estar equivocado.

Gracias por adelantado.

Public Const CALLBACK_FUNCTION = &H30000
Public 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
Public Declare Function midiInClose Lib "winmm.dll" 
        (ByVal hMidiIn As Long) As Long
Public Declare Function midiInStart Lib "winmm.dll" 
        (ByVal hMidiIn As Long) As Long
Public Declare Function midiInStop Lib "winmm.dll" 
        (ByVal hMidiIn As Long) As Long
Public Declare Function midiInReset Lib "winmm.dll" 
        (ByVal hMidiIn As Long) As Long
Private ri As Long

Public Sub StartMidiFunction()
    Dim lngInputIndex As Long
    lngInputIndex=0
    Call midiInOpen(ri, lngInputIndex, AddressOf MidiIn_Event, 
            0, CALLBACK_FUNCTION)
    Call midiInStart(ri)
End Function

Public Sub EndMidiRecieve()
    Call midiInReset(ri)
    Call midiInStop(ri)
    Call midiInClose(ri)
End Sub

Public Function MidiIn_Event(ByVal MidiInHandle As Long, 
        ByVal Message As Long, ByVal Instance As Long, 
        ByVal dw1 As Long, ByVal dw2 As Long) As Long

    ''dw1 contains the midi code
    If dw1 > 255 Then ''Ignore time codes
        Call MsgBox(dw1)    ''This part is unstable
    End If
End Function        

Answer 1

El problema es probablemente MsgBox :

• Dado que los eventos MIDI usan devoluciones de llamada, lo más probable es que se ejecuten desde otro hilo. VBA es intrínsecamente de un solo subproceso (consulte, por ejemplo, Multi-threading en VBA ), por lo que intentar mostrar un diálogo modal desde otro subproceso probablemente cause problemas (comportamiento indefinido, bloqueo, cualquier otra cosa ...)
• El MIDI por lo general desencadena una gran cantidad de eventos (el movimiento más pequeño de un control deslizante o control desencadenaría un evento), por lo que mover algo con una cantidad notable puede provocar cientos de eventos. Mostrar un cuadro de diálogo (que requiere un clic OK) en cada evento podría ser un problema.

Para probar, intente reemplazar Call MsgBox(dw1) con Debug.Print dw1 para que los valores solo se impriman en la ventana Inmediato, que debería ser mucho más estable. Si está intentando ejecutar alguna acción simple (por ejemplo, actualizar el valor en una celda, desplazarse por la ventana), puede salirse con la suya siempre que cada llamada a MidiIn_Event complete antes del siguiente evento.

Una solución mucho más compleja pero estable podría ser insertar puntos de datos en una cola en el controlador de eventos, y usar un temporizador repetitivo en VBA que muestre elementos de la cola y ejecute alguna acción en el hilo de VBA.

Answer 2

Esto es tan fantástico genial: D

pero el cuadro de mensaje como se mencionó anteriormente lo matará, pero quitar el cuadro de mensaje probablemente no ayude demasiado. Desea minimizar la abundancia del tráfico para sobresalir también porque el vba-> excel no será instantáneo.

Así que la solución sería

en la macro de inicio de libro de trabajo

    Public lngMessage As String

    Private Sub Workbook_Open()
        alertTime = Now + TimeValue("00:00:01")
        Application.OnTime alertTime, "EventMacro"
    End Sub
    Sub EventMacro()
        ActiveSheet.Cells(1, 1).Value = lngMessage
        alertTime = Now + TimeValue("00:00:01")
    End Sub

    Public Function MidiIn_Event(ByVal MidiInHandle As Long, ByVal Message As Long, ByVal Instance As Long, ByVal dw1 As Long, ByVal dw2 As Long) As Long
        ''dw1 contains the midi code
        If dw1 > 255 Then ''Ignore time codes
            lngMessage = dw1    ''This part is now happy
        End If
    End Function