winapi - 何时调用 CloseTouchInputHandle

标签 winapi vb6

我像这样调用 GetTouchInputInfo:

RetVal = GetTouchInputInfo(hTouchInput, TouchPoints, tiTouchInput(1&), LenB(tiTouchInput(1&)))

我想知道什么时候应该打电话

CloseTouchInputHandle

每个 GetTouchInputInfo 后面都应该跟着 CloseTouchInputHandle 吗?

docs不要解释何时/为何调用 CloseTouchInput。

我问这个问题是因为我见过人们只在这样的情况下调用它的例子:

   'Check for TouchDown and process it
    If tiTouchInput(i).dwFlags And TOUCHEVENTF_DOWN Then
        OnTouch = True
        m_blnSkipNextMouseDown = True
        hTouchInput = CloseTouchInputHandle(hTouchInput):   Debug.Assert hTouchInput

(无论如何,上面的示例似乎是由新手完成的,因为 hTouchInput 没有被 CloseTouchInput 更改)

或者在发生 TOUCCHEVENT_UP 的情况下。

这些实现对我来说没有意义,这就是我在这里问的原因。

我所指的代码是这样的:

Option Explicit

Private Const SM_DIGITIZER As Long = 94
Private Const WM_TOUCH     As Long = &H240

Private Enum RegisterTouchWindowFlags
    TWF_FINETOUCH = &H1
    TWF_WANTPALM = &H2
End Enum
#If False Then
    Dim TWF_FINETOUCH, TWF_WANTPALM
#End If

Private Enum DigitizerConstants
    TABLET_CONFIG_NONE = &H0
    NID_INTEGRATED_TOUCH = &H1
    NID_EXTERNAL_TOUCH = &H2
    NID_INTEGRATED_PEN = &H4
    NID_EXTERNAL_PEN = &H8
    NID_MULTI_INPUT = &H40
    NID_READY = &H80
End Enum
#If False Then
    Dim TABLET_CONFIG_NONE, NID_INTEGRATED_TOUCH, NID_EXTERNAL_TOUCH, _
    NID_INTEGRATED_PEN, NID_EXTERNAL_PEN, NID_MULTI_INPUT, NID_READY
#End If

Private Enum TOUCHINPUT_Flags
    TOUCHEVENTF_MOVE = &H1
    TOUCHEVENTF_DOWN = &H2
    TOUCHEVENTF_UP = &H4
    TOUCHEVENTF_INRANGE = &H8
    TOUCHEVENTF_PRIMARY = &H10
    TOUCHEVENTF_NOCOALESCE = &H20
    TOUCHEVENTF_PALM = &H80
End Enum
#If False Then
    Dim TOUCHEVENTF_MOVE, TOUCHEVENTF_DOWN, TOUCHEVENTF_UP, TOUCHEVENTF_INRANGE, _
    TOUCHEVENTF_PRIMARY, TOUCHEVENTF_NOCOALESCE, TOUCHEVENTF_PALM
#End If

Private Enum TOUCHINPUT_Masks
    TOUCHINPUTMASKF_TIMEFROMSYSTEM = &H1
    TOUCHINPUTMASKF_EXTRAINFO = &H2
    TOUCHINPUTMASKF_CONTACTAREA = &H4
End Enum
#If False Then
    Dim TOUCHINPUTMASKF_TIMEFROMSYSTEM, TOUCHINPUTMASKF_EXTRAINFO, TOUCHINPUTMASKF_CONTACTAREA
#End If

Private Type TOUCHINPUT
    X           As Long
    Y           As Long
    hSource     As Long
    dwID        As Long
    dwFlags     As TOUCHINPUT_Flags
    dwMask      As TOUCHINPUT_Masks
    dwTime      As Long
    dwExtraInfo As Long
    cxContact   As Long
    cyContact   As Long
End Type

