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