Imports System
Imports System.ComponentModel
Imports System.Drawing.Design
Imports System.Windows.Forms
Imports System.Windows.Forms.Design
Imports System.Runtime.InteropServices

Public Class MaskedComboBox

    Inherits ComboBox

    Private maskProvider As MaskedTextProvider

    ' Czy da się to zrobić w ramach modelu zarządzanego?
    <DllImport("user32.dll")> _
    Public Shared Function GetKeyState(ByVal key As Integer) As Integer
    End Function

    <EditorAttribute(GetType(MaskPropertyEditor), GetType(UITypeEditor))> _
    Public Property Mask() As String
        Get
            If maskProvider Is Nothing Then
                Return ""
            Else
                Return maskProvider.Mask
            End If
        End Get
        Set(ByVal value As String)
            If value = "" Then
                maskProvider = Nothing
                Me.Text = ""
            Else
                ' Me wydaje się być konieczne, ponieważ maska jest tylko do odczytu
                maskProvider = New MaskedTextProvider(value)
                Me.Text = maskProvider.ToDisplayString()
            End If
        End Set
    End Property

    Public ReadOnly Property MaskCompleted() As Boolean
        Get
            Return maskProvider.MaskCompleted
        End Get
    End Property

    Protected Overrides Sub OnKeyDown(ByVal e As KeyEventArgs)
        Dim pos As Integer = Me.SelectionStart

        ' Usuwanie znaku (klawisz Delete)
        ' Obecnie kontrolka nic nie robi, jeśli użytkownik spróbuje
        ' usunąć znak formatujący (inaczej niż MaskedTextBox, która
        ' przechodzi do następnego znaku wejściowego).
        ' Moglibyśmy użyć prywatnej metody SkipToEditableCharacter,
        ' aby zmienić działanie kontrolki.
        If CInt(e.KeyCode) = CInt(Keys.Delete) And pos < Me.Text.Length Then
            If maskProvider.RemoveAt(pos) Then
                RefreshText(pos)
            End If
            e.Handled = True
        End If

        ' Usuwanie znaku (klawisz Backspace).
        ' Obecnie kontrolka zatrzymuje się na znaku formatującym
        ' (w przeciwieństwie do MaskedTextBox, która przechodzi
        ' do następnego znaku wejściowego)
        ' Moglibyśmy użyć prywatnej metody SkipToEditableCharacter,
        ' aby zmienić działanie kontrolki.
        If e.KeyCode = Keys.Back Then
            If pos > 0 Then
                pos -= 1
                If maskProvider.RemoveAt(pos) Then
                    RefreshText(pos)
                End If
                e.Handled = True
            End If
        End If
        MyBase.OnKeyDown(e)
    End Sub

    Protected Overrides Sub OnKeyPress(ByVal e As KeyPressEventArgs)
        If Not maskProvider Is Nothing Then
            Dim pos As Integer = Me.SelectionStart

            If pos < Me.Text.Length Then
                pos = SkipToEditableCharacter(pos)

                ' Tryb nadpisywania
                If GetKeyState(CInt(Keys.Insert) = 1) Then
                    maskProvider.Replace(e.KeyChar, pos)
                    pos += 1

                    ' Tryb wstawiania
                ElseIf (maskProvider.InsertAt(e.KeyChar, pos)) Then
                    pos += 1
                End If

                ' Określanie nowego położenia kursora
                pos = SkipToEditableCharacter(pos)
            End If
            RefreshText(pos)
            e.Handled = True
        End If
        MyBase.OnKeyPress(e)
    End Sub


    Private Sub RefreshText(ByVal pos As Integer)
        ' Odświeżanie łańcucha
        ' Czy da się to zrobić wydajniej?
        ' Specyfikacja wspomina o wyliczeniach, ale nie sądzę,
        ' żeby robiło to różnicę (bo zmiana dowolnego znaku
        ' zasadniczo tworzy nowy obiekt String)
        Me.Text = maskProvider.ToDisplayString()

        ' Pozycjonowanie kursora
        Me.SelectionStart = pos
    End Sub

    ' Znajduje następny znak nie należący do maski
    Private Function SkipToEditableCharacter(ByVal startPos As Integer) As Integer
        Dim newPos As Integer = maskProvider.FindEditPositionFrom(startPos, True)
        If newPos = -1 Then
            ' Jesteśmy na końcu łańcucha
            Return startPos
        Else
            Return newPos
        End If
    End Function

End Class
