Option Explicit
 
' Модуль для перехвата событий ввода мыши и клавиатуры
' © Кривоус Анатолий Анатольевич (The trick), 2014
 
Private Type KBDLLHOOKSTRUCT
    VkCode As Long
    ScanCode As Long
    flags As Long
    time As Long
    dwExtraInfo As Long
End Type
 
#If Win64 Then
    Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As LongPtr, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As LongPtr) As LongPtr
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As LongPtr, ByVal wParam As Integer, lParam As Any) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr
#Else
    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 Integer, lParam As Any) As Long
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
#End If
 
Private Const WH_KEYBOARD_LL = 13
Private Const HC_ACTION = 0
Private Const LLKHF_INJECTED = &H10
Private Const WM_KEYDOWN As Long = &H100
Private Const WM_KEYUP As Long = &H101
Private Const WM_SYSKEYDOWN As Long = &H104
Private Const WM_SYSKEYUP As Long = &H105
 
Dim mhWndVBE As LongPtr
 
Dim hKeyHook As LongPtr, hMouseHook As LongPtr
 
Public Sub Hook()
    hKeyHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelkbdProc, Application.HinstancePtr, 0)
    If hKeyHook = 0 Then MsgBox ("Keyboard hook error")
End Sub
Public Sub UnHook()
    If hKeyHook Then UnhookWindowsHookEx (hKeyHook): hKeyHook = 0
End Sub
' Процедура перехвата сообщений клавиатуры
Private Function LowLevelkbdProc(ByVal uCode As LongPtr, ByVal wParam As Long, lParam As KBDLLHOOKSTRUCT) As LongPtr
    If uCode = HC_ACTION Then
        Select Case wParam
        Case WM_KEYDOWN, WM_KEYUP, WM_SYSKEYDOWN, WM_SYSKEYUP
            Debug.Print KeyString(wParam) & _
                        "KeyCode: " & lParam.VkCode & _
                        " ScanCode: " & lParam.ScanCode & _
                        IIf(lParam.flags And LLKHF_INJECTED, "(inj)", vbNullString)
        End Select
    End If
    LowLevelkbdProc = CallNextHookEx(hKeyHook, uCode, wParam, lParam)
End Function
 
Private Function KeyString(WH As Long) As String
    Select Case WH
    Case WM_KEYDOWN: KeyString = "KeyDown:"
    Case WM_KEYUP: KeyString = "KeyUp:"
    Case WM_SYSKEYDOWN: KeyString = "KeySysDown:"
    Case WM_SYSKEYUP: KeyString = "KeySysUp:"
    End Select
End Function

Public Function BrowseForFolder(owner As Form, Title As String, StartDir As String) As String

strSelectedFolder = BrowseForFolder(Me, "Select A Directory", "N:\Visual Basic\! My VB progs\PicCut Pics")

Public Function PickFolder() As String

modGetOpenFolder.PickFolder

Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
    pvReserved As Long
    dwReserved As Long
    FlagsEx As Long
End Type

Private Declare Sub SetWindowPos Lib "User32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hWnd As Long, ByRef lpRect As RECT) As Long
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
'
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOREDRAW = &H8
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_FRAMECHANGED = &H20
Private Const SWP_SHOWWINDOW = &H40
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_NOCOPYBITS = &H100
Private Const SWP_NOOWNERZORDER = &H200
'
'
Dim tRec          As RECT
Dim lX As Long
Dim lY As Long
'
'Позиционируем ==================================================
GetWindowRect hwndDlg, tRec
lX = (Screen.Width / Screen.TwipsPerPixelX - (tRec.Right - tRec.Left)) \ 2
lY = (Screen.Height / Screen.TwipsPerPixelY - (tRec.Bottom - tRec.Top)) \ 2
SetWindowPos hwndDlg, 0, lX, lY, 0, 0, SWP_NOOWNERZORDER Or SWP_NOSIZE
'==============================================================

Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT) As Long
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

SetWindowPos hwndDlg, 0, 500, 100, 0, 0, SWP_NOSIZE Or SWP_NOZORDER

 (Screen.Height - Form1.Height) / 2
 (Screen.Width- Form1.Width) / 2