如何在VB中控制Num lock,Caps lock和 Scroll lock

[ShiningstarHu]

如题

[用户 昵称]

'**************************************
' Name: CapsLock and NumLock
' Description:How to Activate CapsLock a
' nd NumLock from Code
' By: Ian Ippolito (RAC)
'
' Assumes:The keyboard APIs for VB4-16 a
' nd VB3 do not support the byte data type
' .
By changing the Windows constant To Public Const VK_NUMLOCK = &H90, you can use the above to activate the NumLock key.
'
'This code is copyrighted and has' limited warranties.Please see http://w
' ww.Planet-Source-Code.com/xq/ASP/txtCode
' Id.242/lngWId.1/qx/vb/scripts/ShowCode.h
' tm'for details.'**************************************

On a form, add a 3 command buttons (cmdToggle, cmdTurnOff, cmdTurnOff) and a label. Add the following code to the form:


Private Function CapsLock() As Integer
CapsLock = GetKeyState(VK_CAPITAL) And 1 = 1
End Function


Private Sub Form_Load()
If CapsLock() = 1 Then Label1 = "On" Else Label1 = "Off"
End Sub


Private Sub cmdToggle_Click()
GetKeyboardState kbArray
kbArray.kbByte(VK_CAPITAL) = IIf(kbArray.kbByte(VK_CAPITAL) = 1, 0, 1)
SetKeyboardState kbArray
Label1 = IIf(CapsLock() = 1, "On", "Off")
End Sub


Private Sub cmdTurnOn_Click()
GetKeyboardState kbArray
kbArray.kbByte(VK_CAPITAL) = 1
SetKeyboardState kbArray
Label1 = IIf(CapsLock() = 1, "On", "Off")
End Sub


Private Sub cmdTurnOff_Click()
GetKeyboardState kbArray
kbArray.kbByte(VK_CAPITAL) = 0
SetKeyboardState kbArray
Label1 = IIf(CapsLock() = 1, "On", "Off")
End Sub

[用户 昵称]

Option Explicit

Private Declare Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, ByVal bScan As Byte, _
ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Declare Function MapVirtualKey Lib "user32" _
Alias "MapVirtualKeyA" _
(ByVal wCode As Long, ByVal wMapType As Long) As Long

Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2

Private Sub SetKeyState(ByVal Key As Long, ByVal State As Boolean)

Call keybd_event(Key, MapVirtualKey(Key, 0), _
KEYEVENTF_EXTENDEDKEY Or 0, 0)

Call keybd_event(Key, MapVirtualKey(Key, 0), _
KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)

End Sub

Private Property Get CapsLock() As Boolean

CapsLock = GetKeyState(KeyCodeConstants.vbKeyCapital) = 1

End Property

Private Property Let CapsLock(ByVal Value As Boolean)

Call SetKeyState(KeyCodeConstants.vbKeyCapital, Value)

End Property

Private Property Get NumLock() As Boolean

NumLock = GetKeyState(KeyCodeConstants.vbKeyNumlock) = 1

End Property

Private Property Let NumLock(ByVal Value As Boolean)

Call SetKeyState(KeyCodeConstants.vbKeyNumlock, Value)

End Property

Private Property Get ScrollLock() As Boolean

ScrollLock = GetKeyState(KeyCodeConstants.vbKeyScrollLock) = 1

End Property

Private Property Let ScrollLock(ByVal Value As Boolean)

Call SetKeyState(KeyCodeConstants.vbKeyScrollLock, Value)

End Property

Private Sub CommandCapsLock_Click()
CapsLock = Not CapsLock
End Sub

Private Sub CommandNumLock_Click()
NumLock = Not NumLock
End Sub

Private Sub CommandScroll_Click()
ScrollLock = Not ScrollLock

End Sub

Private Sub Timer1_Timer()
CommandCapsLock.Font.Bold = CapsLock
CommandNumLock.Font.Bold = NumLock
CommandScrollLock.Font.Bold = ScrollLock
End Sub

