Midi 컨트롤러를 통한 Excel 제어

Midi 컨트롤러를 통한 Excel 제어

이것들 중 하나가
_{(출처 : netdna-cdn.com )}

엑셀 폼 컨트롤 스크롤바처럼 슬라이더를 사용하여 엑셀을 제어하고 싶었습니다.

이 코드를 VBA용으로 수정했습니다만, 매우 불안정합니다.누가 안정시키는 것 좀 도와줄래?MidiIn_Event 함수가 빨리 돌아오지 않으면 크래쉬 할 수 있다고 생각합니다만, 틀릴 수 있습니다.

잘 부탁드립니다.

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        

문제는 아마MsgBox:

• MIDI 이벤트는 콜백을 사용하기 때문에 다른 스레드에서 실행될 가능성이 높습니다.VBA는 본질적으로 싱글 스레드입니다(예:VBA에서의 멀티스레딩으로 인해 다른 스레드에서 모달 대화상자를 표시하려고 하면 문제가 발생할 수 있습니다(정의되지 않은 동작, 크래시 등).
• MIDI는 보통 엄청난 양의 이벤트를 트리거하기 때문에(슬라이더나 노브의 아주 작은 움직임만으로도 이벤트가 트리거됩니다), 눈에 띄는 양을 움직이면 수백 개의 이벤트가 발생할 수 있습니다.각 이벤트에서 대화 상자 표시(OK 클릭 필요)는 문제가 될 수 있습니다.

테스트를 위해 교환을 시도합니다.Call MsgBox(dw1)와 함께Debug.Print dw1따라서 값이 즉시 창에 인쇄되므로 훨씬 안정적일 수 있습니다.간단한 조작(셀의 값 갱신, 창 스크롤 등)을 실행하려고 할 경우, 각 콜이 다음과 같이 되어 있는 한 회피할 수 있습니다.MidiIn_Event는 다음 이벤트 전에 완료됩니다.

훨씬 더 복잡하지만 안정적인 해결책은 데이터 포인트를 이벤트핸들러의 큐에 푸시하고 큐에서 아이템을 팝하여 VBA 스레드에서 액션을 실행하는 VBA의 반복 타이머를 사용하는 것입니다.

이거 정말 멋지다 :D

그러나 위에서 말한 메시지 박스는 그것을 없애지만 메시지 박스를 제거하는 것은 그다지 도움이 되지 않을 것입니다.vba->excel은 순간적이지 않기 때문에 트래픽의 증가를 최소화해야 합니다.

그래서 해결책은 다음과 같은 것입니다.

워크북 시작 매크로

    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

MidiIn_Event에 의해 주어진 데이터를 처리하는 일반적인 함수가 필요한데, 이 예에서는 runClock()이 그 함수입니다.

이를 통해 는 상태 표시줄을 사용하여 메시지 키와 클럭유형을 카운트할 수 있습니다.

Option Explicit

Private Const CALLBACK_FUNCTION = &H30000

'MIDI Functions here: https://learn.microsoft.com/en-us/windows/win32/multimedia/midi-functions
#If Win64 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
    Private Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long
    'For MIDI device INPUT
    Private Declare PtrSafe Function midiInOpen Lib "winmm.dll" (lphMidiIn As LongPtr, ByVal uDeviceID As LongPtr, ByVal dwCallback As LongPtr, ByVal dwInstance As LongPtr, ByVal dwFlags As LongPtr) As Long
    Private Declare PtrSafe Function midiInClose Lib "winmm.dll" (ByVal hMidiIn As LongPtr) As Long
    Private Declare PtrSafe Function midiInStart Lib "winmm.dll" (ByVal hMidiIn As LongPtr) As Long
    Private Declare PtrSafe Function midiInStop Lib "winmm.dll" (ByVal hMidiIn As LongPtr) As Long
    Private Declare PtrSafe Function midiInReset Lib "winmm.dll" (ByVal hMidiIn As LongPtr) As Long
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare Function timeGetTime Lib "winmm.dll" () As Long
    'For MIDI device INPUT
    Private Declare Function midiInOpen Lib "winmm.dll" (lphMidiIn As Long, ByVal uDeviceID As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
    Private Declare Function midiInClose Lib "winmm.dll" (ByVal hMidiIn As Long) As Long
    Private Declare Function midiInStart Lib "winmm.dll" (ByVal hMidiIn As Long) As Long
    Private Declare Function midiInStop Lib "winmm.dll" (ByVal hMidiIn As Long) As Long
    Private Declare Function midiInReset Lib "winmm.dll" (ByVal hMidiIn As Long) As Long
#End If

#If Win64 Then
    Private mlngCurDevice      As Long
    Private mlngHmidi          As LongPtr
#Else
    Private mlngCurDevice      As Long
    Private mlngHmidi          As Long
#End If

Private ClockTicks             As Integer
Private Notes                  As Integer
Private Looper                 As Long
Private LongMessage            As Long
Private actualTime             As Long

Public Sub runClock()

    'When canceled become able to close opened Input devices (For ESC press)
    On Error GoTo handleCancel
    Application.EnableCancelKey = xlErrorHandler

    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        '.DisplayStatusBar = False
        '.EnableEvents = False
    End With

    mlngCurDevice = 8 'My Device is 8 but yours is 0
    Notes = 0
    Looper = 0

    'Open Input Device
    Call midiInOpen(mlngHmidi, mlngCurDevice, AddressOf MidiIn_Event, 0, CALLBACK_FUNCTION)

    'Ends only when Status is different from 0
    Do While Notes < 10
        'Reset Status count
        ClockTicks = 0

        'Begins lissinting the MIDI input
        Call midiInStart(mlngHmidi)

        'Loops until the right message is given <= 255 and > 0
        Do While ClockTicks < 1000 And Notes < 10
            'Sleep if needed
            Sleep 10
            Application.StatusBar = "Looper=" & Looper & " | Notes=" & Notes & " | ClockTicks=" & ClockTicks & " | Message=" & LongMessage
            Looper = Looper + 1
            'DoEvents enables ESC key
            If Abs(timeGetTime - actualTime) > 3000 Then
                DoEvents
                actualTime = timeGetTime
            End If
        Loop

        'Ends lisingting the MIDI input
        Call midiInReset(mlngHmidi)
        Call midiInStop(mlngHmidi)

    Loop

    'Closes Input device
    Do While midiInClose(mlngHmidi) <> 0
    Loop

    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .DisplayStatusBar = True
        .EnableEvents = True
    End With

    MsgBox "ENDED WITH SUCCESS", , "Message:"

    'Close all opened MIDI Inputs when canceled (ESC key pressed)
handleCancel:
        If Err.Number = 18 Then

            'Ends lisingting the MIDI input
            Call midiInReset(mlngHmidi)
            Call midiInStop(mlngHmidi)
            Do While midiInClose(mlngHmidi) <> 0
            Loop

            With Application
                .Calculation = xlCalculationAutomatic
                .ScreenUpdating = True
                .DisplayStatusBar = True
                .EnableEvents = True
            End With

            MsgBox "ENDED WITH SUCCESS", , "Message:"

        End If

End Sub

Private Function MidiIn_Event(ByVal mlngHmidi As Long, ByVal Message As Long, ByVal Instance As Long, ByVal dw1 As Long, ByVal dw2 As Long) As Long

    'The value 963 is the MIM_DATA concerning regular MIDI messages
    If Message = 963 Then
        LongMessage = Message
        If dw1 > 255 Then
            Notes = Notes + 1
        Else
            ClockTicks = ClockTicks + 1
        End If
    End If

End Function

이 문제는 클럭 동기 등의 MIDI 데이터를 수신할 때 ESC 키가 눌렸을 때 발생합니다.다른 모든 것이 정상적으로 동작하는데도 ESC 키가 스크립트를 여러 번 크래시합니다.그러나 MIDI 메시지 입력 중에 ESC 키를 사용하지 않으면 이 문제가 발생하지 않습니다.

그럼에도 불구하고 클럭 신호를 수신하면서 ESC 키를 누르면 스크립트가 크래시되는 이유를 알고 싶습니다.

글로벌 변수를 필요에 맞게 조정하기만 하면 됩니다.

내가 도움이 됐길 바란다.

언급URL : https://stackoverflow.com/questions/14095315/controlling-excel-via-midi-controller