Private Declare Function CloseTouchInputHandle Lib "user32.dll" (ByVal hTouchInput As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
Private Declare Function GetTouchInputInfo Lib "user32.dll" (ByVal hTouchInput As Long, ByVal cInputs As Long, ByRef pInputs As TOUCHINPUT, ByVal cbSize As Long) As Long
Private Declare Function RegisterTouchWindow Lib "user32.dll" (ByVal hWnd As Long, Optional ByVal ulFlags As RegisterTouchWindowFlags) As Long

Private Declare Function DefSubclassProc Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, Optional ByVal dwRefData As Long) As Long
Private Declare Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long

Private m_blnSkipNextMouseDown As Boolean
Private m_strMessageOld        As String

Private Sub cmdTouch_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    tmrDown = True
    lblDown.BackColor = vbCyan
End Sub                                 'Error handling isn't really necessary in these 2 Subs

Private Sub cmdTouch_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    tmrUp = True
    lblUp.BackColor = vbCyan
End Sub                                 'because the values being assigned won't ever trigger an error

Private Sub Form_Load() 'Accessing any of a Form's property or control loads it, so might as well run the following code in the proper event
    Dim IsIntegratedTouch As Boolean, IsStackReady As Boolean, hWndBtn As Long

    lblDown = vbNewLine & lblDown
    lblUp = vbNewLine & lblUp

   'Retrieve digitizer status & capabilities
    hWndBtn = GetSystemMetrics(SM_DIGITIZER)
    IsIntegratedTouch = (hWndBtn And NID_INTEGRATED_TOUCH) = NID_INTEGRATED_TOUCH
    IsStackReady = (hWndBtn And NID_READY) = NID_READY

    txtDbgMsg = "Integrated Touch = " & IIf$(IsIntegratedTouch, "True", "False") & vbNewLine _
              & "Stack Ready = " & IIf$(IsStackReady, "True", "False") & vbNewLine & vbNewLine

   'See if we need to use touch events
    If IsStackReady And IsIntegratedTouch Then
        hWndBtn = cmdTouch.hWnd

       'Register button to receive touch events and substitute window event handling procedure
        If RegisterTouchWindow(hWndBtn) Then
            hWndBtn = SetWindowSubclass(hWndBtn, AddressOf StaticSubclassProc, ObjPtr(Me)): Debug.Assert hWndBtn
        End If
    End If
End Sub                                 'Error handling is useless in this Sub because VB6 is unable to catch errors thrown by APIs

Private Sub Form_Resize()
    Dim txtDbgMsg_Left As Single, txtDbgMsg_Top As Single

    txtDbgMsg_Left = txtDbgMsg.Left
    txtDbgMsg_Top = txtDbgMsg.Top

    On Error Resume Next
    txtDbgMsg.Move txtDbgMsg_Left, txtDbgMsg_Top, ScaleWidth - txtDbgMsg_Left - 150!, ScaleHeight - txtDbgMsg_Top - 150!
End Sub

Private Sub Form_Unload(Cancel As Integer)
    RemoveWindowSubclass cmdTouch.hWnd, AddressOf StaticSubclassProc, ObjPtr(Me)
End Sub

Private Sub tmrDown_Timer()
    tmrDown = False
    lblDown.BackColor = vbButtonFace
End Sub                                 'Error handling is also unnecessary in these 2 Subs

Private Sub tmrUp_Timer()
    tmrUp = False
    lblUp.BackColor = vbButtonFace
End Sub                                 'because the values being assigned won't ever trigger an error

'Replacement for VBA.IIf() that is optimized for Strings
Private Function IIf$(ByVal Expression As Boolean, ByRef TruePart As String, ByRef FalsePart As String)
    If Expression Then IIf$ = TruePart Else IIf$ = FalsePart
End Function

