Subclassing in VB ActiveX


‘code

  1. ‘ Place this code in the General Declarations area
  2. Dim m_MyInstance as Integer
  3. ‘ Place this block of code in the user control’s
  4. ‘ INITIALIZE event
  5. Dim Instance_Scan As Integer
  6. For Instance_Scan = MIN_INSTANCES To MAX_INSTANCES
  7. If Instances(Instance_Scan).in_use = False Then
  8. m_MyInstance = Instance_Scan
  9. Instances(Instance_Scan).in_use = True
  10. Instances(Instance_Scan).ClassAddr = ObjPtr(Me)
  11. Exit For
  12. End If
  13. Next Instance_Scan
  14. ‘ Note the Friend keyword.
  15. ‘ If you plan on modifying wMsg, pass it ByRef…
  16. Friend Sub ParentResized(ByVal wMsg As Long)
  17. Static ParentWidth As Long
  18. Static ParentHeight As Long
  19. If wMsg = WM_CLOSE Then UnhookParent
  20. If ParentWidth <> Usercontrol.Parent.Width Or _
  21. ParentHeight <> Usercontrol.Parent.Height Then
  22. Debug.Print m_MyInstance & “: Resize event”
  23. End If
  24. ParentWidth = TrueParentWidth
  25. ParentHeight = TrueParentHeight
  26. End Sub
‘module
  1. Option Explicit
  2. Public Const WM_SIZE = &H5
  3. Public Const GWL_WNDPROC = (-4&)
  4. Public Const GWL_USERDATA = (-21&)
  5. Public Const WM_CLOSE = &H10
  6. Public Const MIN_INSTANCES = 1
  7. Public Const MAX_INSTANCES = 256
  8. Type Instances
  9. in_use As Boolean ‘This instance is alive
  10. ClassAddr As Long ‘Pointer to self
  11. hwnd As Long ‘hWnd being hooked
  12. PrevWndProc As Long ‘Stored for unhooking
  13. End Type
  14. ‘Hooking Related Declares
  15. Declare Function GetWindowLong& Lib “user32” Alias “GetWindowLongA” (ByVal _
  16. hwnd As Long, ByVal nIndex As Long)
  17. Declare Function CallWindowProc& Lib “user32” Alias “CallWindowProcA” _
  18. (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, _
  19. ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long)
  20. Declare Function SetWindowLong& Lib “user32” Alias “SetWindowLongA” _
  21. (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long)
  22. Public Declare Sub CopyMemory Lib “kernel32” Alias “RtlMoveMemory” _
  23. (pDest As Any, pSource As Any, ByVal ByteLen As Long)
  24. Global Instances(MIN_INSTANCES To MAX_INSTANCES) As Instances
  25. Public Function SwitchBoard(ByVal hwnd As Long, ByVal MSG As Long, _
  26. ByVal wParam As Long, ByVal lParam As Long) As Long
  27. Dim instance_check As Integer
  28. Dim cMyUC As MyUC
  29. Dim PrevWndProc As Long
  30. ‘Do this early as we may unhook
  31. PrevWndProc = Is_Hooked(hwnd)
  32. If MSG = WM_SIZE Or MSG = WM_CLOSE Then
  33. For instance_check = MIN_INSTANCES To MAX_INSTANCES
  34. If Instances(instance_check).hwnd = hwnd Then
  35. On Error Resume Next
  36. CopyMemory cMyUC,  Instances(instance_check).ClassAddr, 4
  37. cMyUC.ParentResized MSG
  38. CopyMemory cMyUC, 0&, 4
  39. End If
  40. Next instance_check
  41. End If
  42. SwitchBoard = CallWindowProc(PrevWndProc, hwnd, MSG, wParam, lParam)
  43. End Function
  44. ‘Hooks a window or acts as if it does if the window is
  45. ‘already hooked by a previous instance of myUC.
  46. Public Sub Hook_Window(ByVal hwnd As Long, ByVal instance_ndx As Integer)
  47. Instances(instance_ndx).PrevWndProc = Is_Hooked(hwnd)
  48. If Instances(instance_ndx).PrevWndProc = 0& Then
  49. Instances(instance_ndx).PrevWndProc = SetWindowLong(hwnd, _
  50. GWL_WNDPROC, AddressOf SwitchBoard)
  51. End If
  52. Instances(instance_ndx).hwnd = hwnd
  53. End Sub
  54. ‘ Unhooks only if no other instances need the hWnd
  55. Public Sub UnHookWindow(ByVal instance_ndx As Integer)
  56. If TimesHooked(Instances(instance_ndx).hwnd) = 1 Then
  57. SetWindowLong Instances(instance_ndx).hwnd, GWL_WNDPROC, _
  58. Instances(instance_ndx).PrevWndProc
  59. End If
  60. Instances(instance_ndx).hwnd = 0&
  61. End Sub
  62. ‘Determine if we have already hooked a window,
  63. ‘and returns the PrevWndProc if true, 0& if false
  64. Private Function Is_Hooked(ByVal hwnd As Long) As Long
  65. Dim ndx As Integer
  66. Is_Hooked = 0&
  67. For ndx = MIN_INSTANCES To MAX_INSTANCES
  68. If Instances(ndx).hwnd = hwnd Then
  69. Is_Hooked = Instances(ndx).PrevWndProc
  70. Exit For
  71. End If
  72. Next ndx
  73. End Function
  74. ‘Returns a count of the number of times a given
  75. ‘window has been hooked by instances of myUC.
  76. Private Function TimesHooked(ByVal hwnd As Long) As Long
  77. Dim ndx As Integer
  78. Dim cnt As Integer
  79. For ndx = MIN_INSTANCES To MAX_INSTANCES
  80. If Instances(ndx).hwnd = hwnd Then
  81. cnt = cnt + 1
  82. End If
  83. Next ndx
  84. TimesHooked = cnt
  85. End Function

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s