I'm calling GetTouchInputInfo like this:
RetVal = GetTouchInputInfo(hTouchInput, TouchPoints, tiTouchInput(1&), LenB(tiTouchInput(1&)))
I wonder when I should call
CloseTouchInputHandle
Should every GetTouchInputInfo be followed by CloseTouchInputHandle?
The docs do not explain when / why to call CloseTouchInput.
I'm asking because I have seen examples where people call it only in situations like this:
'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
(The above sample seems to have been done by a newbie anyways because hTouchInput is not altered by CloseTouchInput)
Or in situations where TOUCHEVENT_UP occurs.
These implementations don't make sense to me, that's why I ask here.
The code that I'm referring to is this:
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.