时间戳

首页 > 解决方案 > 何时调用 CloseTouchInputHandle

winapi - 何时调用 CloseTouchInputHandle

问题描述

我这样调用 GetTouchInputInfo ：

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

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

CloseTouchInputHandle

每个 GetTouchInputInfo 都应该跟 CloseTouchInputHandle 吗？

文档没有解释何时/为什么调用 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 更改）

或者在发生 TOUCHEVENT_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.

标签： winapivb6

解决方案

根据WM_TOUCH文档：

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

参数

包含一个触摸输入句柄，可用于调用GetTouchInputInfo以检索有关与此消息关联的触摸点的详细信息。

此句柄仅在当前进程内有效，不应跨进程传递，除非作为 SendMessage 或 PostMessage 调用中的 LPARAM。

当应用程序不再需要此句柄时，应用程序必须调用 CloseTouchInputHandle 以释放与此句柄关联的进程内存。不这样做可能会导致应用程序内存泄漏。

请注意，在将消息传递给DefWindowProc后，此参数中的触摸输入句柄不再有效。DefWindowProc将关闭并使此句柄无效。

另请注意，在使用PostMessage、 SendMessage 或其变体之一转发消息后，此参数中的触摸输入句柄不再有效。这些函数将关闭并使此句柄无效。

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

推荐阅读