Capslock

[Bobby C. Jones]

Why doesn't this stinking code toggle the stupid capslock light on the
keyboard...it toggles the capslock mode, but not the stupid light!!! Thanks
for your help.

'* * * * * * * * * * *
'Sample call
Public Sub testKB()
Dim oKeyboard As CKeyboard
Set oKeyboard = New CKeyboard
oKeyboard.capsOn = False
Set oKeyboard = Nothing
End Sub

'* * * * * * * * * * *
'CKeyboard Class Module
Option Explicit

Private Const VK_CAPITAL = &H14
Private Const VK_NUMLOCK = &H90
Private Const VK_SCROLL = &H91

Private Type KeyboardBytes
kbByte(0 To 255) As Byte
End Type

Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long)
As Long
Private Declare Function GetKeyboardState Lib "user32" (kbArray As
KeyboardBytes) As Long
Private Declare Function SetKeyboardState Lib "user32" (kbArray As
KeyboardBytes) As Long

Private kbArray As KeyboardBytes

Private Sub setKey(vkKey As Long, onVal As Boolean)
'Get the keyboard state
GetKeyboardState kbArray
'Change a key
kbArray.kbByte(vkKey) = Abs(onVal)
SetKeyboardState kbArray
End Sub

Private Function GetKeyStatus(vkKey As Long) As Boolean
'get the keyboard state
GetKeyboardState kbArray
'get and return the key state
GetKeyStatus = kbArray.kbByte(vkKey)
End Function

Public Property Get capsOn() As Boolean
capsOn = GetKeyStatus(VK_CAPITAL)
End Property

Public Property Let capsOn(ByVal bValue As Boolean)
setKey VK_CAPITAL, bValue
End Property

Public Property Get NumLockOn() As Boolean
capsOn = GetKeyStatus(VK_NUMLOCK)
End Property

Public Property Let NumLockOn(ByVal bValue As Boolean)
setKey VK_NUMLOCK, bValue
End Property

Public Property Get ScrollOn() As Boolean
capsOn = GetKeyStatus(VK_SCROLL)
End Property

Public Property Let ScrollOn(ByVal bValue As Boolean)
setKey VK_SCROLL, bValue
End Property

'* * * * * * * * * * *
'End CKeyboard Class Module
'* * * * * * * * * * *

--
Bobby C. Jones
http://www.acadx.com

[Brian D]

Windows NT ?

Maybe this will help...
http://support.microsoft.com/default.aspx?scid=kb;en-us;Q127190

Brian D.

"Bobby C. Jones" <bob...@acadx.com> wrote in message
news:F1F34B0A58F60488...@in.WebX.maYIadrTaRb...

[David M. Gardner]

I did not look very closely but it looks like the same code I use, and I'm
using WinXP. It works fine for me.

--

Dave Gardner

"Bobby C. Jones" <bob...@acadx.com> wrote in message

news:5CBA24DB028DABA6...@in.WebX.maYIadrTaRb...
> Win2k...Thanks Brian.

> --
> Bobby C. Jones
> http://www.acadx.com
>

> "Brian D" <bcd...@hiwaay.net.{Remove To Reply}> wrote in message
> news:ACAEE503B390685F...@in.WebX.maYIadrTaRb...

[Bobby C. Jones]

Win2k...Thanks Brian.

--
Bobby C. Jones
http://www.acadx.com

"Brian D" <bcd...@hiwaay.net.{Remove To Reply}> wrote in message
news:ACAEE503B390685F...@in.WebX.maYIadrTaRb...

[Bobby C. Jones]

Ok...This is what I've come up with so far. I don't have an XP box to test
this on, so until I can research a little further or until someone says
otherwise I'll just take David's word that this works for XP.

'Example of class usage
Public Sub CKeyboard_Example()
Dim oKeyboard as CKeyboard

Set oKeyboard = New CKeyboard

'Turns on Capslock key
oKeyboard.capsOn = True

If oKeyboard.capsOn Then
MsgBox "Capslock is on"
Else
MsgBox "Capslock is off"
End If

