Home All Groups Group Topic Archive Search About

How to increase the number of keys available for use as HotKey?

Author
25 Mar 2006 4:38 AM
Jack
Is it possible for example to use a three keys combination?
Or maybe there is another way?
Your thoughts appreciated,
Jack

Author
25 Mar 2006 4:12 PM
Schmidt
"Jack" <itisnotyour@business> schrieb im Newsbeitrag
news:uPDkAY8TGHA.1728@TK2MSFTNGP11.phx.gbl...
> Is it possible for example to use a three keys combination?
> Or maybe there is another way?

The following is working without Hooking, Subclassing, etc. -
so it is "IDE-stable". It is also working independent to Key-
Combinations, already registered with 'RegisterHotKey'.
You can define your own 10-keys-combination, if you want.
;-)

'***Into a Form
Private Const VK_F12& = &H7B
Private Const VK_MENU& = &H12, VK_CONTROL& = &H11
Private Const VK_LBUTTON& = &H1,VK_RBUTTON& = &H2,VK_MBUTTON& = &H4

Private WithEvents VKeys As Cvkeys, MapNames$(5), MapVKeys$(5)

Private Sub Form_Load()
  Set VKeys = New Cvkeys
  MapVKeys(0) = VK_LBUTTON: MapNames(0) = "VKey for left MouseButton"
  MapVKeys(1) = VK_RBUTTON: MapNames(1) = "VKey for right MouseButton"
  MapVKeys(2) = VK_MBUTTON: MapNames(2) = "VKey for mid MouseButton"
  MapVKeys(3) = VK_CONTROL: MapNames(3) = "VKey for <Strg>"
  MapVKeys(4) = VK_MENU: MapNames(4) = "VKey for <Alt>"
  MapVKeys(5) = VK_F12: MapNames(5) = "VKey for F12"
  VKeys.InitializeAndStartWatching Join(MapVKeys, ","), True 'global
End Sub

Private Sub VKeys_VKeyDown(ByVal MapIdx As Long, ByVal vKey As Integer)
  Debug.Print "VKeyDown", MapNames(MapIdx), vKey
End Sub

Private Sub VKeys_VKeyUp(ByVal MapIdx As Long, ByVal vKey As Integer)
  Debug.Print "VKeyUp", MapNames(MapIdx), vKey
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Set VKeys = Nothing
End Sub

'***Into a Standard *.bas-Module
Private Declare Function SetTimer& Lib "user32" _
  (ByVal HWND&, ByVal nID&, ByVal el&, ByVal TProc&)
Private Declare Function KillTimer& Lib "user32" _
  (ByVal HWND&, ByVal nID&)
Private Declare Sub RtlMoveMemory Lib "kernel32" _
  (Dst As Any, Src As Any, ByVal cb&)

Private pVKeys&, TID&

Public Sub SetClassTimer(Obj As Object, ByVal Interval&)
  If Obj Is Nothing Then Exit Sub
  If TID Then KillClassTimer
  pVKeys = ObjPtr(Obj)
  TID = SetTimer(0, 0, Interval, AddressOf TProc)
End Sub
Public Sub KillClassTimer()
  KillTimer 0, TID: TID = 0
End Sub
Private Sub TProc(ByVal HWND&, ByVal Msg&, ByVal ID&, ByVal SysTime&)
Dim VKeys As Object
  On Error Resume Next
  RtlMoveMemory VKeys, pVKeys, 4
  VKeys.Class_Timer
  RtlMoveMemory VKeys, 0&, 4
  Err.Clear
End Sub

'***Into a Class CVKeys
Private Declare Function GetAsyncKeyState% Lib "user32" (ByVal vKey&)
Private Declare Function GetCurrentProcessId& Lib "kernel32" ()
Private Declare Function GetForegroundWindow& Lib "user32" ()
Private Declare Function GetWindowThreadProcessId& Lib "user32" _
  (ByVal HWND&, pProcessId&)

Event VKeyDown(ByVal MapIdx&, ByVal vKey%)
Event VKeyUp(ByVal MapIdx&, ByVal vKey%)

Private KMap%(), AppProcID&

Public SystemWide As Boolean

Public Sub InitializeAndStartWatching(VKeys$, Optional System As Boolean)
Dim vKeyArr$(), i&
  If VKeys = "" Then Exit Sub
  SystemWide = System
  vKeyArr = Split(VKeys, ","): ReDim KMap(UBound(vKeyArr))
  For i = 0 To UBound(vKeyArr): KMap(i) = vKeyArr(i): Next i

  AppProcID = GetCurrentProcessId
  SetClassTimer Me, 40 'msec-Interval
End Sub

Public Sub StopWatching()
  KillClassTimer
End Sub

Public Sub Class_Timer() 'check the keystates of our Keymap
  Dim i&, WndProcID&: Static LastKS%(255)
  If Not SystemWide Then 'check, if we are inside the app
    GetWindowThreadProcessId GetForegroundWindow, WndProcID
    If WndProcID <> AppProcID Then Exit Sub
  End If
  For i = 0 To UBound(KMap)
    If GetAsyncKeyState(KMap(i)) And &H8000 Then 'vKey is down
      If LastKS(i) = 0 Then LastKS(i) = 1: RaiseEvent VKeyDown(i, KMap(i))
    Else
      If LastKS(i) = 1 Then LastKS(i) = 0: RaiseEvent VKeyUp(i, KMap(i))
    End If
  Next i
End Sub

Private Sub Class_Terminate()
  KillClassTimer
End Sub

Olaf