Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - VBA

Страница: 1 |

 

  Вопрос: Перехват нажатия клавиш - vba Добавлено: 01.09.09 15:23  

Автор вопроса:  AngryBadger
Всем привет. А подскажите плз, как на vba реализовать перехват нажатия клавиш на клавиатуре (если находишься на рабочем листе)? Интересует нажатие стрелок и пробела.

Ответить

  Ответы Всего ответов: 6  

Номер ответа: 1
Автор ответа:
 AngryBadger



Вопросов: 33
Ответов: 245
  Профиль | | #1 Добавлено: 01.09.09 16:55

Опять разобрался сам)) Если кому-то нужно пользуйтесь!

  1. Option Explicit
  2.  
  3. Public Declare Function CallNextHookEx Lib "user32" _
  4.    (ByVal hHook As Long, _
  5.    ByVal nCode As Long, _
  6.    ByVal wParam As Long, _
  7.    ByVal lParam As Long) As Long
  8.  
  9. Public Declare Function UnhookWindowsHookEx Lib "user32" _
  10.    (ByVal hHook As Long) As Long
  11.  
  12. Public Declare Function SetWindowsHookEx Lib "user32" _
  13.    Alias "SetWindowsHookExA" _
  14.    (ByVal idHook As Long, _
  15.    ByVal lpfn As Long, _
  16.    ByVal hmod As Long, _
  17.    ByVal dwThreadId As Long) As Long
  18.  
  19. Public Declare Function GetCurrentThreadId Lib "kernel32" () As Long
  20.  
  21. Public Const WH_KEYBOARD = 2
  22.  
  23. Public hHook As Long
  24. Public Hooked As Boolean
  25. Public Key As String
  26.  
  27.  
  28. Public Function KeyboardProc(ByVal nCode As Long, _
  29.                              ByVal wParam As Long, _
  30.                              ByVal lParam As Long) As Long
  31. 'Debug.Print wParam      раскомментировать чтобы посмотреть что будет при нажатии других клавиш
  32.         If wParam = 37 Or wParam = 39 Or wParam = 38 Or wParam = 40 Or wParam = 32 Then
  33.             Hooked = True
  34.             If wParam = 37 Then Key = "Left"
  35.             If wParam = 39 Then Key = "Right"
  36.             If wParam = 38 Then Key = "Up"
  37.             If wParam = 40 Then Key = "Down"
  38.             If wParam = 32 Then Key = "Space"
  39.         End If
  40.    KeyboardProc = CallNextHookEx(hHook, nCode, wParam, lParam)
  41. End Function
  42.  
  43. Sub Start()
  44.  
  45.  Dim i As Long
  46.  Hooked = False
  47.    hHook = SetWindowsHookEx(WH_KEYBOARD, _
  48.                             AddressOf KeyboardProc, _
  49.                             0&, _
  50.                             GetCurrentThreadId)
  51. 'Пока не хукнули (Hooked=true в KeyboardProc)
  52.   While (Not Hooked)
  53.   i = i + 1
  54.   Cells(1, 1) = i
  55. 'Без этого зависает
  56.   DoEvents
  57.   Wend
  58.    Call UnhookWindowsHookEx(hHook)
  59.    MsgBox Key
  60. End Sub

Ответить

Номер ответа: 2
Автор ответа:
 AngryBadger



Вопросов: 33
Ответов: 245
  Профиль | | #2 Добавлено: 01.09.09 20:04
Рано я радовался, никак не могу понять как сделать чтобы в цикле она отжатие кнопки не ловило..... Если я вообще понял как оно работает))) Если кому-нить не лень, откомментируйте построчно - дальше сам разберусь.

Ответить

Номер ответа: 3
Автор ответа:
 GDK



