From 9bcc82c34d87d27719336657f1096ebd5d950ce4 Mon Sep 17 00:00:00 2001 From: Tanner Date: Mon, 29 Aug 2022 15:37:48 -0600 Subject: [PATCH] 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 | 8 ------ Classes/pdInputKeyboard.cls | 8 ------ Classes/pdInputMouse.cls | 8 ------ Classes/pdUCSupport.cls | 3 +-- Controls/pdAccelerator.ctl | 13 +++------- Modules/OS.bas | 50 +++++++++++++++++++++++++++++++------ Modules/ScreenCapture.bas | 10 +------- 7 files changed, 47 insertions(+), 53 deletions(-) diff --git a/Classes/pdEditBoxW.cls b/Classes/pdEditBoxW.cls index 14d9020f42..f0524a1183 100644 --- a/Classes/pdEditBoxW.cls +++ b/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). diff --git a/Classes/pdInputKeyboard.cls b/Classes/pdInputKeyboard.cls index ae064939c7..1ad08b5012 100644 --- a/Classes/pdInputKeyboard.cls +++ b/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&) diff --git a/Classes/pdInputMouse.cls b/Classes/pdInputMouse.cls index 9276925005..657a179d27 100644 --- a/Classes/pdInputMouse.cls +++ b/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 diff --git a/Classes/pdUCSupport.cls b/Classes/pdUCSupport.cls index 8d477f5e23..9337021d86 100644 --- a/Classes/pdUCSupport.cls +++ b/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 diff --git a/Controls/pdAccelerator.ctl b/Controls/pdAccelerator.ctl index 4437dbbc3c..660bcbd8a1 100644 --- a/Controls/pdAccelerator.ctl +++ b/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 diff --git a/Modules/OS.bas b/Modules/OS.bas index 30b4373e41..b74d8d4522 100644 --- a/Modules/OS.bas +++ b/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 diff --git a/Modules/ScreenCapture.bas b/Modules/ScreenCapture.bas index d10a192ed5..668dde8ed6 100644 --- a/Modules/ScreenCapture.bas +++ b/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