Unify virtual key state trackers

Many classes were implementing this individually; may as well merge them all (since I need both synchronous AND async versions to solve #425)

Classes/pdEditBoxW.cls

@@ -203,9 +203,6 @@ Private m_CharCache As Long
 Private Const PM_NOREMOVE As Long = &H0
 Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageW" (ByRef lpMsg As TagMSG, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
 
-'The Alt mask won't be returned by mouse WM notifications, so we need to retrieve it manually
-Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
-
 'Handle to the system edit box wrapped by this control
 Private m_EditBoxHwnd As Long
 
@@ -418,11 +415,6 @@ Friend Property Let Visible(ByVal newVisibility As Boolean)
     End If
 End Property
 
-'Note that the vKey constant below is a virtual key mapping, not necessarily a standard VB key constant
-Private Function IsVirtualKeyDown(ByVal vKey As Long) As Boolean
-    IsVirtualKeyDown = GetAsyncKeyState(vKey) And &H8000
-End Function
-
 'In order to give our owner some control over when the edit box is actually created, they are required to call the
 ' CreateEditBox function at least once.  (The Show() event is a decent place, for example.)  After the edit box has
 ' been created at least once, it will re-create itself as necessary (e.g. if property changes require it).

Classes/pdInputKeyboard.cls

@@ -71,9 +71,6 @@ Private Const WM_ACTIVATE As Long = &H6
 Private Const WM_SETFOCUS As Long = &H7
 Private Const WM_KILLFOCUS As Long = &H8
 
-'The Alt mask won't be returned by mouse WM notifications, so we need to retrieve it manually
-Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
-
 'In the future, other virtual key codes can be retrieved here:
 ' http://msdn.microsoft.com/en-us/library/windows/desktop/dd375731%28v=vs.85%29.aspx
 
@@ -254,11 +251,6 @@ Friend Sub RequestMoreKeys(ParamArray listOfKeys() As Variant)
 
 End Sub
 
-'Note that the vKey constant below is a virtual key mapping, not necessarily a standard VB key constant
-Private Function IsVirtualKeyDown(ByVal vKey As Long) As Boolean
-    IsVirtualKeyDown = GetAsyncKeyState(vKey) And &H8000
-End Function
-
 Private Function GetLoWord(ByVal lParam As Long) As Integer
     If lParam And &H8000& Then
         GetLoWord = &H8000 Or (lParam And &H7FFF&)

Classes/pdInputMouse.cls

@@ -113,9 +113,6 @@ Private Const TME_LEAVE As Long = &H2&
 
 Private Declare Function TrackMouseEvent Lib "user32" (ByRef lpEventTrack As TRACKMOUSEEVENT_STRUCT) As Long
 
-'The Alt mask won't be returned by mouse WM notifications, so we need to retrieve it manually
-Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
-
 'Virtual key-codes currently supported by pdInput
 Private Const VK_LBUTTON As Long = &H1
 Private Const VK_RBUTTON As Long = &H2
@@ -398,11 +395,6 @@ Private Function RequestMouseTrackingForHwnd() As Boolean
 
 End Function
 
-'Note that the vKey constant below is a virtual key mapping, not (necessarily) a standard VB key constant - plan accordingly!
-Private Function IsVirtualKeyDown(ByVal vKey As Long) As Boolean
-    IsVirtualKeyDown = GetAsyncKeyState(vKey) And &H8000
-End Function
-
 'Note that the vKey constant below is a virtual key mapping, not necessarily a standard VB key constant
 Private Function IsMouseButtonDown(ByVal vKey As Long) As Boolean
 

Classes/pdUCSupport.cls

@@ -62,7 +62,6 @@ Public Event SetCustomTabTarget(ByVal shiftTabWasPressed As Boolean, ByRef newTa
 Public Event AppCommand(ByVal cmdID As AppCommandConstants, ByVal Shift As ShiftConstants, ByVal x As Long, ByVal y As Long)
 
 Private Declare Function DrawFocusRect Lib "user32" (ByVal hDC As Long, ByRef lpRect As RECT) As Long
-Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
 
 'This class subclasses a *lot* of things.  Some are handled by this class itself; others use dedicated single-purpose
 ' support classes.
@@ -1216,7 +1215,7 @@ Friend Function GetControlHeight() As Long
 End Function
 
 Friend Function IsKeyDown(ByVal vkCode As Long) As Boolean
-    IsKeyDown = GetAsyncKeyState(vkCode) And &H8000
+    IsKeyDown = OS.IsVirtualKeyDown(vkCode)
 End Function
 
 Friend Function IsMouseInside() As Boolean

Controls/pdAccelerator.ctl

@@ -90,11 +90,6 @@ Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long)
 ' *after* the hook exits.
 Private m_InHookNow As Boolean, m_InFireTimerNow As Boolean
 
-'When PD loses and then gains focus, we need to manually update control key tracking.  This is done
-' by manually checking key state (instead of waiting for a hook event, which we may have missed as
-' PD wasn't active).
-Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
-
 'To reduce the potential for double-fired keys, we track the last-fired accelerator ID and the time
 ' when we launched the associated action.  The current system keyboard delay must elapse before we
 ' fire that same accelerator a second time.
