Drew Wutka
DWUTKA at Marlow.com
Wed Mar 26 14:54:02 CDT 2008
Keyboard Class:
Option Explicit
' Declare Type for API call:
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128 ' Maintenance string for PSS usage
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)
' Keyboard support functions.
' NOTE: Setting the toggle states will NOT affect the
' keyboard lights. These changes merely affect the current
' process, not the entire machine.
' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.
' Not all VBA implementations include this constant!
Private Const vbKeyScrollLock = 145
Private Const SPI_GETKEYBOARDDELAY = 22
Private Const SPI_SETKEYBOARDDELAY = 23
Private Const SPI_GETKEYBOARDSPEED = 10
Private Const SPI_SETKEYBOARDSPEED = 11
Const VK_NUMLOCK = &H90
Const VK_SCROLL = &H91
Const VK_CAPITAL = &H14
Const KEYEVENTF_EXTENDEDKEY = &H1
Const KEYEVENTF_KEYUP = &H2
Const VER_PLATFORM_WIN32_NT = 2
Const VER_PLATFORM_WIN32_WINDOWS = 1
' 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
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 Declare Function GetCaretBlinkTime Lib "user32" () As Long
Private Declare Function SetCaretBlinkTime Lib "user32" (ByVal wMSeconds
As Long) As Long
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))
Dim o As OSVERSIONINFO
Dim NumLockState As Boolean
Dim ScrollLockState As Boolean
Dim CapsLockState As Boolean
o.dwOSVersionInfoSize = Len(o)
GetVersionEx o
Dim keys(0 To 255) As Byte
GetKeyboardState keys(0)
' NumLock handling:
NumLockState = keys(VK_NUMLOCK)
If intKey = vbKeyNumlock Then 'Turn numlock on
If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then '===== Win95
Call GetKeyboardState(abytBuffer(0))
abytBuffer(intKey) = CByte(Abs(fTurnOn))
Call SetKeyboardState(abytBuffer(0))
ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then '===== WinNT
'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
' CapsLock handling:
CapsLockState = keys(VK_CAPITAL)
If intKey = vbKeyCapital Then 'Turn capslock on
If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then '===== Win95
Call GetKeyboardState(abytBuffer(0))
abytBuffer(intKey) = CByte(Abs(fTurnOn))
Call SetKeyboardState(abytBuffer(0))
ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then '===== WinNT
'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
' ScrollLock handling:
ScrollLockState = keys(VK_SCROLL)
If intKey = vbKeyScrollLock Then 'Turn Scroll lock on
If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then '===== Win95
Call GetKeyboardState(abytBuffer(0))
abytBuffer(intKey) = CByte(Abs(fTurnOn))
Call SetKeyboardState(abytBuffer(0))
ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then '===== WinNT
'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
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
-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Rocky Smolin
at Beach Access Software
Sent: Wednesday, March 26, 2008 2:04 PM
To: 'Access Developers discussion and problem solving'
Subject: [AccessD] Num Lock
Dear List:
I need to see if the NumLock key is on, and if not, set it on (stops the
bound form from moving to another record when 3 or 9 is pressed).
I see where you can use SendKeys to send {NUMLOCK} but of course the
popular
wisdom is not to use SendKeys.
No help from help.
Is there a way to poll and set the NumLock through vba?
MTIA
Rocky
--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com
The information contained in this transmission is intended only for the person or entity to which it is addressed and may contain II-VI Proprietary and/or II-VI Business Sensitive material. If you are not the intended recipient, please contact the sender immediately and destroy the material in its entirety, whether electronic or hard copy. You are notified that any review, retransmission, copying, disclosure, dissemination, or other use of, or taking of any action in reliance upon this information by persons or entities other than the intended recipient is prohibited.