ник: ДрЮня
не мое - просто выкладываю
Attribute VB_Name = "basKeys"
Option Explicit
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
Private Declare Function SetKeyboardState Lib "user32" (lppbKeyState As Byte) As Long
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
(ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, _
ByVal fuWinIni As Long) As Long
' Возвращает True если клавиша Ctrl нажата
Function CtrlKey() As Boolean
CtrlKey = (GetAsyncKeyState(vbKeyControl) And &H8000)
End Function
' Возвращает True если клавиша Shift нажата
Function ShiftKey() As Boolean
ShiftKey = (GetAsyncKeyState(vbKeyShift) And &H8000)
End Function
' Возвращает True если клавиша Alt нажата
Function AltKey() As Boolean
AltKey = (GetAsyncKeyState(vbKeyMenu) And &H8000)
End Function
' Возвращает True если нажаты запрашиваемые клавиши
'MsgBox KeysPressed(vbKeyRButton) - нажата ли правая клавиша мыши?
Function KeysPressed(ByVal KeyCode1 As KeyCodeConstants, Optional ByVal KeyCode2 As KeyCodeConstants, Optional ByVal KeyCode3 As KeyCodeConstants) As Boolean
If GetAsyncKeyState(KeyCode1) >= 0 Then Exit Function
If KeyCode2 = 0 Then KeysPressed = True: Exit Function
If GetAsyncKeyState(KeyCode2) >= 0 Then Exit Function
If KeyCode3 = 0 Then KeysPressed = True: Exit Function
If GetAsyncKeyState(KeyCode3) >= 0 Then Exit Function
KeysPressed = True
End Function
'узнать состояние CapsLock.
'Вызов функции: MsgBox GetCapsLock . Если True - то включена, если False - выключена
Function GetCapsLock() As Boolean
GetCapsLock = GetKeyState(vbKeyCapital)
End Function
'Изменение состояния CapsLock:
' SetCapsLock True - включено
' SetCapsLock False - выключено
Sub SetCapsLock(ByVal newValue As Boolean)
' get current state of all 256 virtual keys
Dim keystat(0 To 255) As Byte
GetKeyboardState keystat(0)
' modify bit 0 of the relevant item, and store back
keystat(vbKeyCapital) = (keystat(vbKeyCapital) And &HFE) Or (newValue And 1)
SetKeyboardState keystat(0)
End Sub
' узнать состояние ScrollLock.
'MsgBox GetScrollLock. Если True - то включена, если False - выключена
Function GetScrollLock() As Boolean
Dim keystat(0 To 255) As Byte
GetKeyboardState keystat(0)
GetScrollLock = (keystat(vbKeyScrollLock) And 1)
End Function
' Изменение состояния ScrollLock.
' SetScrollLock True - включено
' SetScrollLock False - выключено
Sub SetScrollLock(ByVal newValue As Boolean)
Dim keystat(0 To 255) As Byte
GetKeyboardState keystat(0)
keystat(vbKeyScrollLock) = (keystat(vbKeyScrollLock) And &HFE) Or (newValue And 1)
SetKeyboardState keystat(0)
End Sub
' узнать состояние NumLock.
'MsgBox GetNumLock. Если True - то включена, если False - выключена
Function GetNumLock() As Boolean
Dim keystat(0 To 255) As Byte
GetKeyboardState keystat(0)
GetNumLock = (keystat(vbKeyNumlock) And 1)
End Function
' Изменение состояния NumLock
' SetNumLock True - включено
' SetNumLock False - выключено
Sub SetNumLock(ByVal newValue As Boolean)
Dim keystat(0 To 255) As Byte
GetKeyboardState keystat(0)
keystat(vbKeyNumlock) = (keystat(vbKeyNumlock) And &HFE) Or (newValue And 1)
SetKeyboardState keystat(0)
End Sub
' узнать состояние Insert Key.
'MsgBox GetInsertKey. Если True - то включена, если False - выключена
Function GetInsertKey() As Boolean
Dim keystat(0 To 255) As Byte
GetKeyboardState keystat(0)
GetInsertKey = (keystat(vbKeyInsert) And 1)
End Function
' Изменение состояния Insert Key
' SetInsertKey True - включено
' SetInsertKey False - выключено
Sub SetInsertKey(ByVal newValue As Boolean)
Dim keystat(0 To 255) As Byte
GetKeyboardState keystat(0)
keystat(vbKeyInsert) = (keystat(vbKeyInsert) And &HFE) Or (newValue And 1)
SetKeyboardState keystat(0)
End Sub