What's New
Q & A
Tip Jar
C# Helper...
Follow VBHelper on Twitter
MSDN Visual Basic Community
TitleMake CAPTCHA images (version 2) in VB .NET
DescriptionThis example shows how to make CAPTCHA images (version 2) in VB .NET.
KeywordsCAPTCHA, Turing test, image, image processing, distort image, VB.NET
CategoriesGraphics, Software Engineering
CAPTCHA (Completely Automated Public Turing test to tell Computers and Humans Apart) images are those distorted pictures of words that some Web sites make you enter to prove you are a human and not an automated process. The idea is to distort the characters in the image so it would be hard for an optical character recognition (OCR) application to read them but so it would still be easy for a person to read them.

This example extands a technique described at BrainJar.com.

Function MakeCaptchaImage makes a Bitmap of the desired size and clears it. For each character in the message, it creates a random font and calls subroutine DrawCharacter to draw each character separately. The code then draws some lines to clutter the image and introduce breaks in the letters to make it harder for OCR software to read.

' Make a captcha image for the text.
Private Function MakeCaptchaImge(ByVal txt As String, ByVal _
    min_size As Integer, ByVal max_size As Integer, ByVal _
    wid As Integer, ByVal hgt As Integer) As Bitmap
    ' Make the bitmap and associated Graphics object.
    Dim bm As New Bitmap(wid, hgt)
    Dim gr As Graphics = Graphics.FromImage(bm)
    gr.SmoothingMode = Drawing2D.SmoothingMode.HighQuality

    Dim rectf As New RectangleF(0, 0, wid, hgt)
    gr.FillRectangle(Brushes.White, rectf)

    ' See how much room is available for each character.
    Dim ch_wid As Integer = wid \ txt.Length

    ' Draw each character.
    Dim rnd As New Random
    For i As Integer = 0 To txt.Length - 1
        Dim font_size As Single = rnd.Next(min_size, _
        Dim the_font As New Font("Arial", font_size, _
        DrawCharacter(txt.Substring(i, 1), gr, the_font, i _
            * ch_wid, ch_wid, wid, hgt)
    Next i

    ' Mess things up a bit.
    For i As Integer = 1 To 10
        Dim x1 As Integer = rnd.Next(wid)
        Dim y1 As Integer = rnd.Next(hgt)
        Dim x2 As Integer = rnd.Next(wid)
        Dim y2 As Integer = rnd.Next(hgt)
        gr.DrawLine(Pens.Blue, x1, y1, x2, y2)
    Next i
    For i As Integer = 1 To 10
        Dim x1 As Integer = rnd.Next(wid)
        Dim y1 As Integer = rnd.Next(hgt)
        Dim x2 As Integer = rnd.Next(wid)
        Dim y2 As Integer = rnd.Next(hgt)
        gr.DrawLine(Pens.White, x1, y1, x2, y2)
    Next i


    Return bm
End Function
Subroutine DrawCharacter creates a GraphicsPath and adds a character to it in the proper position for the bitmap. It randomly picks some points in the character's area and uses the GraphicsPath object's Warp method to warp the character's bounding rectangle onto those points, distorting the image.

Next the code applies a transformation to the Graphics object to rotate the character around its center by a random angle. In tests, I was seeing a lot of characters with similar rotations so I added a static variable and a loop to ensure that each character's rotation differs from the rotation of the previous character by at least 30 degrees.

Finally the subroutine draws the warped and rotated character onto the Graphics object representing the bitmap.

' Draw a deformed character at this position.
Private Sub DrawCharacter(ByVal txt As String, ByVal gr As _
    Graphics, ByVal the_font As Font, ByVal X As Integer, _
    ByVal ch_wid As Integer, ByVal wid As Integer, ByVal _
    hgt As Integer)
    ' Center the text.
    Dim string_format As New StringFormat
    string_format.Alignment = StringAlignment.Center
    string_format.LineAlignment = StringAlignment.Center
    Dim rectf As New RectangleF(X, 0, ch_wid, hgt)

    ' Convert the text into a path.
    Dim graphics_path As New GraphicsPath
    graphics_path.AddString(txt, the_font.FontFamily, _
        CInt(Font.Style), the_font.Size, rectf, _

    ' Make random warping parameters.
    Dim rnd As New Random
    Dim x1 As Single = CSng(X + rnd.Next(ch_wid) / 2)
    Dim y1 As Single = CSng(rnd.Next(hgt) / 2)
    Dim x2 As Single = CSng(X + ch_wid / 2 + _
        rnd.Next(ch_wid) / 2)
    Dim y2 As Single = CSng(hgt / 2 + rnd.Next(hgt) / 2)
    Dim pts() As PointF = { _
        New PointF(CSng(X + rnd.Next(ch_wid) / 4), _
            CSng(rnd.Next(hgt) / 4)), _
        New PointF(CSng(X + ch_wid - rnd.Next(ch_wid) / 4), _
            CSng(rnd.Next(hgt) / 4)), _
        New PointF(CSng(X + rnd.Next(ch_wid) / 4), CSng(hgt _
            - rnd.Next(hgt) / 4)), _
        New PointF(CSng(X + ch_wid - rnd.Next(ch_wid) / 4), _
            CSng(hgt - rnd.Next(hgt) / 4)) _
    Dim mat As New Matrix
    graphics_path.Warp(pts, rectf, mat, _
        WarpMode.Perspective, 0)

    ' Rotate a bit randomly.
    Dim dx As Single = CSng(X + ch_wid / 2)
    Dim dy As Single = CSng(hgt / 2)
    gr.TranslateTransform(-dx, -dy, MatrixOrder.Append)
    Static prev_angle As Integer = 0
    Dim angle As Integer = prev_angle
    Do While Abs(angle - prev_angle) < 30
        angle = rnd.Next(-60, 60)
    prev_angle = angle
    gr.RotateTransform(angle, MatrixOrder.Append)
    gr.TranslateTransform(dx, dy, MatrixOrder.Append)

    ' Draw the text.
    gr.FillPath(Brushes.Blue, graphics_path)
End Sub
Copyright © 1997-2006 Rocky Mountain Computer Consulting, Inc.   All rights reserved.