topic Re: in VBA Forum

Capslock

Anonymous — Fri, 12 Apr 2002 11:52:17 GMT

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

Re: Capslock

Anonymous — Fri, 12 Apr 2002 12:03:21 GMT

Windows NT ?

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

Brian D.

"Bobby C. Jones" wrote in message
news:F1F34B0A58F60488ECE329A052A29749@in.WebX.maYIadrTaRb...
> 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
>
>
>

Re:

Anonymous — Fri, 12 Apr 2002 12:18:09 GMT

Win2k...Thanks Brian.
--
Bobby C. Jones
http://www.acadx.com

"Brian D" wrote in message
news:ACAEE503B390685F354A38CADD430524@in.WebX.maYIadrTaRb...
> Windows NT ?
>
> Maybe this will help...
> http://support.microsoft.com/default.aspx?scid=kb;en-us;Q127190
>
> Brian D.
>
>
> "Bobby C. Jones" wrote in message
> news:F1F34B0A58F60488ECE329A052A29749@in.WebX.maYIadrTaRb...
> > 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
> >
> >
> >
>
>

Re:

Anonymous — Fri, 12 Apr 2002 12:37:06 GMT

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" wrote in message
news:5CBA24DB028DABA6F5491363223B53DB@in.WebX.maYIadrTaRb...
> Win2k...Thanks Brian.
> --
> Bobby C. Jones
> http://www.acadx.com
>
> "Brian D" wrote in message
> news:ACAEE503B390685F354A38CADD430524@in.WebX.maYIadrTaRb...
> > Windows NT ?
> >
> > Maybe this will help...
> > http://support.microsoft.com/default.aspx?scid=kb;en-us;Q127190
> >
> > Brian D.
> >
> >
> > "Bobby C. Jones" wrote in message
> > news:F1F34B0A58F60488ECE329A052A29749@in.WebX.maYIadrTaRb...
> > > 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
> > >
> > >
> > >
> >
> >
>
>

Re: Capslock

Anonymous — Sat, 13 Apr 2002 09:33:47 GMT

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

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

Re:

Anonymous — Mon, 15 Apr 2002 04:41:17 GMT

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" wrote in message
news:A19CCBAA1FDB37984BC0DE56DF909E20@in.WebX.maYIadrTaRb...
> 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
>
> --
> Bobby C. Jones
> http://www.acadx.com
>
>
>