Вопросов: 13
Ответов: 348
  Профиль | | #3 Добавлено: 02.09.09 17:15
  1. Option Explicit
  2.  
  3. Public Declare Function CallNextHookEx Lib "user32" _
  4.    (ByVal hHook As Long, _
  5.    ByVal nCode As Long, _
  6.    ByVal wParam As Long, _
  7.    ByVal lParam As Long) As Long
  8.  
  9. Public Declare Function UnhookWindowsHookEx Lib "user32" _
  10.    (ByVal hHook As Long) As Long
  11.  
  12. Public Declare Function SetWindowsHookEx Lib "user32" _
  13.    Alias "SetWindowsHookExA" _
  14.    (ByVal idHook As Long, _
  15.    ByVal lpfn As Long, _
  16.    ByVal hmod As Long, _
  17.    ByVal dwThreadId As Long) As Long
  18.  
  19. Public Declare Function GetCurrentThreadId Lib "kernel32" () As Long
  20.  
  21. Public Const WH_KEYBOARD = 2
  22.  
  23. Public hHook As Long
  24. Public Hooked As Boolean
  25. Public Key As String
  26.  
  27.  
  28. Public Function KeyboardProc(ByVal nCode As Long, _
  29.                              ByVal wParam As Long, _
  30.                              ByVal lParam As Long) As Long
  31. 'Debug.Print wParam      раскомментировать чтобы посмотреть что будет при нажатии других клавиш
  32.         If wParam = 37 Or wParam = 39 Or wParam = 38 Or wParam = 40 Or wParam = 32 Then
  33.             Hooked = True
  34.             If wParam = 37 Then Key = "Left"
  35.             If wParam = 39 Then Key = "Right"
  36.             If wParam = 38 Then Key = "Up"
  37.             If wParam = 40 Then Key = "Down"
  38.             If wParam = 32 Then Key = "Space"
  39.         End If
  40.    KeyboardProc = CallNextHookEx(hHook, nCode, wParam, lParam)
  41. End Function
  42.  
  43. Sub Start()
  44.  
  45.  Dim i As Long
  46.  
  47.  'Типа
  48.  Do
  49.  
  50.  Hooked = False
  51.  
  52.    hHook = SetWindowsHookEx(WH_KEYBOARD, _
  53.                             AddressOf KeyboardProc, _
  54.                             0&, _
  55.                             GetCurrentThreadId)
  56.                             
  57.                             
  58.     'Пока не хукнули (Hooked=true в KeyboardProc)
  59.   While (Not Hooked)
  60.   i = i + 1
  61.   Cells(1, 1) = i
  62. 'Без этого зависает
  63.   DoEvents
  64.   Wend
  65.   
  66.   
  67.    Call UnhookWindowsHookEx(hHook)
  68.    MsgBox Key
  69.    
  70. 'И типа
  71.  Loop
  72.  
  73.  
  74. End Sub
  75.  
  76.  


Глючит при нажатии пробела. Потому что фиг его знает. Влияние внеземных цивилизаций.
Не стал бы я этим пользоваться.
В любом случае.
Открой диспетчер задач и посмотри на загрузку процессора.

Ответить

Номер ответа: 4
Автор ответа:
 AngryBadger



Вопросов: 33
Ответов: 245
  Профиль | | #4 Добавлено: 02.09.09 17:59
С загрузкой процессора - понятное дело, но пока не смог найти подходящего варианта, как отлавливать эти нажатия - приходится пользоваться.

Ответить

Номер ответа: 5
Автор ответа:
 GDK



Вопросов: 13
Ответов: 348
  Профиль | | #5 Добавлено: 03.09.09 12:53
Может WithEvents попробовать? А пробел не глючит?

Ответить

Номер ответа: 6
Автор ответа:
 AngryBadger



Вопросов: 33
Ответов: 245
  Профиль | | #6 Добавлено: 03.09.09 14:31
Вот нашел еще пример мне кажется он лучше - Space работает. WithEvents - надо посмотреть и подумать.
  1. Private Declare Function Getasynckeystate Lib "user32" Alias "GetAsyncKeyState" (ByVal VKEY As Long) As Integer
  2. Private Const VK_CAPITAL = &H14
  3.  
  4. Sub GeAsKySt()
  5. Do
  6.     keystate = Getasynckeystate(37)
  7.         If (keystate And &H1) = &H1 Then
  8.             Debug.Print "Left"
  9.         End If
  10.     keystate = Getasynckeystate(39)
  11.         If (keystate And &H1) = &H1 Then
  12.             Debug.Print "Right"
  13.         End If
  14.     keystate = Getasynckeystate(38)
  15.         If (keystate And &H1) = &H1 Then
  16.             Debug.Print "Up"
  17.         End If
  18.     keystate = Getasynckeystate(40)
  19.         If (keystate And &H1) = &H1 Then
  20.             Debug.Print "Down"
  21.         End If
  22.     keystate = Getasynckeystate(32)
  23.         If (keystate And &H1) = &H1 Then
  24.             Debug.Print "Space"
  25.         End If
  26.     keystate = Getasynckeystate(13)
  27.         If (keystate And &H1) = &H1 Then
  28.             Debug.Print "Enter"
  29.             Exit Do
  30.         End If
  31. Loop
  32. End Sub

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам