我调用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
(以上示例似乎是由新手完成的，因为CloseTouchInput不会更改hTouchInput(
或者在发生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.
根据WM_TOUCH文档：
https://learn.microsoft.com/en-us/windows/win32/wintouch/wm-touchdown
lParam
包含一个触摸输入句柄，可在调用GetTouchInputInfo时使用该句柄来检索与此消息相关联的触摸点的详细信息。
此句柄仅在当前进程中有效，不应跨进程传递，除非在SendMessage或PostMessage调用中作为LPARAM传递。
当应用程序不再需要此句柄时，应用程序必须调用CloseTouchInputHandle以释放与此句柄关联的进程内存。否则可能导致应用程序内存泄漏
请注意，在将消息传递给DefWindowProc后，此参数中的触摸输入手柄将不再有效。DefWindowProc将关闭并使该句柄无效
还请注意，在使用PostMessage、SendMessage或其变体转发消息后，此参数中的触摸输入手柄将不再有效。这些函数将关闭并使此句柄无效。
在您提供的示例中，如果OnTouch()返回True，它不会调用DefSubclassProc()(它将调用DefWindowProc()(，因此OnTouch()在返回True之前调用CloseTouchInputHandle()(在本示例中有点多余(。