[用户 昵称]

Option Explicit

Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VK_CAPITAL = &H14
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2


Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

' API declarations:

Private Declare Function GetVersionEx Lib "kernel32" _
Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long

Private Declare Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

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

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

Public Sub ToggleCapsLock(TurnOn As Boolean)

'To turn capslock on, set turnon to true
'To turn capslock off, set turnon to false

Dim bytKeys(255) As Byte
Dim bCapsLockOn As Boolean

'Get status of the 256 virtual keys
GetKeyboardState bytKeys(0)

bCapsLockOn = bytKeys(VK_CAPITAL)
Dim typOS As OSVERSIONINFO

If bCapsLockOn <> TurnOn Then 'if current state <>
'requested stae

If typOS.dwPlatformId = _
VER_PLATFORM_WIN32_WINDOWS Then '=== Win95/98

bytKeys(VK_CAPITAL) = 1
SetKeyboardState bytKeys(0)

Else '=== WinNT/2000

'Simulate Key Press
keybd_event VK_CAPITAL, &H45, _
KEYEVENTF_EXTENDEDKEY Or 0, 0
'Simulate Key Release
keybd_event VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY _
Or KEYEVENTF_KEYUP, 0
End If
End If


End Sub
===============================================================

Option Explicit

Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VK_NUMLOCK = &H90
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2

Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
' API declarations:

Private Declare Function GetVersionEx Lib "kernel32" _
Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long

Private Declare Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

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

Private Declare Function SetKeyboardState Lib "user32" _
(lppbKeyState As Byte) As Long
Public Sub ToggleNumLock(TurnOn As Boolean)

'To turn numlock on, set turnon to true
'To turn numlock off, set turnon to false

Dim bytKeys(255) As Byte
Dim bnumLockOn As Boolean

'Get status of the 256 virtual keys
GetKeyboardState bytKeys(0)

bnumLockOn = bytKeys(VK_NUMLOCK)
Dim typOS As OSVERSIONINFO

If bnumLockOn <> TurnOn Then 'if current state <>
'requested stae

If typOS.dwPlatformId = _
VER_PLATFORM_WIN32_WINDOWS Then '=== Win95/98

bytKeys(VK_NUMLOCK) = 1
SetKeyboardState bytKeys(0)

Else '=== WinNT/2000

'Simulate Key Press
keybd_event VK_NUMLOCK, &H45, _
KEYEVENTF_EXTENDEDKEY Or 0, 0
'Simulate Key Release
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY _
Or KEYEVENTF_KEYUP, 0
End If
End If

End Sub
======================================================
Option Explicit

Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VK_SCROLL = &H91
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2

Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

' API declarations:

Private Declare Function GetVersionEx Lib "kernel32" _
Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long

Private Declare Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

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

Private Declare Function SetKeyboardState Lib "user32" _
(lppbKeyState As Byte) As Long
Public Sub ToggleScrollLock(TurnOn As Boolean)

'To turn ScrollLock on, set turnon to true
'To turn ScrollLock off, set turnon to false

Dim bytKeys(255) As Byte
Dim bScrollLockOn As Boolean

'Get status of the 256 virtual keys
GetKeyboardState bytKeys(0)

bScrollLockOn = bytKeys(VK_SCROLL)
Dim typOS As OSVERSIONINFO

If bScrollLockOn <> TurnOn Then 'if current state <>
'requested stae

If typOS.dwPlatformId = _
VER_PLATFORM_WIN32_WINDOWS Then '=== Win95/98

bytKeys(VK_SCROLL) = 1
SetKeyboardState bytKeys(0)

Else '=== WinNT/2000

'Simulate Key Press
keybd_event VK_SCROLL, &H45, _
KEYEVENTF_EXTENDEDKEY Or 0, 0
'Simulate Key Release
keybd_event VK_SCROLL, &H45, KEYEVENTF_EXTENDEDKEY _
Or KEYEVENTF_KEYUP, 0
End If
End If

End Sub

[ShiningstarHu]

Thanks a lot