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

'**************************************
' 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

解决方案 »

  1.   

    Option ExplicitPrivate 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 LongPrivate Const KEYEVENTF_EXTENDEDKEY = &H1
    Private Const KEYEVENTF_KEYUP = &H2Private 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 SubPrivate Property Get CapsLock() As Boolean
          
      CapsLock = GetKeyState(KeyCodeConstants.vbKeyCapital) = 1
      
    End PropertyPrivate Property Let CapsLock(ByVal Value As Boolean)
      
      Call SetKeyState(KeyCodeConstants.vbKeyCapital, Value)
      
    End PropertyPrivate Property Get NumLock() As Boolean  NumLock = GetKeyState(KeyCodeConstants.vbKeyNumlock) = 1
        
    End PropertyPrivate Property Let NumLock(ByVal Value As Boolean)  Call SetKeyState(KeyCodeConstants.vbKeyNumlock, Value)End PropertyPrivate Property Get ScrollLock() As Boolean  ScrollLock = GetKeyState(KeyCodeConstants.vbKeyScrollLock) = 1End PropertyPrivate Property Let ScrollLock(ByVal Value As Boolean)
      
      Call SetKeyState(KeyCodeConstants.vbKeyScrollLock, Value)End PropertyPrivate Sub CommandCapsLock_Click()
      CapsLock = Not CapsLock
    End SubPrivate Sub CommandNumLock_Click()
      NumLock = Not NumLock
    End SubPrivate Sub CommandScroll_Click()
      ScrollLock = Not ScrollLock
      
    End SubPrivate Sub Timer1_Timer()
      CommandCapsLock.Font.Bold = CapsLock
      CommandNumLock.Font.Bold = NumLock
      CommandScrollLock.Font.Bold = ScrollLock
    End Sub
      

  2.   

    Option ExplicitPrivate 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 LongPrivate 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 LongPrivate Declare Function SetKeyboardState Lib "user32" _
       (lppbKeyState As Byte) As LongPublic 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 ExplicitPrivate 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 = &H2Private 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 LongPrivate 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 LongPrivate 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 ExplicitPrivate 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 = &H2Private 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 LongPrivate 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 LongPrivate 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