標題: [發問] Num Lock 數字鍵狀態取得 [打印本頁]

---

作者: Scott090    時間: 2016-9-25 16:38     標題: Num Lock 數字鍵狀態取得

VBA 發出 sendkeys ".... " 後常常 會不知何原因 影響數字鍵鎻 NUMLOCK狀態被改變了，
在發出一個 sendkeys "{NUMLOCK}" 並不能回復原來狀態
問題是無法掌握 numlock 的真正狀態，使用 windows API 也沒能掌握狀態
     (作業系統 WIN 10)
有請賢達協助

' API declaration

'Key board events operation
Private Declare Sub keybd_event Lib "user32" ( _
  ByVal bVk As Byte, _
  ByVal bScan As Byte, _
  ByVal dwFlags As Long, _
  ByVal dwExtraInfo As Long)
  
'Get key status
Private Declare Function GetKeyState Lib "user32" ( _
  ByVal nVirtKey As Long) As Integer

'======問題例 ：要使 numLock 保持亮燈 ==========
Sub LightUpNUMLOCK()
   
    SendKeys "^g^a{DEL}"     '送鍵值，消除即時運算視窗內資料；可能變更了 NumLock 亮燈狀態
'   SendKeys "{NUMLOCK}", True   '不能使 numlock 每次保持燈亮
'  debug.print GetKeyState(vbKeyNumlock)
'使用API 取得 NumLock 狀態，假如燈是熄的就送  NumLock key  使燈再亮
    If GetKeyState(vbKeyNumlock) = 0 Then    '← 此指令無法正確讀取狀態  
        SendKeys "{NUMLOCK}", True
    End If
End Sub

---

作者: jackyq    時間: 2016-9-26 17:50

本帖最後由 jackyq 於 2016-9-26 17:51 編輯

SendKeys "^g^a{DEL}"  , True   '   If GetKeyState(vbKeyNumlock) = 0 Then  '← 此指令可正確讀取狀態  

SendKeys "{NUMLOCK}  好像有 bug 應該也沒法用

---

作者: PKKO    時間: 2016-9-26 21:36

本帖最後由 PKKO 於 2016-9-26 21:38 編輯

回復 1# Scott090


    相同困擾+1
小弟也曾經研究過許久
https://support.microsoft.com/zh-tw/kb/179987
解決方式為增加一行    DoEvents=>但...無效....
求解答+1

---

作者: jackyq    時間: 2016-9-27 00:39

SendKeys 有 bug
可以嘗試用  keybd_event 去送

---

作者: Scott090    時間: 2016-9-27 08:51

回復 2# jackyq

在 #1 發文中的例子，SendKeys "^g^a{DEL}"  , True 也是有試過的，
If GetKeyState(vbKeyNumlock) = 0 then '在 win 10 取得的並非穩態的資訊
燈熄時也會有1，燈亮時也會有 0。在其他的OS系統我是不知道會是怎樣

---

作者: jackyq    時間: 2016-9-27 10:26

回復 5# Scott090

把所有  SendKeys 移除
只留 debug.print GetKeyState(vbKeyNumlock)  一句

Numlock 手動關閉 , 觀察 GetKeyState(vbKeyNumlock) 是否正確
Numlock 手動開啟 , 觀察 GetKeyState(vbKeyNumlock) 是否正確
如果都正確無誤, 表示是 SendKeys 在作怪

---

作者: Scott090    時間: 2016-9-27 12:36

回復 6# jackyq
回復 3# PKKO

當然 sendkeys 很作怪
它不僅影響 numlock, capslock, scroll, 還會莫名其妙跑出定義名稱參照哪一個位置!!
#3樓 提到 https://support.microsoft.com/zh-tw/kb/179987

這份文件的解決方案有3， 前2個試了都不行
再試第3個很迂迴的方案如下，好像可以穩定的解決問題 (win10)

Option Explicit

' API declarations:

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_KEYUP = &H2
   
'https://support.microsoft.com/zh-tw/kb/179987
'Resolution:
'Determine the setting of the NumLock key prior to using SendKeys.
'Then, turn off the NumLock before using SendKeys.
'After using SendKeys,reset the NumLock to its previous setting.
'This is accomplished using the GetKeyboardState, keybd_event and SetKeyboardState API functions.
'================================================================================================

Private Sub test()     '測試 sendkeys
    presetNumlock
   
    SendKeys "^g^a{DEL}" ', True
   
    TurnNumlock

End Sub


Sub presetNumlock()
     Dim bKeys(0 To 255) As Byte
     Dim LockState%
      
    'Get status of the 256 virtual keys
    GetKeyboardState bKeys(0)
   
    'turn off the num_lock key
    If bKeys(vbKeyNumlock) = 1 Then
        TurnNumlock
    End If
    DoEvents       '一定要 ?

End Sub

Sub TurnNumlock()
    'Simulate Key Press
    keybd_event vbKeyNumlock, 1, 0, 0
    'Simulate Key Release
    keybd_event vbKeyNumlock, 1, KEYEVENTF_KEYUP, 0
End Sub

---

作者: jackyq    時間: 2016-9-27 12:58

回復 7# Scott090


SendKeys 既然會作怪, 不如這部分乾脆不用它

Public Sub Sendkey2(keyArray)
  For w = LBound(keyArray) To UBound(keyArray): Call keybd_event(keyArray(w), 0, &H1, 0): Next
  For w = LBound(keyArray) To UBound(keyArray): Call keybd_event(keyArray(w), 0, &H3, 0): Next
End Sub

Public Sub  clear_win  (                 )
Sendkey2 Array(vbKeyControl, vbKeyG)
Sendkey2 Array(vbKeyControl, vbKeyA)
Sendkey2 Array(vbKeyDelete)
If GetKeyState(vbKeyNumlock) = 1 Then
   Sendkey2 Array(vbKeyNumlock)
End If
End Sub

---

作者: Scott090    時間: 2016-9-27 14:40

回復 8# jackyq


    Sendkey2 Array(vbKeyControl, vbKeyG, vbKeyControl, vbKeyA, vbKeyDelete)
實驗的結果，Num_Lock 會保持原來未送 key 之前的狀態

謝謝

---

作者: Scott090    時間: 2016-9-27 16:25

回復 8# jackyq


    放到實際的應用，不論 7# 或 8# 的方法都會產生下列"不相干"的詢問畫面：
[attach]25374[/attach]

sendkeys 的 bug 還是沒有避過

---

作者: jackyq    時間: 2016-9-27 16:42

回復 10# Scott090

這部分應該不是bug
sendkey 本來就有失焦的風險

提供一種簡法來清除即時窗
看你能不能接受這種方法
debug.print string(88, vbcr )

---

作者: Scott090    時間: 2016-9-28 07:52

回復 11# jackyq

謝謝提供的另類思考做清潔即時視窗的方法
sendkeys 去抹除 即時視窗只是其中一個例子

再次感恩

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)