Key Down Conflict

[Sinaps]

Basically I'm registering a hotkey with RegisterHotKey and then trying to make it send a numpad number with keybd_event. My hotkey and the key I'm sending I cant change this is needed for the program I'm makeing. My best guess at the problem is since Alt+Q and Numpad7 are both happening at the same time there is a conflict with it trying to send Alt+Numpad7. If I add a sleep 1000 in there it works fine. However since this is part of the user interface a 1 second delay is unacceptable.

Please help!!!

My goal is for Alt+Q (not q) to send Numpad7 (not 7) without a delay (sleep).

The code below works great however I need it without the sleep delay.

In Form1

Option Explicit

Private Sub Form_Load()
Dim Val1 As Boolean
Val1 = RegisterHotKey(Me.hwnd, 0, MOD_ALT, vbKeyQ)
    If Not Val1 Then
        MsgBox "Could not register hotkey.", vbCritical
    End If
    
    Me.Visible = False
    
    glWinRet = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf CallbackMsgs)
End Sub

In a Module

Option Explicit

Public Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Public Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal ID As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Public Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal ID As Long) As Long

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Const WM_HOTKEY = &H312
Public Const GWL_WNDPROC = -4
Public Const KEYEVENTF_KEYUP As Long = &H2
Public Const KEYEVENTF_EXTENDEDKEY As Long = &H1
Public Const VK_MENU = &H12
Public Const VK_NUMPAD7 = &H67
Public Const MOD_ALT = &H1

Public glWinRet As Long


Public Function CallbackMsgs(ByVal wHwnd As Long, ByVal wmsg As Long, ByVal wp_id As Long, ByVal lp_id As Long) As Long
    If wmsg = WM_HOTKEY Then
        Call DoFunctions(wp_id)
        CallbackMsgs = 1
        Exit Function
    End If
    CallbackMsgs = CallWindowProc(glWinRet, wHwnd, wmsg, wp_id, lp_id)
End Function

Public Sub DoFunctions(ByVal vKeyID As Byte)
    If vKeyID = 0 Then
        Debug.Print "Pressed Alt+Q Waiting 1 second"
'Heres the big frickin problem!!!!!
        Sleep 1000
'Help me get rid of the sleep and still make it work!!!!
        Debug.Print "NumPad7"
        keybd_event VK_NUMPAD7, 0, 0, 0
        keybd_event VK_NUMPAD7, 0, KEYEVENTF_KEYUP, 0
    End If
End Sub

This is my first post to this site. I have been working on this problem for 2 weeks. It would mean alot to me if you guys are able to show me how this can be done.

Please Save Me!!!!

-Sinaps

[Joacim Andersson]

I'm guessing that the problem occurs because the Alt+Q keys are still pressed when you're trying to send the numpad 7 key. Maybe you should try to first send KEYEVENTF_KEYUP for the pressed keys.

[Sinaps]

I thought so to and tried that but it dident work for me. If anyone gets time load up the code and tinker with it if you can actualy get something to work let me know. This problem has been driveing me crazy for a wile now, if you have an awsner please test it and see if you can make it work. I apprciate your time. I may never get this working without the help of this forums users.

[Joacim Andersson]

I've tried a few different things, and the reason your code doesn't work is definitly since Alt+Q is still pressed when you're trying to send the new key. I've managed to get it to work (somewhat) by using a low-level keyboard and an API timer instead of a global shortcut key. It's not perfect but try it out and see if it's enough for you.

'Module code
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" ( _
    ByVal idHook As Long, _
    ByVal lpfn As Long, _
    ByVal hmod As Long, _
    ByVal dwThreadId As Long _
) As Long
  
Private Declare Function CallNextHookEx Lib "user32" ( _
    ByVal hHook As Long, _
    ByVal nCode As Long, _
    ByVal wParam As Long, _
    ByRef lParam As KBDLLHOOKSTRUCT _
) As Long
 
Private Declare Function UnhookWindowsHookEx Lib "user32" ( _
    ByVal hHook As Long _
) As Long
 
