title image


Smiley Re: CAPSLOCK aktiviert?
Das geht über die API:



' 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 ' "Service Pack xx"

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



' Constant declarations:

Const VK_NUMLOCK = &H90

Const VK_SCROLL = &H91

Const VK_SHIFT = &H10

Const VK_CAPITAL = &H14

Const VK_LSHIFT = &HA0

Const VK_RSHIFT = &HA1

Const KEYEVENTF_EXTENDEDKEY = &H1

Const KEYEVENTF_KEYUP = &H2

Const VER_PLATFORM_WIN32_S = 0

Const VER_PLATFORM_WIN32_WINDOWS = 1 ' Windows 9x

Const VER_PLATFORM_WIN32_NT = 2 ' Windows NT or 2000



Public Function IsAnyShiftSet() As Boolean

Dim keys(255) As Byte

GetKeyboardState keys(0)



IsAnyShiftSet = keys(VK_RSHIFT) 0 Or keys(VK_LSHIFT) 0

End Function



Public Function IsCapsSet() As Boolean

Dim keys(255) As Byte

GetKeyboardState keys(0)



IsCapsSet = (keys(VK_CAPITAL) 0)

End Function



Public Function IsShiftSet() As Boolean

Dim keys(255) As Byte

GetKeyboardState keys(0)



IsShiftSet = (keys(VK_SHIFT) 0)

End Function



Public Function IsScrollLockSet() As Boolean

Dim keys(255) As Byte

GetKeyboardState keys(0)



IsScrollLockSet = (keys(VK_SCROLL) 0)

End Function



Public Function SetCapsLock(SetIt As Boolean)

Dim O As OSVERSIONINFO

Dim KeyStat As Boolean

Dim keys(0 To 255) As Byte



O.dwOSVersionInfoSize = Len(O)

GetVersionEx O

If IsCapsSet() Xor SetIt Then 'Turn Scroll lock on

If O.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then '=== Win95/98

keys(VK_SCROLL) = 1

SetKeyboardState keys(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

End Function



Public Function SetScrollLock(SetIt As Boolean)

Dim O As OSVERSIONINFO

Dim KeyStat As Boolean

Dim keys(0 To 255) As Byte



O.dwOSVersionInfoSize = Len(O)

GetVersionEx O

If IsScrollLockSet() Xor SetIt Then 'Turn Scroll lock on

If O.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then '=== Win95/98

keys(VK_SCROLL) = 1

SetKeyboardState keys(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 Function



Public Function KeyState(VK As Byte, State As Byte)

Dim O As OSVERSIONINFO

Dim KeyStat As Boolean



O.dwOSVersionInfoSize = Len(O)

GetVersionEx O

Dim keys(0 To 255) As Byte

GetKeyboardState keys(0)



KeyStat = keys(VK) And 1

If KeyStat State Then 'Toggle key on

If O.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then '===== Win95

keys(VK) = State

SetKeyboardState keys(0)

ElseIf O.dwPlatformId = VER_PLATFORM_WIN32_NT Then '===== WinNT

'Simulate Key Press

keybd_event VK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0

'Simulate Key Release

keybd_event VK, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0

End If

End If

End Function



Gruß aus dem Norden
Reinhard


Bitte immer die Access-Version angeben!
DB-Wiki


Wie man Fragen richtig stellt

YaccessAccess-FAQUnd ansonsten: Wikipedia




geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: