vbAccelerator - Contents of code file: TestSuite_cSubclass2.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "cSubclass2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_MOUSEMOVE = &H200
Private Const WM_DESTROY = &H2
Private Const WM_SIZE = &H5

Implements ISubclass

Private m_hWnd As Long

Public Sub Attach(ByVal hWnd As Long)
   Detach
   attachmessage Me, hWnd, WM_LBUTTONUP
   attachmessage Me, hWnd, WM_MOUSEMOVE
   attachmessage Me, hWnd, WM_LBUTTONDOWN
   attachmessage Me, hWnd, WM_DESTROY
   m_hWnd = hWnd
End Sub

Public Sub Detach()
   If Not (m_hWnd = 0) Then
      detachmessage Me, m_hWnd, WM_LBUTTONUP
      detachmessage Me, m_hWnd, WM_MOUSEMOVE
      detachmessage Me, m_hWnd, WM_LBUTTONDOWN
      detachmessage Me, m_hWnd, WM_DESTROY
      m_hWnd = 0
   End If
End Sub

Private Property Let ISubclass_MsgResponse(ByVal RHS As SSubTimer.EMsgResponse)
   '
End Property

Private Property Get ISubclass_MsgResponse() As SSubTimer.EMsgResponse
   '
   Select Case CurrentMessage
   Case WM_LBUTTONUP
      ISubclass_MsgResponse = emrPostProcess
   Case WM_MOUSEMOVE
      ISubclass_MsgResponse = emrPostProcess
   Case WM_LBUTTONDOWN
      ISubclass_MsgResponse = emrPostProcess
   Case WM_DESTROY
      ISubclass_MsgResponse = emrPostProcess
   End Select
   '
End Property

Private Function ISubclass_WindowProc(ByVal hWnd As Long, ByVal iMsg As Long,
 ByVal wParam As Long, ByVal lParam As Long) As Long
   '
   Select Case CurrentMessage
   Case WM_LBUTTONUP
      'Debug.Print "Class2:WM_LBUTTONUP"
   Case WM_MOUSEMOVE
      'Debug.Print "Class2:WM_MOUSEMOVE"
   Case WM_LBUTTONDOWN
      'Debug.Print "Class2:WM_LBUTTONDOWN"
   Case WM_DESTROY
      'Debug.Print "Class2:WM_DESTROY"
      Detach
   End Select

   '
End Function