dotNETportal.cz

Zdravím, snažím se ve svém programu vypnout numerickou klávesnici, ale starý kód z VB6 nefunguje v VB.NET 2008. Poradil by nekdo?

Až budu doma, vložím sem i nefunkční kód.

Za rady děkuji předem.

Jedine Win Api.

Mělo by to jít pomocí metody SendKeys.Send("{NUMLOCK}"), ale z nějakého neznámého důvodu to nefunguje (jiné klávesy fungují).

Zajímavé. Přes skriptovací COM rozhraní to funguje, pomocí .NET metody ne...

Přesně tak. Děkuji za potvrzení mého přesvědčení.

NET.Framework má ještě mouchy.

Teraz mi nie je jasné. Potrebovali ste poradiť alebo iba sa utvrdiť, že NET.Framework má muchy?

Zdravím,

potřeboval jsem poradit jinou cestu ve Frameworku, ale zjistil jsem , že jiná bohužel není.

Možte prezradiť, prečo Vám uvedený kód nevyhovuje?

Ještě jeden velice zajímavý poznatek: Odesílání stisknutých kláves pomocí metody SendKeys COM objektu WshShell FUNGUJE GLOBÁLNĚ, lze to tedy použít místo poměrně komplikovaného Windows API. Jinak řečeno takto "stisknuté" klávesy se odesílají i do ostatních aplikací.

Přikládám původní kód z VB6.0

Deklarace:

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

      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_CAPITAL = &H14
      Const KEYEVENTF_EXTENDEDKEY = &H1
      Const KEYEVENTF_KEYUP = &H2
      Const VER_PLATFORM_WIN32_NT = 2
      Const VER_PLATFORM_WIN32_WINDOWS = 1

