Imports System
Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.Drawing.Imaging

''' <summary>
''' CAPTCHA image generation class
''' </summary>
''' <remarks>
''' Adapted from the excellent code at 
''' http://www.codeproject.com/aspnet/CaptchaImage.asp
''' </remarks>
Public Class CaptchaImage

    Private _height As Integer
    Private _width As Integer
    Private _rand As Random
    Private _generatedAt As DateTime
    Private _randomText As String
    Private _randomTextLength As Integer
    Private _randomTextChars As String
    Private _fontFamilyName As String
    Private _fontWarp As FontWarpFactor
    Private _backgroundNoise As BackgroundNoiseLevel
    Private _lineNoise As LineNoiseLevel
    Private _guid As String
    Private _fontWhitelist As String

#Region "  Public Enums"

    ''' <summary>
    ''' Amount of random font warping to apply to rendered text
    ''' </summary>
    Public Enum FontWarpFactor
        None
        Low
        Medium
        High
        Extreme
    End Enum

    ''' <summary>
    ''' Amount of background noise to add to rendered image
    ''' </summary>
    Public Enum BackgroundNoiseLevel
        None
        Low
        Medium
        High
        Extreme
    End Enum

    ''' <summary>
    ''' Amount of curved line noise to add to rendered image
    ''' </summary>
    Public Enum LineNoiseLevel
        None
        Low
        Medium
        High
        Extreme
    End Enum

#End Region

#Region "  Public Properties"

    ''' <summary>
    ''' Returns a GUID that uniquely identifies this Captcha
    ''' </summary>
    Public ReadOnly Property UniqueId() As String
        Get
            Return _guid
        End Get
    End Property

    ''' <summary>
    ''' Returns the date and time this image was last rendered
    ''' </summary>
    Public ReadOnly Property RenderedAt() As DateTime
        Get
            Return _generatedAt
        End Get
    End Property

    ''' <summary>
    ''' Font family to use when drawing the Captcha text. If no font is provided, a random font will be chosen from the font whitelist for each character.
    ''' </summary>
    Public Property Font() As String
        Get
            Return _fontFamilyName
        End Get
        Set(ByVal Value As String)
            Try
                Dim font1 As Font = New Font(Value, 12.0!)
                _fontFamilyName = Value
                font1.Dispose()
            Catch ex As Exception
                _fontFamilyName = Drawing.FontFamily.GenericSerif.Name
            End Try
        End Set
    End Property

    ''' <summary>
    ''' Amount of random warping to apply to the Captcha text.
    ''' </summary>
    Public Property FontWarp() As FontWarpFactor
        Get
            Return _fontWarp
        End Get
        Set(ByVal Value As FontWarpFactor)
            _fontWarp = Value
        End Set
    End Property

    ''' <summary>
    ''' Amount of background noise to apply to the Captcha image.
    ''' </summary>
    Public Property BackgroundNoise() As BackgroundNoiseLevel
        Get
            Return _backgroundNoise
        End Get
        Set(ByVal Value As BackgroundNoiseLevel)
            _backgroundNoise = Value
        End Set
    End Property

    Public Property LineNoise() As LineNoiseLevel
        Get
            Return _lineNoise
        End Get
        Set(ByVal value As LineNoiseLevel)
            _lineNoise = value
        End Set
    End Property

    ''' <summary>
    ''' A string of valid characters to use in the Captcha text. 
    ''' A random character will be selected from this string for each character.
    ''' </summary>
    Public Property TextChars() As String
        Get
            Return _randomTextChars
        End Get
        Set(ByVal Value As String)
            _randomTextChars = Value
            _randomText = GenerateRandomText()
        End Set
    End Property

    ''' <summary>
    ''' Number of characters to use in the Captcha text. 
    ''' </summary>
    Public Property TextLength() As Integer
        Get
            Return _randomTextLength
        End Get
        Set(ByVal Value As Integer)
            _randomTextLength = Value
            _randomText = GenerateRandomText()
        End Set
    End Property

    ''' <summary>
    ''' Returns the randomly generated Captcha text.
    ''' </summary>
    Public ReadOnly Property [Text]() As String
        Get
            Return _randomText
        End Get
    End Property

    ''' <summary>
    ''' Width of Captcha image to generate, in pixels 
    ''' </summary>
    Public Property Width() As Integer
        Get
            Return _width
        End Get
        Set(ByVal Value As Integer)
            If (Value <= 60) Then
                Throw New ArgumentOutOfRangeException("width", Value, "width must be greater than 60.")
            End If
            _width = Value
        End Set
    End Property

    ''' <summary>
    ''' Height of Captcha image to generate, in pixels 
    ''' </summary>
    Public Property Height() As Integer
        Get
            Return _height
        End Get
        Set(ByVal Value As Integer)
            If Value <= 30 Then
                Throw New ArgumentOutOfRangeException("height", Value, "height must be greater than 30.")
            End If
            _height = Value
        End Set
    End Property

    ''' <summary>
    ''' A semicolon-delimited list of valid fonts to use when no font is provided.
    ''' </summary>
    Public Property FontWhitelist() As String
        Get
            Return _fontWhitelist
        End Get
        Set(ByVal value As String)
            _fontWhitelist = value
        End Set
    End Property

