vbAccelerator - Contents of code file: cSizeMove.cls

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

' ===================================================================
' cSizeMoveHelper.cls
' Author:   Steve McMahon
' Date:     10 August 1999
'
' Allows a form to take advanced control of the moving
' and sizing process, including
'
' -------------------------------------------------------------------
' vbAccelerator - Advanced, Free Source Code for Visual Basic
' http://vbaccelerator.com/
' mailto:steve@vbaccelerator.com
' ===================================================================
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Private Const WM_DESTROY = &H2
Private Const WM_SIZING = &H214
Private Const WM_MOVING = &H216&
Private Const WM_ENTERSIZEMOVE = &H231&
Private Const WM_EXITSIZEMOVE = &H232&
Private Const WM_ACTIVATE = &H6
Private Const WM_SIZE = &H5

Private m_hWnd As Long
Private m_bActive As Boolean
Private m_bInSizeMove As Boolean

Implements ISubclass

Public Event EnterSizeMove()
Public Event ExitSizeMove()
Public Event Activate(ByVal bByMouse As Boolean)
Public Event Deactivate()
Public Event Moving(ByRef lLeft As Long, ByRef lTop As Long, ByRef lWidth As
 Long, ByRef lHeight As Long)
Public Event Sizing(ByRef lLeft As Long, ByRef lTop As Long, ByRef lWidth As
 Long, ByRef lHeight As Long)

Public Property Get Active() As Boolean
   Active = m_bActive
End Property

Public Sub Attach(ByVal hWndA As Long)
   Detach
   m_hWnd = hWndA
   AttachMessage Me, m_hWnd, WM_ENTERSIZEMOVE
   AttachMessage Me, m_hWnd, WM_EXITSIZEMOVE
   AttachMessage Me, m_hWnd, WM_DESTROY
   AttachMessage Me, m_hWnd, WM_MOVING
   AttachMessage Me, m_hWnd, WM_SIZING
   AttachMessage Me, m_hWnd, WM_ACTIVATE
   AttachMessage Me, m_hWnd, WM_SIZE
End Sub
Public Sub Detach()
   If Not m_hWnd = 0 Then
      DetachMessage Me, m_hWnd, WM_ENTERSIZEMOVE
      DetachMessage Me, m_hWnd, WM_EXITSIZEMOVE
      DetachMessage Me, m_hWnd, WM_DESTROY
      DetachMessage Me, m_hWnd, WM_MOVING
      DetachMessage Me, m_hWnd, WM_SIZING
      DetachMessage Me, m_hWnd, WM_SIZE
      DetachMessage Me, m_hWnd, WM_ACTIVATE
   End If
End Sub

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

Private Property Get ISubClass_MsgResponse() As SSubTimer.EMsgResponse
   ' Process before windows:
   ISubClass_MsgResponse = emrPostProcess
End Property

Private Function ISubClass_WindowProc(ByVal hwnd As Long, ByVal iMsg As Long,
 ByVal wParam As Long, ByVal lParam As Long) As Long
Dim lR As Long
Dim tR As RECT
Dim lWidth As Long
Dim lHeight As Long

   Select Case iMsg
   Case WM_ENTERSIZEMOVE
      ' Enter modal sizing/moving loop
      m_bInSizeMove = True
      RaiseEvent EnterSizeMove
      
   Case WM_EXITSIZEMOVE
      ' Exit modal sizing/moving loop
      RaiseEvent ExitSizeMove
      m_bInSizeMove = False
      
   Case WM_MOVING
      ' Form is moving:
      CopyMemory tR, ByVal lParam, Len(tR)
      lWidth = tR.Right - tR.Left
      lHeight = tR.Bottom - tR.Top
      RaiseEvent Moving(tR.Left, tR.Top, lWidth, lHeight)
      tR.Right = tR.Left + lWidth
      tR.Bottom = tR.Top + lHeight
      CopyMemory ByVal lParam, tR, Len(tR)
      
   Case WM_SIZING
      ' Form is sizing:
      CopyMemory tR, ByVal lParam, Len(tR)
      lWidth = tR.Right - tR.Left
      lHeight = tR.Bottom - tR.Top
      RaiseEvent Sizing(tR.Left, tR.Top, lWidth, lHeight)
      tR.Right = tR.Left + lWidth
      tR.Bottom = tR.Top + lHeight
      CopyMemory ByVal lParam, tR, Len(tR)
      
   Case WM_ACTIVATE
      ' Form is activated/deactivated:
      If wParam = 0 Then
         ' deactivate:
         m_bActive = False
         RaiseEvent Deactivate
      Else
         ' Activate
         m_bActive = True
         RaiseEvent Activate(wParam = 2)
      End If

   'Case WM_SIZE
   '   ' This ensures that you don't have to separately
   '   ' check for maximize/minimize/restore/in code
   '   ' movement, as these aren't
   '   ' controlled by the UI sizing loop:
   '   If Not (m_bInSizeMove) Then
   '      GetWindowRect m_hWnd, tR
   '      lWidth = tR.Right - tR.Left
   '      lHeight = tR.Bottom - tR.Top
   '      RaiseEvent Sizing(tR.Left, tR.Top, lWidth, lHeight)
   '   End If
      
   Case WM_DESTROY
      ' Ensures the class terminates regardless
      ' of whether the user explicitly detaches
      ' it or not:
      'Debug.Print "WM_DESTROY"
      Detach
   End Select
End Function