描绘浮动透明控件，鼠标移出后不正常，请大家帮忙看看是什么问题。

Question

代码都是从网上资料找的，想做个浮动的透明控件，添加浮动效果后不正常。鼠标进入控件时正常，但移出时无反映，移入后点击鼠标半天没有响应，请大家帮忙看看是什么原因。
'用户控件代码
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type'  flags for DrawFrameControl
Private Const DFC_BUTTON = 4          'Standard button
Private Const DFCS_BUTTONCHECK = &H0  'Check box
Private Const DFCS_BUTTONRADIO = &H4  'Radio button
Private Const DFCS_CHECKED = &H400    'is checked
Private Const DFCS_MONO = &H8000 '加单色边框
Private Const DFCS_PUSHED = &H200 '鼠标按下
Private Declare Function DrawFrameControl Lib "user32" (ByVal hdc&, lpRect As RECT, ByVal un1 As Long, ByVal un2 As Long) As Boolean
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As LongPublic Enum ControlType
    OptionBox = DFCS_BUTTONRADIO
    CheckBox = DFCS_BUTTONCHECK
End EnumPrivate mType As ControlType
Private mForeColor As OLE_COLOR
Private mCaption As String
Private mValue As BooleanEvent Click()
'缺省属性值:
Const m_def_FontItalic = 0
'属性变量:
Dim m_FontItalic As BooleanEvent InitProperties()
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseMove
Public Property Get CntrlType() As ControlType
     CntrlType = mType
End PropertyPublic Property Let CntrlType(NewVal As ControlType)
     mType = NewVal
     PropertyChanged "CntrlType"
     DrawControl
End PropertyPrivate Function MakeRect(l As Long, t As Long, w As Long, h As Long) As RECT
    With MakeRect
        .Left = l
        .Top = t
        .Right = l + w
        .Bottom = t + h
    End With
End FunctionPublic Property Let Value(NewVal As Boolean)
    mValue = NewVal
    PropertyChanged "Value"
    DrawControl
End PropertyPublic Property Get Value() As Boolean
     Value = mValue
End PropertyPublic Property Get ForeColor() As OLE_COLOR
     ForeColor = mForeColor
End PropertyPublic Property Let ForeColor(ByVal NewVal As OLE_COLOR)
     mForeColor = NewVal
     PropertyChanged "ForeColor"
     DrawControl
End PropertyPrivate Sub UserControl_Click()
    If mType = CheckBox Then ' Toggle "Check Box" control type only.
        If mValue = True Then   ' Toggle "Option Box" in Forms, see SetOptionBox.
            mValue = False ' not checked
        Else
            mValue = True ' checked
        End If
        DrawControl
    End If
    RaiseEvent Click
End SubPrivate Sub UserControl_Initialize()
    mForeColor = vbBlack
    Call Init(UserControl.hwnd)
End SubPrivate Sub UserControl_InitProperties()
    UserControl.ScaleMode = vbPixels
    Caption = Extender.Name
    m_FontItalic = m_def_FontItalic
End SubPublic Property Get Caption() As String
     Caption = mCaption
End PropertyPublic Property Let Caption(NewVal As String)
     mCaption = NewVal
     PropertyChanged "Caption"
     DrawControl
End PropertyPublic Property Get Font() As Font
     Set Font = UserControl.Font
End PropertyPublic Property Set Font(ByVal NewVal As Font)
     Set UserControl.Font = NewVal
     PropertyChanged "Font"
     DrawControl
End PropertyPrivate Sub UserControl_ReadProperties(PropBag As PropertyBag)
    With PropBag
        Set UserControl.Font = PropBag.ReadProperty("Font", Ambient.Font)
        Caption = .ReadProperty("Caption", Extender.Name)
        ForeColor = .ReadProperty("ForeColor", vbBlack)
        Value = .ReadProperty("Value", mValue)
        CntrlType = .ReadProperty("CntrlType", mType)
    End With
    DrawControl
    m_FontItalic = PropBag.ReadProperty("FontItalic", m_def_FontItalic)
    Set MouseIcon = PropBag.ReadProperty("MouseIcon", Nothing)
End SubPrivate Sub UserControl_Resize()
   DrawControl
