Imports System.Text
Imports System.ComponentModel
Imports System.Windows.Forms

''' <summary>
''' Represents a textbox that allows users to enter shortcuts.
''' </summary>
Public Class ShortcutTextBox
    Inherits TextBox

    '//constants
    Private Const UserAllowingNoneErrorMessage As String = "You must allow at least one of the four types (arrows, digits, function keys or letters) to create a valid shortcut."

    '//events
    ''' <summary>
    ''' Occurs when the ShortcutKeys property changes.
    ''' </summary>
    <Description("Occurs when the ShortcutKeys property changes.")> _
    Public Event ShortcutKeysChanged As EventHandler(Of System.EventArgs)

    '//properties
    <Browsable(False)> _
    <DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)> _
    <EditorBrowsable(EditorBrowsableState.Never)> _
    Public Overloads Property [ReadOnly]() As Boolean
        Get
            Return True
        End Get
        Set(ByVal value As Boolean)
            MyBase.ReadOnly = True
        End Set
    End Property

    <Browsable(False)> _
    <DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)> _
    <EditorBrowsable(EditorBrowsableState.Never)> _
    Public Overrides Property Text() As String
        Get
            Return MyBase.Text
        End Get
        Set(ByVal value As String)
            MyBase.Text = "None"
        End Set
    End Property

    <Browsable(False)> _
    <DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)> _
    <EditorBrowsable(EditorBrowsableState.Never)> _
    Public Overrides Property Multiline() As Boolean
        Get
            Return False
        End Get
        Set(ByVal value As Boolean)
            MyBase.Multiline = False
        End Set
    End Property

    Private _allowLetters As Boolean = True
    ''' <summary>
    ''' Gets or sets a value indicating whether shortcuts can be composed of a letter.
    ''' </summary>
    <DefaultValue(True)> _
    <Description("Indicates whether shortcuts can be composed of a letter.")> _
    Public Property AllowLetters() As Boolean
        Get
            Return Me._allowLetters
        End Get
        Set(ByVal value As Boolean)
            If Not value AndAlso Not Me.AllowArrows AndAlso Not Me.AllowDigits AndAlso Not Me.AllowFunctionKeys Then
                Throw New ArgumentException(ShortcutTextBox.UserAllowingNoneErrorMessage)
            End If
            Me._allowLetters = value
        End Set
    End Property

    Private _allowDigits As Boolean = True
    ''' <summary>
    ''' Gets or sets a value indicating whether shortcuts can be composed of a digit.
    ''' </summary>
    <DefaultValue(True)> _
    <Description("Indicates whether shortcuts can be composed of a digit.")> _
    Public Property AllowDigits() As Boolean
        Get
            Return Me._allowDigits
        End Get
        Set(ByVal value As Boolean)
            If Not value AndAlso Not Me.AllowArrows AndAlso Not Me.AllowFunctionKeys AndAlso Not Me.AllowLetters Then
                Throw New ArgumentException(ShortcutTextBox.UserAllowingNoneErrorMessage)
            End If
            Me._allowDigits = value
        End Set
    End Property

    Private _allowArrows As Boolean = True
    ''' <summary>
    ''' Gets or sets a value indicating whether shortcuts can be composed of an arrow.
    ''' </summary>
    <DefaultValue(True)> _
    <Description("Indicates whether shortcuts can be composed of an arrow.")> _
    Public Property AllowArrows() As Boolean
        Get
            Return Me._allowArrows
        End Get
        Set(ByVal value As Boolean)
            If Not value AndAlso Not Me.AllowDigits AndAlso Not Me.AllowFunctionKeys AndAlso Not Me.AllowLetters Then
                Throw New ArgumentException(ShortcutTextBox.UserAllowingNoneErrorMessage)
            End If
            Me._allowArrows = value
        End Set
    End Property

    Private _allowFunctionKeys As Boolean = True
    ''' <summary>
    ''' Gets or set a value indicating whether shortcuts can be composed of a function key.
    ''' </summary>
    <DefaultValue(True)> _
    <Description("Indicates whether shortcuts can be composed of a function key.")> _
    Public Property AllowFunctionKeys() As Boolean
        Get
            Return Me._allowFunctionKeys
        End Get
        Set(ByVal value As Boolean)
            If Not value AndAlso Not Me.AllowDigits AndAlso Not Me.AllowLetters Then
                Throw New ArgumentException(ShortcutTextBox.UserAllowingNoneErrorMessage)
            End If
            Me._allowFunctionKeys = value
        End Set
    End Property

    Private _shortcutKeys As Keys = Keys.None
    ''' <summary>
    ''' Gets or sets a value indicating the shortcut associated by the user.
    ''' </summary>
    <DefaultValue(GetType(Keys), "None")> _
    <Description("Indicates the shortcut associated by the user.")> _
    Public Property ShortcutKeys() As Keys
        Get
            Return Me._shortcutKeys
        End Get
        Set(ByVal value As Keys)
            Dim keyValue = Me.GetKeyValue(value)
            Dim isModifier = Me.KeyValueIsModifier(keyValue)
            Dim isAny = Me.KeyValueIsAny(keyValue)
            Dim isAllowed = Me.KeyValueIsAllowed(keyValue)
            If Not isModifier AndAlso Not isAny Then
                MyBase.Text = "None"
                value = Keys.None
            ElseIf (isModifier AndAlso Not isAny) OrElse Not isAllowed Then
                MyBase.Text = Me.ProcessKeyArgs(New KeyEventArgs(value))
                value = Keys.None
            Else
                MyBase.Text = Me.ProcessKeyArgs(New KeyEventArgs(value))
            End If
            MyBase.SelectionStart = MyBase.TextLength
            If Not Object.Equals(value, Me._shortcutKeys) Then
                Me._shortcutKeys = value
                Me.OnShortcutKeysChanged(EventArgs.Empty)
            End If
        End Set
    End Property

    '//constructors
    ''' <summary>
    ''' Initializes a new instance of the ShortcutTextBox class.
    ''' </summary>
    Public Sub New()
        MyBase.ReadOnly = True
        MyBase.Multiline = False
        MyBase.Cursor = Cursors.Arrow
        MyBase.Text = "None"
        MyBase.SelectionStart = MyBase.TextLength
    End Sub

    '//methods
    ''' <summary>
    ''' Raises the System.Windows.Forms.Control.KeyDown event.
    ''' </summary>
    ''' <param name="e">A System.Windows.Forms.KeyEventArgs that contains the event data.</param>
    Protected Overrides Sub OnKeyDown(ByVal e As System.Windows.Forms.KeyEventArgs)
        Me.ShortcutKeys = e.KeyData
        e.SuppressKeyPress = True
        e.Handled = True
    End Sub

    ''' <summary>
    ''' Raises the System.Windows.Forms.Control.KeyUp event.
    ''' </summary>
    ''' <param name="e">A System.Windows.Forms.KeyEventArgs that contains the event data.</param>
    Protected Overrides Sub OnKeyUp(ByVal e As System.Windows.Forms.KeyEventArgs)
        If Not Me.KeyValueIsAny(Me.GetKeyValue(Me.ShortcutKeys)) Then
            Me.ShortcutKeys = Keys.None
        End If
    End Sub

    ''' <summary>
    ''' Raises the ShortcutTextBox.ShortcutKeysChanged event.
    ''' </summary>
    ''' <param name="e">A System.EventArgs that contains the event data.</param>
    Protected Overridable Sub OnShortcutKeysChanged(ByVal e As System.EventArgs)
        RaiseEvent ShortcutKeysChanged(Me, e)
    End Sub

    ''' <summary>
    ''' Processes Windows messages.
    ''' </summary>
    ''' <param name="m">The Windows System.Windows.Forms.Message to process.</param>
    Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
        Const WM_MOUSEDOWN As Integer = &H201
        Const WM_LBUTTONDBLCLK As Integer = &H203
        Const WM_RBUTTONDOWN As Integer = &H204
        If m.Msg = WM_MOUSEDOWN OrElse _
           m.Msg = WM_RBUTTONDOWN OrElse _
           m.Msg = WM_LBUTTONDBLCLK Then
            Me.Select()
            MyBase.SelectionStart = MyBase.TextLength
            Return
        End If
        MyBase.WndProc(m)
    End Sub

    Private Function GetKeyValue(ByVal keyData As Keys) As Integer
        Return (keyData And &HFFFF)
    End Function

    Private Function ProcessKeyArgs(ByVal e As KeyEventArgs) As String
        Dim builder = New StringBuilder()
        If e.Control Then
            builder.Append("Ctrl + ")
        End If
        If e.Alt Then
            builder.Append("Alt + ")
        End If
        If e.Shift Then
            builder.Append("Shift + ")
        End If
        If Me.AllowLetters AndAlso Me.KeyValueIsLetter(e.KeyValue) Then
            builder.Append(e.KeyCode.ToString())
        ElseIf Me.AllowDigits AndAlso Me.KeyValueIsDigit(e.KeyValue) Then
            builder.Append(e.KeyCode - Keys.D0)
        ElseIf Me.AllowFunctionKeys AndAlso Me.KeyValueIsFunctionKey(e.KeyValue) Then
            builder.Append(e.KeyCode.ToString())
        ElseIf Me.AllowArrows AndAlso Me.KeyValueIsArrow(e.KeyValue) Then
            builder.Append(e.KeyCode.ToString())
        End If
        Return builder.ToString()
    End Function

    Private Function KeyValueIsAllowed(ByVal keyValue As Integer) As Boolean
        If Me.KeyValueIsArrow(keyValue) Then
            Return Me.AllowArrows
        End If
        If Me.KeyValueIsDigit(keyValue) Then
            Return Me.AllowDigits
        End If
        If Me.KeyValueIsFunctionKey(keyValue) Then
            Return Me.AllowFunctionKeys
        End If
        If Me.KeyValueIsLetter(keyValue) Then
            Return Me.AllowLetters
        End If
    End Function

    Private Function KeyValueIsAny(ByVal keyValue As Integer) As Boolean
        Return Me.KeyValueIsDigit(keyValue) OrElse _
               Me.KeyValueIsFunctionKey(keyValue) OrElse _
               Me.KeyValueIsLetter(keyValue) OrElse _
               Me.KeyValueIsArrow(keyValue)
    End Function

    Private Function KeyValueIsArrow(ByVal keyValue As Integer) As Boolean
        Return Me.KeyValueIsInRange(keyValue, _
                                    Keys.Left, _
                                    Keys.Down)
    End Function

    Private Function KeyValueIsDigit(ByVal keyValue As Integer) As Boolean
        Dim isDPadDigit = Me.KeyValueIsInRange(keyValue, Keys.D0, Keys.D9)
        Dim isNPadDigit = Me.KeyValueIsInRange(keyValue, Keys.NumPad0, Keys.NumPad9)
        Return isDPadDigit OrElse isNPadDigit
    End Function

    Private Function KeyValueIsFunctionKey(ByVal keyValue As Integer) As Boolean
        Return Me.KeyValueIsInRange(keyValue, _
                                    Keys.F1, _
                                    Keys.F24)
    End Function

    Private Function KeyValueIsLetter(ByVal keyValue As Integer) As Boolean
        Return Me.KeyValueIsInRange(keyValue, _
                                    Keys.A, _
                                    Keys.Z)
    End Function

    Private Function KeyValueIsModifier(ByVal keyValue As Integer) As Boolean
        Return keyValue = Keys.Menu OrElse _
               keyValue = Keys.ShiftKey OrElse _
               keyValue = Keys.ControlKey
    End Function

    Private Function KeyValueIsInRange(ByVal keyValue As Integer, _
                                       ByVal startingRange As Integer, _
                                       ByVal endingRange As Integer) As Boolean
        Return (keyValue >= startingRange AndAlso keyValue <= endingRange)
    End Function

End Class