Home
Search
 
What's New
Index
Books
Links
Q & A
Newsletter
Banners
 
Feedback
Tip Jar
 
C# Helper...
 
XML RSS Feed
Follow VBHelper on Twitter
 
 
 
MSDN Visual Basic Community
 
 
 
 
 
TitleMake CAPTCHA images (version 4) in VB .NET
DescriptionThis example shows how to make CAPTCHA images (version 4) 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. This example uses relatively large fonts so the characters tend to overlap in cool and interesting ways that are hard for an OCR program to decipher.

 
' 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, _
            max_size)
        Dim the_font As New Font("Times New Roman", _
            font_size, FontStyle.Bold)
        DrawCharacter(txt.Substring(i, 1), gr, the_font, i _
            * ch_wid, ch_wid, wid, hgt)
        the_font.Dispose()
    Next i

    gr.Dispose()

    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 20 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, _
            string_format)

    ' 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) < 20
        angle = rnd.Next(-30, 30)
    Loop
    prev_angle = angle
    gr.RotateTransform(angle, MatrixOrder.Append)
    gr.TranslateTransform(dx, dy, MatrixOrder.Append)

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