Private Function OnTouch(ByVal hWnd As Long, ByVal TouchPoints As Long, ByVal hTouchInput As Long) As Boolean
    Dim i As Long, RetVal As Long, strMessage As String, tiTouchInput() As TOUCHINPUT

    ReDim tiTouchInput(1& To TouchPoints) As TOUCHINPUT 'Allocate the TOUCHINPUT array

    RetVal = GetTouchInputInfo(hTouchInput, TouchPoints, tiTouchInput(1&), LenB(tiTouchInput(1&)))

   'Loop through TOUCHINPUT structures
    For i = 1& To TouchPoints
        strMessage = "ID=" & tiTouchInput(i).dwID & _
                   ", hSource=&H" & Hex$(tiTouchInput(i).hSource) & _
                   ", dwFlags=&H" & Hex$(tiTouchInput(i).dwFlags) & _
                   ", RetVal=" & RetVal & _
                   ", hWnd=&H" & Hex$(hWnd) & _
                   ", TouchPoints=" & TouchPoints & vbNewLine

       'Display diagnostic information
        If StrComp(strMessage, m_strMessageOld) Then    'StrComp() is actually faster than either the = or <> operators
            On Error Resume Next
            txtDbgMsg.SelStart = &HFFFF&                'Appending text via .SelText is quicker than retrieving the
            txtDbgMsg.SelText = strMessage              'entire .Text contents and concatenating it with additional text
            On Error GoTo 0
            m_strMessageOld = strMessage
        End If

       'Check for TouchDown and process it
        If tiTouchInput(i).dwFlags And TOUCHEVENTF_DOWN Then
            OnTouch = True
            m_blnSkipNextMouseDown = True
            hTouchInput = CloseTouchInputHandle(hTouchInput):   Debug.Assert hTouchInput
            tmrDown = True
            lblDown.BackColor = vbCyan
            Exit Function
        End If
    Next
End Function

Friend Function SubclassProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal dwRefData As Long) As Long
    If uMsg = WM_TOUCH Then If OnTouch(hWnd, wParam And &HFFFF&, lParam) Then Exit Function

    SubclassProc = DefSubclassProc(hWnd, uMsg, wParam, lParam) 'Avoid declaring additional variables inside window/subclass procedures because they'll still
End Function                                                   'be allocated even for messages not being handled there. Create a separate procedure instead.

最佳答案

根据 WM_TOUCH 文档:

https://learn.microsoft.com/en-us/windows/win32/wintouch/wm-touchdown

lParam

Contains a touch input handle that can be used in a call to GetTouchInputInfo to retrieve detailed information about the touch points associated with this message.

This handle is valid only within the current process and should not be passed cross-process except as the LPARAM in a SendMessage or PostMessage call.

When the application no longer requires this handle, the application must call CloseTouchInputHandle to free the process memory associated with this handle. Failing to do so can result in an application memory leak.

Note that the touch input handle in this parameter is no longer valid after the message has been passed to DefWindowProc. DefWindowProc will close and invalidate this handle.

Note also that the touch input handle in this parameter is no longer valid after the message has been forwarded using PostMessage, SendMessage, or one of their variants. These functions will close and invalidate this handle.

在您提供的示例中,如果 OnTouch() 返回,则不会调用 DefSubclassProc() (它将调用 DefWindowProc()) True,因此 OnTouch() 在返回 True 之前调用 CloseTouchInputHandle() (在本例中这有点多余)。

关于winapi - 何时调用 CloseTouchInputHandle,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/66974961/

相关文章:

vb6 - 应用程序需要 Fiddler 才能在某些 PC 上正确执行

vb6 - 在VB6中将文件写入txt

winapi - Win32 API : How to change color of part of text in edit control

c++ - 设置滚动拇指的大小?

c++ - 从 AllocConsole C++ 获取行输入

c - 如何协调被 Getasynckeystate 阻止的 Sendmessage、SendInput、Mouse_event?

vb.net - 不再支持错误 BC30829 'Get' 语句 - 从 vb6 转换为 vb.net

c++ - 将 PAGE_GUARD 保护设置为大页面

c++ - 在 Windows 中加入等效项

string - Visual Basic 6 中的字符串空间不足