@@ -323,11 +318,6 @@ Public Sub RecaptureKeyStates()
     m_ShiftDown = IsVirtualKeyDown(VK_SHIFT)
 End Sub
 
-'Note that the vKey constant below is a virtual key mapping, not necessarily a standard VB key constant
-Private Function IsVirtualKeyDown(ByVal vKey As Long) As Boolean
-    IsVirtualKeyDown = GetAsyncKeyState(vKey) And &H8000
-End Function
-
 'When PD loses focus, call this function to reset all key state tracking
 Public Sub ResetKeyStates()
     m_CtrlDown = False
@@ -525,6 +515,9 @@ Friend Function KeyboardHookProcAccelerator(ByVal nCode As Long, ByVal wParam As
             ' are (by design) not triggered by hold-to-repeat behavior, we only want to deal with key events
             ' that are full transitions from "Unpressed" to "Pressed" or vice-versa.  (The byte masks here
             ' all come from MSDN - check the link above for details!)
+            '
+            'TODO: some hotkeys (like brush size up/down) would actually benefit from key repeat behavior.
+            ' This line needs to be revisited accordingly!
             If ((lParam >= 0) And ((lParam And &H40000000) = 0)) Or ((lParam < 0) And ((lParam And &H40000000) <> 0)) Then
 
                 'We now want to check two things simultaneously.  First, we want to update Ctrl/Alt/Shift

Modules/OS.bas

@@ -275,6 +275,8 @@ End Type
 
 Private Declare Function CloseHandle Lib "kernel32" (ByVal Handle As Long) As Long
 Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
+Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
+Private Declare Function GetKeyState Lib "user32" (ByVal vKey As Long) As Integer
 Private Declare Function GetCommandLineW Lib "kernel32" () As Long
 Private Declare Function GetModuleFileNameW Lib "kernel32" (ByVal hModule As Long, ByVal ptrToFileNameBuffer As Long, ByVal nSize As Long) As Long
 Private Declare Sub GetNativeSystemInfo Lib "kernel32" (ByRef lpSystemInfo As OS_SystemInfo)
@@ -683,7 +685,7 @@ Public Function GetSystemTimeAsCurrency() As Currency
 End Function
 
 'Is Aero enabled (requires Vista+ and classic theme must *not* be in use)
-Public Function IsAeroAvailable(ByVal srcHwnd As Long) As Boolean
+Public Function IsAeroAvailable(ByVal srcHWnd As Long) As Boolean
 
     'Only check this once; it does not change per-session
     If (m_ThemingAvailable = pdta_Unknown) Then
@@ -700,7 +702,7 @@ Public Function IsAeroAvailable(ByVal srcHwnd As Long) As Boolean
         Else
             Dim hTheme As Long, sClass As String
             sClass = "Window"
-            hTheme = OpenThemeData(srcHwnd, StrPtr(sClass))
+            hTheme = OpenThemeData(srcHWnd, StrPtr(sClass))
             If (hTheme <> 0) Then
                 m_ThemingAvailable = pdta_True
                 CloseThemeData hTheme
@@ -720,6 +722,38 @@ Public Function IsProgramCompiled() As Boolean
     IsProgramCompiled = (App.LogMode = 1)
 End Function
 
+'Check current keystate.  Note that the vKey constant below is a virtual key mapping, not (necessarily) a standard
+' VB key constant - plan accordingly!
+'
+'ANOTHER IMPORTANT NOTE: this function only checks literal key up/down state.  It *will not work* for toggle state
+' on keys like CAPS LOCK or NUM LOCK; for those, you need to use the synchronous call, below.
+'
+'The optional "incStateSinceLastQuery" parameter uses old 16-bit Windows compatibility to see if the requested key
+' *was* pressed since the last check (regardless of whether it is down or not now).  Note that the bit is cleared
+' whenever *any* thread calls GetAsyncKeyState, so it is not reliable under most circumstances.  (PD uses this
+' during screen recording to increase the odds of "catching" mouse clicks, but it's not mission-critical.)
+Public Function IsVirtualKeyDown(ByVal vKey As Long, Optional ByVal incStateSinceLastQuery As Boolean = False) As Boolean
+    If incStateSinceLastQuery Then
+        IsVirtualKeyDown = (GetAsyncKeyState(vKey) And &H8001) <> 0
+    Else
+        IsVirtualKeyDown = (GetAsyncKeyState(vKey) And &H8000) <> 0
+    End If
+End Function
+
+'Return synchronous key state from the current thread.  Note that this function is necessary to detect state
+' of toggle-able keys like CAPS LOCK, thanks to the following info from MSDN:
+' - If the high-order bit is 1, the key is down; otherwise, it is up.
+' - If the low-order bit is 1, the key is toggled. A key, such as the CAPS LOCK key, is toggled if it is turned on.
+'   The key is off and untoggled if the low-order bit is 0. A toggle key's indicator light (if any) on the keyboard
+'   will be on when the key is toggled, and off when the key is untoggled.
+Public Function IsVirtualKeyDown_Synchronous(ByVal vKey As Long, Optional ByVal useToggleState As Boolean = False) As Boolean
+    If useToggleState Then
+        IsVirtualKeyDown_Synchronous = (GetKeyState(vKey) And &H1) <> 0
+    Else
+        IsVirtualKeyDown_Synchronous = (GetKeyState(vKey) And &H8000) <> 0
+    End If
+End Function
+
 'Check for a version >= the specified version.
 Public Function IsVistaOrLater() As Boolean
     If (Not m_VersionInfoCached) Then CacheOSVersion
