如何检测以及设置键盘状态

Const KEYEVENTF_EXTENDEDKEY = &H1
Const KEYEVENTF_KEYUP = &H2

Public Sub SetNumLock(ByVal bLock As Boolean)
Dim i As Boolean, ScanCode As Long
i = CBool(GetKeyState(vbKeyNumlock) And vbShiftMask)
If i <> bLock Then
   ScanCode = MapVirtualKey(vbKeyNumlock, 0)
   Call keybd_event(vbKeyNumlock, ScanCode, 0, 0)
   Call keybd_event(vbKeyNumlock, ScanCode, KEYEVENTF_KEYUP, 0)
End If
End Sub
Public Sub SetScrollLock(ByVal bLock As Boolean)
Dim i As Boolean, ScanCode As Long
i = CBool(GetKeyState(vbKeyScrollLock) And vbShiftMask)
If i <> bLock Then
   ScanCode = MapVirtualKey(vbKeyScrollLock, 0)
   Call keybd_event(vbKeyScrollLock, ScanCode, 0, 0)
   Call keybd_event(vbKeyScrollLock, ScanCode, KEYEVENTF_KEYUP, 0)
End If
End Sub
Public Sub SetCapsLock(ByVal bLock As Boolean)
Dim i As Boolean, ScanCode As Long
i = CBool(GetKeyState(vbKeyCapital) And vbShiftMask)
If i <> bLock Then
   ScanCode = MapVirtualKey(vbKeyCapital, 0)
   Call keybd_event(vbKeyCapital, ScanCode, 0, 0)
   Call keybd_event(vbKeyCapital, ScanCode, KEYEVENTF_KEYUP, 0)
End If
End Sub

Private Sub Command1_Click()
Call SetNumLock(True)
End Sub

'若要設定CapsLock只要使用
'setKeyState VK_CAPITAL, True
'解除的話只要使用
'setKeyState VK_CAPITAL, False

Private Declare Function GetKeyboardType Lib "user32" _
(ByVal lngTypeFlag As Long) As Long

Private Declare Function GetKeyState Lib "user32" _
(ByVal lngVirtKey As Long) As Integer

Private Declare Function GetKeyboardState Lib "user32" _
(bytKeyState As Byte) As Long

Private Declare Function SetKeyboardState Lib "user32" _
(bytKeyState As Byte) As Long

Private Const vbKeyScrollLock = 145

Private Const SPI_GETKEYBOARDDELAY = 22

Private Const SPI_SETKEYBOARDDELAY = 23

Private Const SPI_GETKEYBOARDSPEED = 10

Private Const SPI_SETKEYBOARDSPEED = 11

'SystemParametersInfo flags

Private Const SPIF_UPDATEINIFILE = &H1

Private Const SPIF_SENDWININICHANGE = &H2

Private Declare Function SystemParametersInfo Lib _
"user32" Alias "SystemParametersInfoA" ( _
ByVal uAction As Long, ByVal uParam As Long, _
lpvParam As Any, ByVal fuWinIni As Long) As Long

' This is a made-up constant.

Private Const SPIF_TELLALL = SPIF_UPDATEINIFILE Or _
SPIF_SENDWININICHANGE

Property Get KeyboardType() As Long

' Determine the type of keyboard on the system.

' 1 IBM PC/XT or compatible (83-key) keyboard

' 2 Olivetti "ICO" (102-key) keyboard

' 3 IBM PC/AT (84-key) or similar keyboard

' 4 IBM enhanced (101- or 102-key) keyboard

' 5 Nokia 1050 and similar keyboards

' 6 Nokia 9140 and similar keyboards

' 7 Japanese keyboard

KeyboardType = GetKeyboardType(0)

End Property

Property Get FunctionKeys() As Long

' Determine the number of function keys on the keyboard.

' 1 10

' 2 12 (sometimes 18)

' 3 10

' 4 12

' 5 10

' 6 24

' 7 Hardware dependent and specified by the OEM

FunctionKeys = GetKeyboardType(2)

End Property

Property Get Capslock() As Boolean

'Return the Capslock toggle.

Capslock = CBool(GetKeyState(vbKeyCapital) And 1)

End Property

Property Get Numlock() As Boolean

' Return the Numlock toggle.

Numlock = CBool(GetKeyState(vbKeyNumlock) And 1)

End Property

Property Get ScrollLock() As Boolean

' Return the ScrollLock toggle.

ScrollLock = CBool(GetKeyState(vbKeyScrollLock) And 1)

End Property

Property Let Capslock(Value As Boolean)

' Set the Capslock toggle.

Call setKeyState(vbKeyCapital, Value)

End Property

Property Let Numlock(Value As Boolean)

' Set the Numlock toggle.

Call setKeyState(vbKeyNumlock, Value)

End Property

Property Let ScrollLock(Value As Boolean)

' Set the ScrollLock toggle.

Call setKeyState(vbKeyScrollLock, Value)

End Property

Private Sub setKeyState(intKey As Integer, fTurnOn As Boolean)

' Retrieve the keyboard state, set the particular

' key in which you're interested, and then set

' the entire keyboard state back the way it

' was, with the one key altered.

Dim abytBuffer(0 To 255) As Byte

Call GetKeyboardState(abytBuffer(0))

abytBuffer(intKey) = CByte(Abs(fTurnOn))

Call SetKeyboardState(abytBuffer(0))

End Sub

Property Let Delay(Value As Long)

' Sets the keyboard repeat-delay setting.

' Only values 0 through 3 are acceptable. Others will be

' set back to 0.

Call SystemParametersInfo(SPI_SETKEYBOARDDELAY, Value, 0, SPIF_TELLALL)

End Property

Property Get Delay() As Long

Dim lngValue As Long

Call SystemParametersInfo(SPI_GETKEYBOARDDELAY, 0, lngValue, 0)

Delay = lngValue

End Property

Property Let Speed(Value As Long)

' Sets the keyboard repeat-speed setting.

' Only values 0 through 31 are acceptable. Others will

' be set back to 0.

Call SystemParametersInfo(SPI_SETKEYBOARDSPEED, Value, 0, SPIF_TELLALL)

End Property

Property Get Speed() As Long

' Get the keyboard repeat-speed setting.

Dim lngValue As Long

Call SystemParametersInfo(SPI_GETKEYBOARDSPEED, 0, lngValue, 0)

Speed = lngValue

End Property

Property Get CaretBlinkTime() As Long

' Retrieve the number of milliseconds

' between blinks of the caret.

' SYSTEM RESOURCE. Change this with care.

CaretBlinkTime = GetCaretBlinkTime()

End Property

Property Let CaretBlinkTime(Value As Long)

' Set the number of milliseconds

' between blinks of the caret.

' SYSTEM RESOURCE. Change this with care.

' Allowable values: 200 to 1200 (multiples of 100)

Call SetCaretBlinkTime(Value)

End Property