[엑셀마리오게임] 키보드 입력 인식

'########################################################################################################################
'# 해당 명령문에 대한 저작권은 오빠두엑셀(https://www.oppadu.com)에 있습니다.                                                #
'# 모든 정보는 Cretive Commns License에 의해 저작권을 보호받습니다.                                                     #
'# 영리를 목적으로 하지 않는 사용 및 공유는 허용됩니다. 반드시 저작자, 오빠두엑셀(https://www.oppadu.com)을 명시해야합니다.  #
'# This VBA Code is protected by Creative Commons License.                                                              #
'# All information can be posted, uploaded, shared at online for NON-commercial use only.                               #
'# The Author, '오빠두엑셀(https://www.oppadu.com)' have to be mentioned when you post this code.                            #
'########################################################################################################################
 
Option Explicit
 
'// 마우스 포인트 위치 (x,y)를 받아옵니다.
Private Type POINTAPI
    x As Long
    y As Long
End Type
 
'// TOP LEVEL WINDOW 의 키정보, 마우스위치정보를 받아올 메세지 Type을 설정합니다. (윈도우 Default 값)
Private Type msgKeyPress
    hwnd As LongPtr
    Message As LongPtr
    wParam As LongPtr
    lParam As LongPtr
    time As Long
    pt As POINTAPI
End Type
 
'// TOP LEVEL 윈도우 정보를 받습니다.
'// 더 자세한 내용은 아래 링크를 참고하세요
'// For more details, please refer to below links at MSDN
'// https://docs.microsoft.com/en-us/windows/desktop/api/winuser/nf-winuser-findwindowa
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, _
     ByVal lpWindowName As String) As LongPtr
 
'// 실행중인 Thread에서 키입력을 받기위해 대기합니다.
'// 더 자세한 내용은 아래 링크를 참고하세요
'// For more details, please refer to below links at MSDN
'// https://docs.microsoft.com/en-us/windows/desktop/api/winuser/nf-winuser-waitmessage
Private Declare PtrSafe Function WaitMessage Lib "user32" () As LongPtr
 
'// 입력된 키정보를 받습니다.
'// https://docs.microsoft.com/en-us/windows/desktop/api/winuser/nf-winuser-peekmessagea
Private Declare PtrSafe Function PeekMessage Lib "user32" Alias "PeekMessageA" _
    (ByRef lpMsg As msgKeyPress, ByVal hwnd As LongPtr, _
     ByVal wMsgFilterMin As LongPtr, _
     ByVal wMsgFilterMax As LongPtr, _
     ByVal wRemoveMsg As LongPtr) As LongPtr
 
'// 키 값을 TOP LEVEL WINDOW에 Return 합니다.
'// https://msdn.microsoft.com/en-us/library/ms910658.aspx
Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" _
    (ByVal hwnd As LongPtr, _
     ByVal wMsg As LongPtr, _
     ByVal wParam As LongPtr, _
     lParam As Any) As LongPtr
 
'// 받아온 키 정보를 처리가능한 데이터로 변환합니다.
'// https://docs.microsoft.com/en-us/windows/desktop/api/winuser/nf-winuser-translatemessage
Private Declare PtrSafe Function TranslateMessage Lib "user32" _
    (ByRef lpMsg As msgKeyPress) As LongPtr
 
Private Const wmKeyDown As LongPtr = &H100
Private Const PM_REMOVE  As LongPtr = &H1
Private Const wmChar    As LongPtr = &H102
Private blnExit As Boolean
 
'// 키입력 이벤트가 일어났을때 발생시킵니다.
Public Event KeyPressed(ByVal KeyAscii As LongPtr, _
     ByVal KeyCode As LongPtr, _
     ByVal Target As Range, _
     ByRef Cancel As Boolean)