Declare Sub keybd_event Lib "user32.dll" ( _
    ByVal bVk As Byte, _
    ByVal bScan As Byte, _
    ByVal dwFlags As Long, _
    ByVal dwExtraInfo As Long _
)
 
Private Declare Function SetTimer Lib "user32.dll" ( _
    ByVal hWnd As Long, _
    ByVal nIDEvent As Long, _
    ByVal uElapse As Long, _
    ByVal lpTimerFunc As Long _
) As Long
 
Private Declare Function KillTimer Lib "user32.dll" ( _
    ByVal hWnd As Long, _
    ByVal nIDEvent As Long _
) As Long
 
Private Type KBDLLHOOKSTRUCT
    vkCode As Long
    scanCode As Long
    flags As Long
    time As Long
    dwExtraInfo As Long
End Type
 
Private Const HC_ACTION = 0
Private Const WH_KEYBOARD_LL = 13&
Private Const LLKHF_ALTDOWN As Long = 16&
Private Const LLKHF_EXTENDED As Long = 1&
Private Const LLKHF_UP As Long = 128&
Private Const KEYEVENTF_KEYUP As Long = &H2
Private Const VK_NUMPAD7 = &H67
Private Const VK_ALT = &H12
 
Private hKeyb As Long
Private blnExit As Boolean
 
Private Function KeybCallback(ByVal Code As Long, ByVal wParam As Long, lParam As KBDLLHOOKSTRUCT) As Long
    If blnExit Then
        KeybCallback = 1
        Exit Function
    End If
    If (Code = HC_ACTION) Then
        If (lParam.vkCode = vbKeyQ) And (lParam.flags And LLKHF_ALTDOWN = LLKHF_ALTDOWN) Then
            If lParam.flags And LLKHF_UP = LLKHF_UP Then
                Call SetTimer(0, 1, 1, AddressOf TimerProc)
                blnExit = True
                KeybCallback = 1
                Exit Function
            End If
        End If
    End If
    KeybCallback = CallNextHookEx(hKeyb, Code, wParam, lParam)
End Function
 
Private Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
    keybd_event vbKeyQ, 0, KEYEVENTF_KEYUP, 0
    keybd_event VK_ALT, 0, KEYEVENTF_KEYUP, 0
    blnExit = False
    keybd_event VK_NUMPAD7, 0, 0, 0
    keybd_event VK_NUMPAD7, 0, KEYEVENTF_KEYUP, 0
    keybd_event VK_ALT, 0, 0, 0
    KillTimer hWnd, idEvent
End Sub
 
Public Sub HookKeyboard()
    UnhookKeyboard
    hKeyb = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf KeybCallback, App.hInstance, 0&)
End Sub
 
Public Sub UnhookKeyboard()
    If hKeyb <> 0 Then
        Call UnhookWindowsHookEx(hKeyb)
        hKeyb = 0
    End If
End Sub

Change your Form code to call the HookKeyboard sub instead of the call to RegisterHotkey. Also make sure you call the UnhookKeyboard sub before your Form is unloaded.

[Sinaps]

Thanks for your help.

Unfortunatly this code seems to work similarly poorly to mine. Both have the problem that you cant hold ALT and press Q twice or 3 times and send numpad7 at the same speed. This is now bothering me more because it seems so hard to get right. But yet I know people do! I have this same question posted on another programing related forum and no one seems to have a quick and easy fix. Thank for your help Joacim. I hope we figure this out!

[Joacim Andersson]

Hmmm... I don't have a problem with using my code and pressing Ctrl+Q more then once...

[Sinaps]

Perhaps I'm doing something wrong could you post what you have in form1 to rule out any mistake I could be making. I'm very new to vb, and likely misunderstood your instructions. Making it idiot proof would be very helpful.

[Joacim Andersson]

I simply have this in my Form.

Private Sub Form_Load()
    HookKeyboard
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    UnhookKeyboard
End Sub

I also had a TextBox on the Form to test the code. When the textbox had the focus I pressed Alt+Q and it would type a 7 in the textbox, just as expected.

[Sinaps]

Thats exactly what I have, if I hit alt+q fast enough it works but holding alt and pressing q dosent send anything. Also if the windo does not have focus i.e. in notepad it dosent work. What could I be missing?