Kód pro tlačítko:

 Private Sub Command1_Click()
      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 NumLockState <> True Then    'Turn numlock on
        If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then  '=== Win95/98

          keys(VK_NUMLOCK) = 1
          SetKeyboardState keys(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 CapsLockState <> True Then    'Turn capslock on
        If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then  '=== Win95/98
          keys(VK_CAPITAL) = 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

      ' ScrollLock handling:
      ScrollLockState = keys(VK_SCROLL)
      If ScrollLockState <> True 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 Sub

Stále nechápem, prečo Vám nevyhovuje kód, ktorý som uviedol. Podobný možete použiť aj pre CapsLock a myslím, že aj ScrollLock.

Také bych se přikláněl k použití toho Scripting COM objektu místo výše uvedeného API...

Win API pre VB .NET

Imports WindowsApplication1.KeyboardFunctions
Public Class Form1
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
    Handles Button1.Click, Button2.Click, Button3.Click
        Dim myKey As ToggleKey
        Dim btn As Button = CType(sender, Button)
        Select Case btn.Name
            Case "Button1" : myKey = ToggleKey.NumLock
            Case "Button2" : myKey = ToggleKey.CapsLock
            Case "Button3" : myKey = ToggleKey.ScrollLock
        End Select
        Dim myState As KeyToggleStatus = ToggleKeyControl.GetLockStatus(myKey)
        Select Case myState
            Case KeyToggleStatus.StatusOn
                myState = KeyToggleStatus.StatusOff
                sender.BackColor = SystemColors.Control
            Case KeyToggleStatus.StatusOff
                myState = KeyToggleStatus.StatusOn
                sender.BackColor = Color.LightGreen
        End Select
        ToggleKeyControl.SetLock(myKey, myState)
    End Sub
End Class

Namespace KeyboardFunctions
    Public Enum KeyToggleStatus As Integer
        StatusOn = 0
        StatusOff
    End Enum

    Public Enum ToggleKey As Integer
        CapsLock = 0
        NumLock
        ScrollLock
    End Enum

    Public Class ToggleKeyControl
        ' Constant declarations:
        Public Const VK_NUMLOCK As Short = &H90S
        Public Const VK_SCROLL As Short = &H91S
        Public Const VK_CAPITAL As Short = &H14S
        Public Const KEYEVENTF_EXTENDEDKEY As Short = &H1S
        Public Const KEYEVENTF_KEYUP As Short = &H2S
        Public Const VER_PLATFORM_WIN32_NT As Short = 2
        Public Const VER_PLATFORM_WIN32_WINDOWS As Short = 1

        Private Structure OSVERSIONINFO
            Dim dwOSVersionInfoSize As Integer
            Dim dwMajorVersion As Integer
            Dim dwMinorVersion As Integer
            Dim dwBuildNumber As Integer
            Dim dwPlatformId As Integer
            <VBFixedString(128), System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValTStr, SizeConst:=128)> Public szCSDVersion As String '  Maintenance string for PSS usage
        End Structure

        ' API declarations:
        Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Integer
        Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Integer, ByVal dwExtraInfo As Integer)
        Private Declare Function GetKeyboardState Lib "user32" (ByRef pbKeyState As Byte) As Integer
        Private Declare Function SetKeyboardState Lib "user32" (ByRef lppbKeyState As Byte) As Integer

        Public Shared Sub SetLock(ByVal targetKey As ToggleKey, ByVal status As KeyToggleStatus)
            Dim o As OSVERSIONINFO
            o.dwOSVersionInfoSize = Len(o)
            GetVersionEx(o)
            Dim keys(255) As Byte
            Dim index As Short
            GetKeyboardState(keys(0))
            If GetLockStatus(targetKey) = status Then
                'Nothing to do as the required status is already set
            Else
                Select Case targetKey
                    Case ToggleKey.CapsLock : index = VK_CAPITAL
                    Case ToggleKey.NumLock : index = VK_NUMLOCK
                    Case ToggleKey.ScrollLock : index = VK_SCROLL
                End Select
                If status = KeyToggleStatus.StatusOn Then
                    If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then '=== Win95/98/XP
                        keys(index) = 1
                        SetKeyboardState(keys(0))
                    ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then  '=== WinNT
                        'Simulate Key Press
                        keybd_event(index, &H45S, KEYEVENTF_EXTENDEDKEY Or 0, 0)
                        'Simulate Key Release
                        keybd_event(index, &H45S, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
                    End If
                Else
                    If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then '=== Win95/98/XP
                        keys(index) = 0
                        SetKeyboardState(keys(0))
                    ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then  '=== WinNT
                        'Simulate Key Press
                        keybd_event(index, &H45S, KEYEVENTF_EXTENDEDKEY Or 0, 0)
                        'Simulate Key Release
                        keybd_event(index, &H45S, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
                    End If
                End If
            End If
        End Sub

        Public Shared Function GetLockStatus(ByVal targetKey As ToggleKey) As KeyboardFunctions.KeyToggleStatus
            Dim LockState As Boolean = False
            Dim keys(255) As Byte
            GetKeyboardState(keys(0))
            Select Case targetKey
                Case ToggleKey.CapsLock : LockState = keys(VK_CAPITAL)
                Case ToggleKey.NumLock : LockState = keys(VK_NUMLOCK)
                Case ToggleKey.ScrollLock : LockState = keys(VK_SCROLL)
            End Select
            Return ToKeyToggleStatus(LockState)
        End Function

        Public Shared Function ToKeyToggleStatus(ByVal value As Boolean) As KeyToggleStatus
            If value Then
                Return KeyToggleStatus.StatusOn
            Else
                Return KeyToggleStatus.StatusOff
            End If
        End Function
    End Class
End Namespace

Dalo by se pomocí tohoto kódu simulovat i CTRL+{něco}? Popřípadě, jak upravit?

Zkoušel jsem použít např.

WshShell.SendKeys("^(A)")

ale program, který je v pozadí tuto klávesouvou zkratku nezachytí. Ale když ji zmáčknu na klávesnici, tak to funguje.

To je možná důvod, proč NumLock nejde z .NETu - asi se nedá poslat lokálně, ale jen globálně. Ale jak jsem koukal do referenčních zdrojáků, tak tam s numlockem počátají.