#End Region

    Public Sub New()
        _rand = New Random
        _fontWarp = FontWarpFactor.Low
        _backgroundNoise = BackgroundNoiseLevel.Low
        _lineNoise = LineNoiseLevel.None
        _width = 180
        _height = 50
        _randomTextLength = 5
        _randomTextChars = "ACDEFGHJKLNPQRTUVXYZ2346789!"
        _fontFamilyName = ""
        ' -- a list of known good fonts in on both Windows XP and Windows Server 2003
        _fontWhitelist = _
            "arial;arial black;comic sans ms;courier new;estrangelo edessa;franklin gothic medium;" & _
            "georgia;lucida console;lucida sans unicode;mangal;microsoft sans serif;palatino linotype;" & _
            "sylfaen;tahoma;times new roman;trebuchet ms;verdana"
        _randomText = GenerateRandomText()
        _generatedAt = DateTime.Now
        _guid = Guid.NewGuid.ToString()
    End Sub

    ''' <summary>
    ''' Forces a new Captcha image to be generated using current property value settings.
    ''' </summary>
    Public Function RenderImage() As Bitmap
        Return GenerateImagePrivate()
    End Function

    ''' <summary>
    ''' Returns a random font family from the font whitelist
    ''' </summary>
    Private Function RandomFontFamily() As String
        Static ff() As String
        '-- small optimization so we don't have to split for each char
        If ff Is Nothing Then
            ff = _fontWhitelist.Split(";"c)
        End If
        Return ff(_rand.Next(0, ff.Length))
    End Function

    ''' <summary>
    ''' generate random text for the CAPTCHA
    ''' </summary>
    Private Function GenerateRandomText() As String
        Dim sb As New System.Text.StringBuilder(_randomTextLength)
        Dim maxLength As Integer = _randomTextChars.Length
        For n As Integer = 0 To _randomTextLength - 1
            sb.Append(_randomTextChars.Substring(_rand.Next(maxLength), 1))
        Next
        Return sb.ToString
    End Function

    ''' <summary>
    ''' Returns a random point within the specified x and y ranges
    ''' </summary>
    Private Function RandomPoint(ByVal xmin As Integer, ByVal xmax As Integer, ByRef ymin As Integer, ByRef ymax As Integer) As PointF
        Return New PointF(_rand.Next(xmin, xmax), _rand.Next(ymin, ymax))
    End Function

    ''' <summary>
    ''' Returns a random point within the specified rectangle
    ''' </summary>
    Private Function RandomPoint(ByVal rect As Rectangle) As PointF
        Return RandomPoint(rect.Left, rect.Width, rect.Top, rect.Bottom)
    End Function

    ''' <summary>
    ''' Returns a GraphicsPath containing the specified string and font
    ''' </summary>
    Private Function TextPath(ByVal s As String, ByVal f As Font, ByVal r As Rectangle) As GraphicsPath
        Dim sf As StringFormat = New StringFormat
        sf.Alignment = StringAlignment.Near
        sf.LineAlignment = StringAlignment.Near
        Dim gp As GraphicsPath = New GraphicsPath
        gp.AddString(s, f.FontFamily, CType(f.Style, Integer), f.Size, r, sf)
        Return gp
    End Function

    ''' <summary>
    ''' Returns the CAPTCHA font in an appropriate size 
    ''' </summary>
    Private Function GetFont() As Font
        Dim fsize As Single
        Dim fname As String = _fontFamilyName
        If fname = "" Then
            fname = RandomFontFamily()
        End If
        Select Case Me.FontWarp
            Case FontWarpFactor.None
                fsize = Convert.ToInt32(_height * 0.7)
            Case FontWarpFactor.Low
                fsize = Convert.ToInt32(_height * 0.8)
            Case FontWarpFactor.Medium
                fsize = Convert.ToInt32(_height * 0.85)
            Case FontWarpFactor.High
                fsize = Convert.ToInt32(_height * 0.9)
            Case FontWarpFactor.Extreme
                fsize = Convert.ToInt32(_height * 0.95)
        End Select
        Return New Font(fname, fsize, FontStyle.Bold)
    End Function

    ''' <summary>
    ''' Renders the CAPTCHA image
    ''' </summary>
    Private Function GenerateImagePrivate() As Bitmap
        Dim fnt As Font = Nothing
        Dim rect As Rectangle
        Dim br As Brush
        Dim bmp As Bitmap = New Bitmap(_width, _height, PixelFormat.Format32bppArgb)
        Dim gr As Graphics = Graphics.FromImage(bmp)
        gr.SmoothingMode = SmoothingMode.AntiAlias

        '-- fill an empty white rectangle
        rect = New Rectangle(0, 0, _width, _height)
        br = New SolidBrush(Color.White)
        gr.FillRectangle(br, rect)

        Dim charOffset As Integer = 0
        Dim charWidth As Double = _width / _randomTextLength
        Dim rectChar As Rectangle

        For Each c As Char In _randomText
            '-- establish font and draw area
            fnt = GetFont()
            rectChar = New Rectangle(Convert.ToInt32(charOffset * charWidth), 0, Convert.ToInt32(charWidth), _height)

            '-- warp the character
            Dim gp As GraphicsPath = TextPath(c, fnt, rectChar)
            WarpText(gp, rectChar)

            '-- draw the character
            br = New SolidBrush(Color.Black)
            gr.FillPath(br, gp)

            charOffset += 1
        Next

        AddNoise(gr, rect)
        AddLine(gr, rect)

        '-- clean up unmanaged resources
        fnt.Dispose()
        br.Dispose()
        gr.Dispose()

        Return bmp
    End Function

    ''' <summary>
    ''' Warp the provided text GraphicsPath by a variable amount
    ''' </summary>
    Private Sub WarpText(ByVal textPath As GraphicsPath, ByVal rect As Rectangle)
        Dim WarpDivisor As Single
        Dim RangeModifier As Single

        Select Case _fontWarp
            Case FontWarpFactor.None
                Return
            Case FontWarpFactor.Low
                WarpDivisor = 6
                RangeModifier = 1
            Case FontWarpFactor.Medium
                WarpDivisor = 5
                RangeModifier = 1.3
            Case FontWarpFactor.High
                WarpDivisor = 4.5
                RangeModifier = 1.4
            Case FontWarpFactor.Extreme
                WarpDivisor = 4
                RangeModifier = 1.5
        End Select

        Dim rectF As RectangleF
        rectF = New RectangleF(Convert.ToSingle(rect.Left), 0, Convert.ToSingle(rect.Width), rect.Height)

        Dim hrange As Integer = Convert.ToInt32(rect.Height / WarpDivisor)
        Dim wrange As Integer = Convert.ToInt32(rect.Width / WarpDivisor)
        Dim left As Integer = rect.Left - Convert.ToInt32(wrange * RangeModifier)
        Dim top As Integer = rect.Top - Convert.ToInt32(hrange * RangeModifier)
        Dim width As Integer = rect.Left + rect.Width + Convert.ToInt32(wrange * RangeModifier)
        Dim height As Integer = rect.Top + rect.Height + Convert.ToInt32(hrange * RangeModifier)

        If left < 0 Then left = 0
        If top < 0 Then top = 0
        If width > Me.Width Then width = Me.Width
        If height > Me.Height Then height = Me.Height

        Dim leftTop As PointF = RandomPoint(left, left + wrange, top, top + hrange)
        Dim rightTop As PointF = RandomPoint(width - wrange, width, top, top + hrange)
        Dim leftBottom As PointF = RandomPoint(left, left + wrange, height - hrange, height)
        Dim rightBottom As PointF = RandomPoint(width - wrange, width, height - hrange, height)

        Dim points As PointF() = New PointF() {leftTop, rightTop, leftBottom, rightBottom}
        Dim m As New Matrix
        m.Translate(0, 0)
        textPath.Warp(points, rectF, m, WarpMode.Perspective, 0)
    End Sub


    ''' <summary>
    ''' Add a variable level of graphic noise to the image
    ''' </summary>
    Private Sub AddNoise(ByVal graphics1 As Graphics, ByVal rect As Rectangle)
        Dim density As Integer
        Dim size As Integer

        Select Case _backgroundNoise
            Case BackgroundNoiseLevel.None
                Return
            Case BackgroundNoiseLevel.Low
                density = 30
                size = 40
            Case BackgroundNoiseLevel.Medium
                density = 18
                size = 40
            Case BackgroundNoiseLevel.High
                density = 16
                size = 39
            Case BackgroundNoiseLevel.Extreme
                density = 12
                size = 38
        End Select

        Dim br As New SolidBrush(Color.Black)
        Dim max As Integer = Convert.ToInt32(Math.Max(rect.Width, rect.Height) / size)

        For i As Integer = 0 To Convert.ToInt32((rect.Width * rect.Height) / density)
            graphics1.FillEllipse(br, _rand.Next(rect.Width), _rand.Next(rect.Height), _
                _rand.Next(max), _rand.Next(max))
        Next
        br.Dispose()
    End Sub

    ''' <summary>
    ''' Add variable level of curved lines to the image
    ''' </summary>
    Private Sub AddLine(ByVal graphics1 As Graphics, ByVal rect As Rectangle)

        Dim length As Integer
        Dim width As Single
        Dim linecount As Integer

        Select Case _lineNoise
            Case LineNoiseLevel.None
                Return
            Case LineNoiseLevel.Low
                length = 4
                width = Convert.ToSingle(_height / 31.25) ' 1.6
                linecount = 1
            Case LineNoiseLevel.Medium
                length = 5
                width = Convert.ToSingle(_height / 27.7777) ' 1.8
                linecount = 1
            Case LineNoiseLevel.High
                length = 3
                width = Convert.ToSingle(_height / 25) ' 2.0
                linecount = 2
            Case LineNoiseLevel.Extreme
                length = 3
                width = Convert.ToSingle(_height / 22.7272) ' 2.2
                linecount = 3
        End Select

        Dim pf(length) As PointF
        Dim p As New Pen(Color.Black, width)

        For l As Integer = 1 To linecount
            For i As Integer = 0 To length
                pf(i) = RandomPoint(rect)
            Next
            graphics1.DrawCurve(p, pf, 1.75)
        Next

        p.Dispose()
    End Sub

End Class