End SubPrivate Sub UserControl_Terminate()
   ' Call MouseLeft(UserControl.hwnd)
End SubPrivate Sub UserControl_WriteProperties(PropBag As PropertyBag)
     With PropBag
          Call .WriteProperty("Caption", mCaption, Extender.Name)
          Call .WriteProperty("ForeColor", mForeColor, vbBlack)
          Call .WriteProperty("Font", UserControl.Font, Ambient.Font)
          Call .WriteProperty("Value", mValue, False)
          Call .WriteProperty("CntrlType", mType, ControlType.CheckBox)
     End With
    Call PropBag.WriteProperty("FontItalic", m_FontItalic, m_def_FontItalic)
    Call PropBag.WriteProperty("MouseIcon", MouseIcon, Nothing)
End SubPublic Property Get FontItalic() As Boolean
    FontItalic = m_FontItalic
End PropertyPublic Property Let FontItalic(ByVal New_FontItalic As Boolean)
    m_FontItalic = New_FontItalic
    PropertyChanged "FontItalic"
End PropertyPrivate Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   ' mMouseMove = (0 <= X) And (X <= UserControl.Width) And (0 <= Y) And (Y <= UserControl.Height)
    If mMouseMove = False Then mMouseMove = True
     Dim ET As TRACKMOUSEEVENTTYPE
        'initialize structure
     ET.cbSize = Len(ET)
     ET.hwndTrack = UserControl.hwnd
     ET.dwFlags = TME_LEAVE
        'start the tracking
     TrackMouseEvent ET
    'End If
    
    DrawControl
    RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub
Public Property Get hwnd() As Long
    hwnd = UserControl.hwnd
End PropertyPrivate Sub DrawControl()
    UserControl.Cls
    UserControl.ForeColor = mForeColor
    If mValue And mMouseMove Then  ' control is checked
        DrawFrameControl hdc, MakeRect(0, 0, 13, 13), DFC_BUTTON, mType Or DFCS_CHECKED Or DFCS_PUSHED
    ElseIf mValue Then
        DrawFrameControl hdc, MakeRect(0, 0, 13, 13), DFC_BUTTON, mType Or DFCS_CHECKED
    ElseIf mMouseMove Then
        DrawFrameControl hdc, MakeRect(0, 0, 13, 13), DFC_BUTTON, mType Or DFCS_MONO
    Else
        DrawFrameControl UserControl.hdc, MakeRect(0, 0, 13, 13), DFC_BUTTON, mType
    End If
    
    TextOut UserControl.hdc, 19, 0, mCaption, LenB(StrConv(mCaption, vbFromUnicode))
    UserControl.MaskPicture = UserControl.Image ' As transparent
End Sub

Answer 1

'标准模块代码：
Option Explicit
Public mMouseMove As BooleanPrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  
Private Const GWL_WNDPROC = (-4&)
Dim PrevWndProc&
Private Const WM_DESTROY = &H2
Public Declare Function TrackMouseEvent Lib "user32" (lpEventTrack As TRACKMOUSEEVENTTYPE) As Long
Public Const TME_CANCEL = &H80000000
Public Const TME_HOVER = &H1&
Public Const TME_LEAVE = &H2&
Public Const TME_NONCLIENT = &H10&
Public Const TME_QUERY = &H40000000
Private Const WM_MOUSELEAVE = &H2A3&
Public Type TRACKMOUSEEVENTTYPE
    cbSize As Long
    dwFlags As Long
    hwndTrack As Long
    dwHoverTime As Long
End TypePrivate Function SubWndProc(ByVal hwnd As Long, ByVal Msg As Long, _
                            ByVal wParam As Long, ByVal lParam As Long) _
                            As Long   If Msg = WM_DESTROY Then MouseLeft (hwnd)   If Msg = WM_MOUSELEAVE Then mMouseMove = False
   
   SubWndProc = CallWindowProc(PrevWndProc, hwnd, Msg, wParam, lParam)
   
End FunctionPublic Sub Init(hwnd As Long)
  PrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf SubWndProc)
End SubPublic Sub MouseLeft(hwnd As Long)
  Call SetWindowLong(hwnd, GWL_WNDPROC, PrevWndProc)
End Sub