Virtual Keyboard Control - VB.NET

Imports System.Drawing.Drawing2D
Imports System.Drawing.Text

'------------------
'Creator: aeonhack
'Site: elitevs.net
'Created: 03/25/2013
'Changed: 03/28/2013
'Version: 1.1.0
'------------------

Class VirtualKeyboard
    Inherits Control

    Private TextBitmap As Bitmap
    Private TextGraphics As Graphics

    Const LowerKeys As String = "1234567890-=qwertyuiop[]asdfghjkl\;'zxcvbnm,./`"
    Const UpperKeys As String = "!@#$%^&*()_+QWERTYUIOP{}ASDFGHJKL|:""ZXCVBNM<>?~"

    Sub New()
        SetStyle(DirectCast(139270, ControlStyles), True)

        Font = New Font("Verdana", 8.25F)

        TextBitmap = New Bitmap(1, 1)
        TextGraphics = Graphics.FromImage(TextBitmap)

        MinimumSize = New Size(386, 162)
        MaximumSize = New Size(386, 162)

        Lower = LowerKeys.ToCharArray()
        Upper = UpperKeys.ToCharArray()

        PrepareCache()
    End Sub

    Public Target As Control
    Public Sub AssignControl(c As Control)
        Target = c
    End Sub

    Private Shift As Boolean

    Private Pressed As Integer = -1
    Private Buttons As Rectangle()

    Private Lower As Char()
    Private Upper As Char()
    Private Other As String() = {"Shift", "Space", "Back"}

    Private UpperCache As PointF()
    Private LowerCache As PointF()

    Private Sub PrepareCache()
        Buttons = New Rectangle(50) {}
        UpperCache = New PointF(Upper.Length - 1) {}
        LowerCache = New PointF(Lower.Length - 1) {}

        Dim I As Integer

        Dim S As SizeF
        Dim R As Rectangle

        For Y As Integer = 0 To 3
            For X As Integer = 0 To 11
                I = (Y * 12) + X
                R = New Rectangle(X * 32, Y * 32, 32, 32)

                Buttons(I) = R

                If Not I = 47 AndAlso Not Char.IsLetter(Upper(I)) Then
                    S = TextGraphics.MeasureString(Upper(I), Font)
                    UpperCache(I) = New PointF(R.X + (R.Width \ 2 - S.Width / 2), R.Y + R.Height - S.Height - 2)

                    S = TextGraphics.MeasureString(Lower(I), Font)
                    LowerCache(I) = New PointF(R.X + (R.Width \ 2 - S.Width / 2), R.Y + R.Height - S.Height - 2)
                End If
            Next
        Next

        Buttons(48) = New Rectangle(0, 4 * 32, 2 * 32, 32)
        Buttons(49) = New Rectangle(Buttons(48).Right, 4 * 32, 8 * 32, 32)
        Buttons(50) = New Rectangle(Buttons(49).Right, 4 * 32, 2 * 32, 32)
    End Sub

    Private G As Graphics
    Protected Overrides Sub OnPaint(e As System.Windows.Forms.PaintEventArgs)
        G = e.Graphics
        G.TextRenderingHint = TextRenderingHint.ClearTypeGridFit

        G.Clear(SystemColors.Control)

        Dim S As SizeF
        Dim P As PointF
        Dim R As Rectangle

        Dim Offset As Integer

        G.DrawRectangle(SystemPens.ControlDarkDark, 0, 0, (12 * 32) + 1, (5 * 32) + 1)

        For I As Integer = 0 To Buttons.Length - 1
            R = Buttons(I)

            Offset = 0
            If I = Pressed Then Offset = 1

            Select Case I
                Case 48, 49, 50
                    S = G.MeasureString(Other(I - 48), Font)
                    G.DrawString(Other(I - 48), Font, SystemBrushes.ControlText, R.X + (R.Width \ 2 - S.Width / 2) + Offset, R.Y + (R.Height \ 2 - S.Height / 2) + Offset)
                Case 47
                    DrawArrow(R.X + Offset, R.Y + Offset)
                Case Else
                    If Shift Then
                        G.DrawString(Upper(I), Font, SystemBrushes.ControlText, R.X + 3 + Offset, R.Y + 2 + Offset)

                        If Not Char.IsLetter(Lower(I)) Then
                            P = LowerCache(I)
                            G.DrawString(Lower(I), Font, SystemBrushes.ControlDark, P.X + Offset, P.Y + Offset)
                        End If
                    Else
                        G.DrawString(Lower(I), Font, SystemBrushes.ControlText, R.X + 3 + Offset, R.Y + 2 + Offset)

                        If Not Char.IsLetter(Upper(I)) Then
                            P = UpperCache(I)
                            G.DrawString(Upper(I), Font, SystemBrushes.ControlDark, P.X + Offset, P.Y + Offset)
                        End If
                    End If
            End Select

            G.DrawRectangle(SystemPens.ControlLightLight, R.X + 1 + Offset, R.Y + 1 + Offset, R.Width - 2, R.Height - 2)
            G.DrawRectangle(SystemPens.ControlDark, R.X + Offset, R.Y + Offset, R.Width, R.Height)

            If I = Pressed Then
                G.DrawLine(SystemPens.ControlDarkDark, R.X, R.Y, R.Right, R.Y)
                G.DrawLine(SystemPens.ControlDarkDark, R.X, R.Y, R.X, R.Bottom)
            End If
        Next
    End Sub

    Private Sub DrawArrow(rx As Integer, ry As Integer)
        Dim R As New Rectangle(rx + 8, ry + 8, 16, 16)
        G.SmoothingMode = SmoothingMode.AntiAlias

        Dim P As New Pen(SystemColors.ControlText, 1)
        Dim C As New AdjustableArrowCap(3, 2)
        P.CustomEndCap = C

        G.DrawArc(P, R, 0.0F, 290.0F)

        P.Dispose()
        C.Dispose()
        G.SmoothingMode = SmoothingMode.None
    End Sub

    Protected Overrides Sub OnMouseDown(e As MouseEventArgs)
        Dim Index As Integer = ((e.Y \ 32) * 12) + (e.X \ 32)

        If Index > 47 Then
            For I As Integer = 48 To Buttons.Length - 1
                If Buttons(I).Contains(e.X, e.Y) Then
                    Pressed = I
                    Exit For
                End If
            Next
        Else
            Pressed = Index
        End If

        HandleKey()
        Invalidate()
    End Sub

    Protected Overrides Sub OnMouseUp(e As MouseEventArgs)
        Pressed = -1
        Invalidate()
    End Sub

    Private Sub HandleKey()
        If Target Is Nothing Then Return
        If Pressed = -1 Then Return

        Select Case Pressed
            Case 47
                Target.Text = String.Empty
            Case 48
                Shift = Not Shift
            Case 49
                Target.Text &= " "
            Case 50
                If Not Target.Text.Length = 0 Then
                    Target.Text = Target.Text.Remove(Target.Text.Length - 1)
                End If
            Case Else
                If Shift Then
                    Target.Text &= Upper(Pressed)
                Else
                    Target.Text &= Lower(Pressed)
                End If
        End Select
    End Sub

End Class