Есть проект ActiveX Control. В нем модуль и два класс-модуля от сабклассера плюс один юзер-контрол - Button
Возникает довольно-таки неприятная ситуация...
Компилирую OCX, добавляю его для тестирования в голый проект Standart EXE, компилирую Project1.exe, запускаю, закрываю. После закрытия Project1.exe появляется ошибка в kernel32.dll
Пол-головы сломал. Вторую доламывать боюсь
Код контрола:
- Код: Выделить всё
Option Explicit
Implements ISubclass
Private Type tagTRACKMOUSEEVENT
cbSize As Long
dwFlags As Long
hwndTrack As Long
dwHoverTime As Long
End Type
Private Const TME_HOVER As Long = 1
Private Const TME_LEAVE As Long = 2
Private Const WM_MOUSEHOVER As Long = &H2A1
Private Const WM_MOUSELEAVE As Long = &H2A3
Private Const WM_MOUSEMOVE As Long = &H200
Private Declare Function SetProp Lib "user32.dll" Alias "SetPropA" ( _
ByVal hWnd As Long, _
ByVal lpString As String, _
ByVal hData As Long) As Long
Private Declare Function GetProp Lib "user32.dll" Alias "GetPropA" ( _
ByVal hWnd As Long, _
ByVal lpString As String) As Long
Private Declare Function RemoveProp Lib "user32.dll" Alias "RemovePropA" ( _
ByVal hWnd As Long, _
ByVal lpString As String) As Long
Private Declare Function TrackMouseEvent Lib "user32.dll" ( _
ByRef lpEventTrack As tagTRACKMOUSEEVENT) As Long
Public Event MouseHover()
Public Event MouseLeave()
Private Function ISubclass_Callback(ByVal hWnd As Long, uMsg As Long, wParam As Long, lParam As Long, ByVal PrevProc As Long) As Long
Dim typTME As tagTRACKMOUSEEVENT
Select Case uMsg
Case WM_MOUSEHOVER
SetProp hWnd, "Hot", 1
RaiseEvent MouseHover
Case WM_MOUSELEAVE
RemoveProp hWnd, "Hot"
RaiseEvent MouseLeave
Case WM_MOUSEMOVE
If GetProp(hWnd, "Hot") = 0 Then
typTME.cbSize = LenB(typTME)
typTME.hwndTrack = hWnd
typTME.dwFlags = TME_HOVER Or TME_LEAVE
typTME.dwHoverTime = 1
TrackMouseEvent typTME
End If
End Select
If PrevProc Then _
ISubclass_Callback = SubClasser.CallWindowProc(PrevProc, hWnd, uMsg, wParam, lParam)
End Function
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
If Ambient.UserMode Then _
SubClasser.AddSubclassHook hWnd, Me, DoNotTransfer
End Sub
Private Sub UserControl_Terminate()
SubClasser.RemoveAll
End Sub
Public Property Get hWnd() As Long
hWnd = UserControl.hWnd
End Property
Public Property Get hdc() As Long
hdc = UserControl.hdc
End Property