Set oKeyboard = Nothing
End Sub

VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "CKeyboard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Const VK_CAPITAL = &H14
Private Const VK_NUMLOCK = &H90
Private Const VK_SCROLL = &H91

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

Private Type KeyboardBytes
kbByte(0 To 255) As Byte
End Type

Private Type OSVERSIONINFO
dwOSVerInfoSize As Long
dwMajorVer As Long
dwMinorVer As Long
dwBuildNumber As Long
dwPlatformID As Long
szCSDVer As String * 128
End Type

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" (keys As
KeyboardBytes) As Long
Private Declare Function SetKeyboardState Lib "user32" (keys As
KeyboardBytes) As Long

Private keys As KeyboardBytes

'* * * * * * * * * * * * *
'Public Members
'* * * * * * * * * * * * *

Public Property Get capsOn() As Boolean
capsOn = GetKeyStatus(VK_CAPITAL)
End Property

Public Property Let capsOn(ByVal bValue As Boolean)
setKey VK_CAPITAL, bValue
End Property

Public Property Get NumLockOn() As Boolean

NumLockOn = GetKeyStatus(VK_NUMLOCK)
End Property

Public Property Let NumLockOn(ByVal bValue As Boolean)
setKey VK_NUMLOCK, bValue
End Property

Public Property Get ScrollOn() As Boolean

ScrollOn = GetKeyStatus(VK_SCROLL)
End Property

Public Property Let ScrollOn(ByVal bValue As Boolean)
setKey VK_SCROLL, bValue
End Property

'* * * * * * * * * * * * *
'Private functions
'* * * * * * * * * * * * *

Private Sub setKey(vkKey As Long, onVal As Boolean)

Dim OS As OSVERSIONINFO
Dim keyState As Boolean

'get OS info
OS.dwOSVerInfoSize = Len(OS)
GetVersionEX OS

'Get the keyboard state
GetKeyboardState keys

'Get the key state
keyState = keys.kbByte(vkKey)

'Change a key
If keyState <> onVal Then
If OS.dwPlatformID = VER_PLATFORM_WIN32_NT Then
'simulate key press
keybd_event vkKey, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
'simulate key release
keybd_event vkKey, &H45, KEYEVENTF_EXTENDEDKEY Or
KEYEVENTF_KEYUP, 0
Else
keys.kbByte(vkKey) = Abs(onVal)
SetKeyboardState keys
End If
End If
End Sub

Private Function GetKeyStatus(vkKey As Long) As Boolean
'get the keyboard state

GetKeyboardState keys

'get and return the key state

GetKeyStatus = keys.kbByte(vkKey)
End Function

[David M. Gardner]

Well here is the code I use. Somone else wrote it. And I can't remember
who. One of the problems with this code is that the Office Shortcut Bar
does not work correct. You have to make AutoCAD not active then you can
click a button. And after more of look (still not line for line compare)
the 2 code look more different. If you look for this post there is more
info on the code I'm giving you: "AutoCAD 2002 activate/deactivate" posted
on Feb. 25, 2002.

Public WithEvents ACADApp As AcadApplication

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

Const VK_CAPITAL = &H14
Const KEYEVENTF_EXTENDEDKEY = &H1
Const KEYEVENTF_KEYUP = &H2

Dim keys(0 To 255) As Byte

Sub ACADStartup()
Set ACADApp = GetObject(, "AutoCAD.Application")
Call ACADApp_AppActivate
End Sub

Private Sub ACADApp_AppActivate()
GetKeyboardState keys(0)
keybd_event VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
keybd_event VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY _
Or KEYEVENTF_KEYUP, 0
End Sub

Private Sub ACADApp_AppDeactivate()
GetKeyboardState keys(0)
keybd_event VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
keybd_event VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY _
Or KEYEVENTF_KEYUP, 0
End Sub

--

Dave Gardner

"Bobby C. Jones" <bob...@acadx.com> wrote in message

news:A19CCBAA1FDB3798...@in.WebX.maYIadrTaRb...