'########################################################################################################################
'# 해당 명령문에 대한 저작권은 오빠두엑셀(https://www.oppadu.com)에 있습니다.                                                #
'# 모든 정보는 Cretive Commns License에 의해 저작권을 보호받습니다.                                                     #
'# 영리를 목적으로 하지 않는 사용 및 공유는 허용됩니다. 반드시 저작자, 오빠두엑셀(https://www.oppadu.com)을 명시해야합니다.  #
'# This VBA Code is protected by Creative Commons License.                                                              #
'# All information can be posted, uploaded, shared at online for NON-commercial use only.                               #
'# The Author, '오빠두엑셀(https://www.oppadu.com)' have to be mentioned when you post this code.                            #
'########################################################################################################################
Public Sub StartKeyPress()
    Dim msgMessage As msgKeyPress
    Dim blnCancel As Boolean
    Dim iMessage As LongPtr
    Dim iKeyCode As LongPtr
    Dim lXLhwnd As LongPtr
 
    On Error GoTo errHandler
    Application.EnableCancelKey = xlErrorHandler
 
    '// blnExit이 TRUE 가 되면 키입력인식을 종료합니다.
    blnExit = False
 
    '// 현재 실행중인 TOP LEVEL WINDOW (프로그램 창)을 인식하여 longptr (64비트 호환)로 받아옵니다.
    lXLhwnd = FindWindow("XLMAIN", Application.Caption)
 
    Do
        '// 실행중인 Thread에서 키입력을 받기위해 대기합니다.
        WaitMessage
 
        '// 오류 방지를 위해 blnExit를 Cross-Check 합니다.
        If blnExit Then Exit Do
 
        '// 키 입력을 받아옵니다.
        '// PeekMessage 값이 존재하는지(<>0) Cross-Check 합니다.
        If PeekMessage(msgMessage, lXLhwnd, wmKeyDown, wmKeyDown, PM_REMOVE) Then
            'Store the virtual key code for later use.
            iMessage = msgMessage.Message
            iKeyCode = msgMessage.wParam   '// <- 입력된 키보드 Input입니다.
 
            '받아온 msgKeyPress(=Virtual Message)를 실제 처리가능한 정보로 변환합니다.
            TranslateMessage msgMessage
            PeekMessage msgMessage, lXLhwnd, wmChar, wmChar, PM_REMOVE
 
            '// 오류 방지를 위해 blnCancel를 Cross-Check 합니다.
            blnCancel = False
 
            'KeyPressed 이벤트를 실행합니다.
            RaiseEvent KeyPressed(msgMessage.wParam, iKeyCode, Selection, blnCancel)
 
            'TOP LEVEL WINDOW에 입력값 Return합니다.
            If Not blnCancel Then
                PostMessage lXLhwnd, iMessage, iKeyCode, 0
            End If
        End If
errHandler:
        'StopKeyPress까지 DoEvents로 Loop합니다.
        DoEvents
    Loop Until blnExit
End Sub
 
Public Sub StopKeyPress()
    'Set this boolean flag to exit the above loop.
    blnExit = True
End Sub

'########################################################################################################################
'# 해당 명령문에 대한 저작권은 오빠두엑셀(https://www.oppadu.com)에 있습니다.                                                #
'# 모든 정보는 Cretive Commns License에 의해 저작권을 보호받습니다.                                                     #
'# 영리를 목적으로 하지 않는 사용 및 공유는 허용됩니다. 반드시 저작자, 오빠두엑셀(https://www.oppadu.com)을 명시해야합니다.  #
'# This VBA Code is protected by Creative Commons License.                                                              #
'# All information can be posted, uploaded, shared at online for NON-commercial use only.                               #
'# The Author, '오빠두엑셀(https://www.oppadu.com)' have to be mentioned when you post this code.                            #
'########################################################################################################################
Option Explicit
 
Dim WithEvents KeyPressWatcher As KeyPressAPI
 
Sub Start_KeyPress()
 
If KeyPressWatcher Is Nothing Then
    Set KeyPressWatcher = New KeyPressAPI
End If
 
KeyPressWatcher.StartKeyPress
 
End Sub
 
Sub End_KeyPress()
 
If KeyPressWatcher Is Nothing Then Exit Sub
KeyPressWatcher.StopKeyPress
 
End Sub
 
Private Sub KeyPressWatcher_KeyPressed(ByVal KeyAscii As LongPtr, ByVal KeyCode As LongPtr, ByVal Target As Range, Cancel As Boolean)
 
MsgBox "[[알림]]" & vbNewLine & _
        "현재 입력한 키는 " & Chr(CLng(KeyAscii)) & " 입니다." & vbNewLine & _
        "키의 아스키코드는 " & CLng(KeyAscii) & " 입니다."
 
End Sub

'########################################################################################################################
'# 해당 명령문에 대한 저작권은 오빠두엑셀(https://www.oppadu.com)에 있습니다.                                                #
'# 모든 정보는 Cretive Commns License에 의해 저작권을 보호받습니다.                                                     #
'# 영리를 목적으로 하지 않는 사용 및 공유는 허용됩니다. 반드시 저작자, 오빠두엑셀(https://www.oppadu.com)을 명시해야합니다.  #
'# This VBA Code is protected by Creative Commons License.                                                              #
'# All information can be posted, uploaded, shared at online for NON-commercial use only.                               #
'# The Author, '오빠두엑셀(https://www.oppadu.com)' have to be mentioned when you post this code.                            #
'########################################################################################################################
 
Option Explicit
 
Private Type POINTAPI
    x As Long
    y As Long
End Type
 
Private Type MSG
    hwnd As Long
    Message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type
 
Private Declare Function WaitMessage Lib "user32" () As Long
 
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" _
    (ByRef lpMsg As MSG, ByVal hwnd As Long, _
     ByVal wMsgFilterMin As Long, _
     ByVal wMsgFilterMax As Long, _
     ByVal wRemoveMsg As Long) As Long
 
Private Declare Function TranslateMessage Lib "user32" _
    (ByRef lpMsg As MSG) As Long
 
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
    (ByVal hwnd As Long, _
     ByVal wMsg As Long, _
     ByVal wParam As Long, _
     lParam As Any) As Long
 
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, _
     ByVal lpWindowName As String) As Long
 
Private Const WM_KEYDOWN As Long = &H100
Private Const PM_REMOVE  As Long = &H1
Private Const WM_CHAR    As Long = &H102
Private bExitLoop As Boolean
 
Public Event KeyPressed(ByVal KeyAscii As Integer, _
     ByVal KeyCode As Integer, _
     ByVal Target As Range, _
     ByRef Cancel As Boolean)