vbAccelerator - Contents of code file: CancellableEditPopupVB_PopupCancelNotifier.vb

Namespace vbAccelerator.Components.Controls

    ''' <summary>
    ''' Represents the method that handles the <see
     cref="PopupCancelNotifier.PopupCancel"/> event
    ''' raised by this class.
    ''' </summary>
    Public Delegate Sub PopupCancelEventHandler(ByVal sender As Object, ByVal e
     As PopupCancelEventArgs)

    ''' <summary>
    ''' Arguments to a <see cref="PopupCancelEvent"/>.  Provides a
    ''' reference to the popup form that is to be closed and 
    ''' allows the operation to be cancelled.
    ''' </summary>
    Public Class PopupCancelEventArgs
        Inherits EventArgs

        ''' <summary>
        ''' Whether to cancel the operation
        ''' </summary>
        Private m_cancel As Boolean = False
        ''' <summary>
        ''' Mouse down location
        ''' </summary>
        Private m_location As Point
        ''' <summary>
        ''' Popup control.
        ''' </summary>
        Private m_popup As Control = Nothing

        ''' <summary>
        ''' Constructs a new instance of this class.
        ''' </summary>
        ''' <param name="popup">The popup form</param>
        ''' <param name="location">The mouse location, if any, where the
        ''' mouse event that would cancel the popup occured.</param>
        Public Sub New(ByVal popup As Control, ByVal location As Point)
            m_popup = popup
            m_location = location
            m_cancel = False
        End Sub

        ''' <summary>
        ''' Gets the popup control
        ''' </summary>
        Public ReadOnly Property Popup() As Control
            Get
                Return m_popup
            End Get
        End Property

        ''' <summary>
        ''' Gets the location that the mouse down which would cancel this 
        ''' popup occurred
        ''' </summary>
        Public ReadOnly Property CursorLocation() As Point
            Get
                Return m_location
            End Get
        End Property

        ''' <summary>
        ''' Gets/sets whether to cancel closing the form. Set to
        ''' <c>true</c> to prevent the popup from being closed.
        ''' </summary>
        Public Property Cancel() As Boolean
            Get
                Return m_cancel
            End Get
            Set(ByVal Value As Boolean)
                m_cancel = Value
            End Set
        End Property

    End Class


    ''' <summary>
    ''' 
    ''' A class which provides the functionality required to 
    ''' cancel a popup window.  This class wraps two pieces of 
    ''' functionality:
    ''' 
    ''' <list type="number">Firstly, it checks whether the form (or the form
     owner
    ''' for the control) receives a <c>WM_APPACTIVATE</c> message with
    ''' wParam = 0.  This indicates the window has gone out
    ''' of focus because the user has clicked on another one.</list>
    ''' <list type="number">Secondly, it installs a <see
     cref="System.Windows.Forms.IMessageFilter"/>
    ''' message filter implementation which checks for mouse presses anywhere 
    ''' else in the application.
    ''' 
    ''' <remarks>
    ''' Copyright &#169; 2003 Steve McMahon for vbAccelerator.com.
    ''' vbAccelerator is a Trade Mark of vbAccelerator Ltd.  All Rights
    ''' Reserved.  Please visit http:'vbaccelerator.com/ for more
    ''' on this and other VB and .NET Framework code.
    ''' </remarks>
    ''' 
    ''' </summary>
    Public Class PopupCancelNotifier
        Inherits NativeWindow

        Private Const WM_ACTIVATEAPP As Integer = &H1C

        ''' <summary>
        ''' Raised when the popup control is about to be cancelled.
        ''' </summary>
        Public Event PopupCancel As PopupCancelEventHandler

        ''' <summary>
        ''' The <see cref="System.Windows.Forms.IMessageFilter"/> object
        ''' which checks for mouse down outside the control
        ''' </summary>
        Private WithEvents filter As PopupCancelNotifierMessageFilter = Nothing

        ''' <summary>
        ''' Owning Form's Window handle to track for popup cancellation
        ''' </summary>
        Private trackHandle As IntPtr = IntPtr.Zero

        ''' <summary>
        ''' Control to track for popup cancellation
        ''' </summary>
        Private trackControl As Control = Nothing

        ''' <summary>
        ''' Start tracking for a popup cancellation.
        ''' </summary>
        ''' <param name="ctl">The <c>Control</c> or <c>Form</c>
        ''' to use when tracking Window inactivation messages. This can
        ''' either be a control or a Form.</param>
        Public Sub StartTracking(ByVal ctl As Control)

            Dim handle As IntPtr = IntPtr.Zero

            Dim ctlOwnerForm As Control = ctl
            Dim ctlTest As Control = Nothing
            While Not (TypeOf ctlOwnerForm Is Form)
             'not(typeof(Form).IsAssignableFrom(ctlOwnerForm.GetType()))
                ctlTest = ctlOwnerForm.Parent
                If (ctlTest Is Nothing) Then
                    Exit While
                Else
                    ctlOwnerForm = ctlTest
                End If
            End While

            Me.trackControl = ctl
            filter.Popup = ctl
            Me.trackHandle = ctlOwnerForm.Handle
            Me.AssignHandle(trackHandle)
            Application.AddMessageFilter(filter)

        End Sub

        ''' <summary>
        ''' Check for the WM_APPACTIVATE message and stop
        ''' tracking if the window is inactivated.
        ''' </summary>
        ''' <param name="msg">Message details for this window procedure
        ''' event.</param>
        Protected Overrides Sub WndProc(ByRef msg As Message)

            MyBase.WndProc(msg)
            If (msg.Msg = WM_ACTIVATEAPP) Then
                If (msg.WParam.Equals(IntPtr.Zero)) Then
                    Dim e As PopupCancelEventArgs = New PopupCancelEventArgs( _
                        Me.trackControl, Cursor.Position)
                    OnPopupCancel(e)
                End If
            End If
        End Sub

        ''' <summary>
        ''' Stop tracking. Called automatically if this class determines
        ''' the popup should be cancelled.
        ''' </summary>
        Public Sub StopTracking()
            If Not (Me.trackHandle.Equals(IntPtr.Zero)) Then
                Me.ReleaseHandle()
                Me.trackHandle = IntPtr.Zero
                Application.RemoveMessageFilter(filter)
                filter.Popup = Nothing
            End If
        End Sub

        ''' <summary>
        ''' Notify when the popup should be cancelled,
        ''' and uninstall tracking.
        ''' </summary>
        Protected Sub OnPopupCancel(ByVal e As PopupCancelEventArgs)
            RaiseEvent PopupCancel(Me, e)
            If Not (e.Cancel) Then
                StopTracking()
            End If
        End Sub

        ''' <summary>
        ''' Constructs a new instance of the PopupCancelNotifier
        ''' class.
        ''' </summary>
        Public Sub New()
            MyBase.New()
            Me.filter = New PopupCancelNotifierMessageFilter(Me)
        End Sub

        ''' <summary>
        ''' Pass through for the PopupCancel event of the Message Filter
        ''' </summary>
        ''' <param name="sender">The <see
         cref="PopupCancelNotifierEventFilter"/></param>
        ''' <param name="e"><see cref="PopupCancelEventArgs"/> describing the
         event
        ''' that will cancel the popup.</param>
        Private Sub filter_PopupCancel(ByVal sender As Object, ByVal e As
         CancellableEditPopupVB.vbAccelerator.Components.Controls.PopupCancelEve
        ntArgs) Handles filter.PopupCancel
            OnPopupCancel(e)
        End Sub
    End Class

#Region "PopupWindowHelperMessageFilter"
    ''' <summary>
    ''' A Message Loop filter which detect mouse events whilst the popup form
     is shown
    ''' and notifies the owning <see cref="PopupWindowHelper"/> class when a
     mouse
    ''' click outside the popup occurs.
    ''' </summary>
    Public Class PopupCancelNotifierMessageFilter
        Implements IMessageFilter

        Private Const WM_LBUTTONDOWN As Integer = &H201
        Private Const WM_RBUTTONDOWN As Integer = &H204
        Private Const WM_MBUTTONDOWN As Integer = &H207
        Private Const WM_NCLBUTTONDOWN As Integer = &HA1
        Private Const WM_NCRBUTTONDOWN As Integer = &HA4
        Private Const WM_NCMBUTTONDOWN As Integer = &HA7

        ''' <summary>
        ''' Raised when the Popup COntrol is about to be cancelled.  The
        ''' <see cref="PopupCancelEventArgs.Cancel"/> property can be
        ''' set to <c>true</c> to prevent the control from being cancelled.
        ''' </summary>
        Public Event PopupCancel As PopupCancelEventHandler

        ''' <summary>
        ''' The popup control
        ''' </summary>
        Private m_popup As Control = Nothing
        ''' <summary>
        ''' The owning <see cref="PopupCancelNotifier"/> object.
        ''' </summary>
        Private m_owner As PopupCancelNotifier = Nothing

        ''' <summary>
        ''' Constructs a new instance of this class and sets the owning
        ''' object.
        ''' </summary>
        ''' <param name="owner">The <see cref="PopupCancelNotifier"/> object
        ''' which owns this class.</param>
        Public Sub New(ByVal owner As PopupCancelNotifier)
            m_owner = owner
        End Sub

        ''' <summary>
        ''' Gets/sets the popup <see cref="System.Windows.Forms.Control"/>
         which is being displayed.
        ''' </summary>
        Public Property Popup() As Control
            Get
                Return m_popup
            End Get
            Set(ByVal Value As Control)
                m_popup = Value
            End Set
        End Property

        ''' <summary>
        ''' Checks the message loop for mouse messages whilst the popup
        ''' window is displayed.  If one is detected the position is
        ''' checked to see if it is outside the form, and the owner
        ''' is notified if so.
        ''' </summary>
        ''' <param name="m">Windows Message about to be processed by the
        ''' message loop</param>
        ''' <returns><c>true</c> to filter the message, <c>false</c> otherwise.
        ''' This implementation always returns <c>false</c>.</returns>
        Public Function PreFilterMessage(ByRef m As Message) As Boolean _
            Implements System.Windows.Forms.IMessageFilter.PreFilterMessage
            If Not (m_popup Is Nothing) Then
                Select Case (m.Msg)
                    Case WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN, _
                        WM_NCLBUTTONDOWN, WM_NCRBUTTONDOWN, WM_NCMBUTTONDOWN
                        OnMouseDown()
                End Select
            End If
            Return False
        End Function


        ''' <summary>
        ''' Checks the mouse location and calls the OnCancelPopup method
        ''' if the mouse is outside the popup form.      
        ''' </summary>
        Private Sub OnMouseDown()

            If Not (m_popup Is Nothing) Then
                ' Get the cursor location
                Dim cursorPos As Point = Cursor.Position
                ' To control coordinates:
                cursorPos = Me.Popup.PointToClient(cursorPos)
                ' Check if it is within the popup control
                If Not (Popup.ClientRectangle.Contains(cursorPos)) Then
                    ' If not, then call to see if it should be closed          
                         
                    OnCancelPopup(New PopupCancelEventArgs(Popup, cursorPos))
                End If
            End If
        End Sub

        ''' <summary>
        ''' Raises the <see cref="PopupCancel"/> event.
        ''' </summary>
        ''' <param name="e">The <see cref="PopupCancelEventArgs"/> associated 
        ''' with the cancel event.</param>
        Protected Overridable Sub OnCancelPopup(ByVal e As PopupCancelEventArgs)
            RaiseEvent PopupCancel(Me, e)
            If Not (e.Cancel) Then
                m_owner.StopTracking()
                ' Clear reference for GC
                m_popup = Nothing
            End If
        End Sub


    End Class
#End Region


End Namespace