|
code
newsgroups
|
|||||||||||||||||||||||
|
|||||||||||||||||||||||
How to increase the number of keys available for use as HotKey?Is it possible for example to use a three keys combination?
Or maybe there is another way? Your thoughts appreciated, Jack "Jack" <itisnotyour@business> schrieb im Newsbeitrag The following is working without Hooking, Subclassing, etc. -news:uPDkAY8TGHA.1728@TK2MSFTNGP11.phx.gbl... > Is it possible for example to use a three keys combination? > Or maybe there is another way? 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
Moving info to a web page
FTP(not boring) Produktlokalisierung - wie funktioniert's? Consume Web Map Service (WMS) with VB6 "Save As" question & file extensions Duplicate definition on Interface declaration VBEvents ContextMenu MapObjects2 list of files in directories? How to cast a ref to one type to another? VB.NET throws "Application is ambiguous" exception |
|||||||||||||||||||||||