@@ -958,17 +992,17 @@ Public Sub SetRestartRestoreBehavior(ByVal allowToRestore As Boolean)
 End Sub
 
 'If desired, a custom state can be set for the taskbar.  (Normally this is handled by the SetTaskbarProgressValue function.)
-Public Function SetTaskbarProgressState(ByVal tbpFlags As PD_TaskBarProgress, ByVal srcHwnd As Long) As Long
-    If WIN7_FEATURES_ALLOWED Then SetTaskbarProgressState = CallInterface(m_taskbarObjHandle, SetProgressState_, 2, srcHwnd, tbpFlags)
+Public Function SetTaskbarProgressState(ByVal tbpFlags As PD_TaskBarProgress, ByVal srcHWnd As Long) As Long
+    If WIN7_FEATURES_ALLOWED Then SetTaskbarProgressState = CallInterface(m_taskbarObjHandle, SetProgressState_, 2, srcHWnd, tbpFlags)
 End Function
 
-Public Function SetTaskbarProgressValue(ByVal amtCompleted As Long, ByVal amtTotal As Long, ByVal srcHwnd As Long) As Long
+Public Function SetTaskbarProgressValue(ByVal amtCompleted As Long, ByVal amtTotal As Long, ByVal srcHWnd As Long) As Long
     If WIN7_FEATURES_ALLOWED Then
         If (amtCompleted = 0) Then
-            SetTaskbarProgressState TBP_NoProgress, srcHwnd
+            SetTaskbarProgressState TBP_NoProgress, srcHWnd
         Else
-            SetTaskbarProgressState TBP_Normal, srcHwnd
-            SetTaskbarProgressValue = CallInterface(m_taskbarObjHandle, SetProgressValue_, 5, srcHwnd, amtCompleted, 0, amtTotal, 0)
+            SetTaskbarProgressState TBP_Normal, srcHWnd
+            SetTaskbarProgressValue = CallInterface(m_taskbarObjHandle, SetProgressValue_, 5, srcHWnd, amtCompleted, 0, amtTotal, 0)
         End If
     End If
 End Function

Modules/ScreenCapture.bas

@@ -48,7 +48,6 @@ End Type
 Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
 
 Private Declare Function DrawIconEx Lib "user32" (ByVal hDC As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
-Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
 Private Declare Function GetClientRect Lib "user32" (ByVal hndWindow As Long, ByRef lpRect As winRect) As Long
 Private Declare Function GetCursorInfo Lib "user32" (ByVal ptrToCursorInfo As Long) As Long
 Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
@@ -226,15 +225,8 @@ Public Sub GetPartialDesktopAsDIB(ByRef dstDIB As pdDIB, ByRef srcRect As RectL,
             ' doesn't differentiate between these for left-handed mouse users and we don't
             ' want to query additional APIs for that kind of low-level data - so said another
             ' way, *either* button down gets an identical render.
-            Dim mbDown As Boolean
             Const VK_LBUTTON As Long = &H1, VK_RBUTTON As Long = &H2
-
-            'Also note that GetAsyncKeyState returns a weird short value, e.g. from MSDN:
-            ' "If the most significant bit is set, the key is down..."
-            mbDown = ((GetAsyncKeyState(VK_LBUTTON) And &H8000) <> 0)
-            If (Not mbDown) Then mbDown = ((GetAsyncKeyState(VK_RBUTTON) And &H8000) <> 0)
-
-            If mbDown Then
+            If (IsVirtualKeyDown(VK_LBUTTON, True) Or IsVirtualKeyDown(VK_RBUTTON, True)) Then
 
                 'pd2D handles rendering duties
                 Dim cBrush As pd2DBrush