|
|
Title | Make CAPTCHA images (version 3) in VB .NET |
Description | This example shows how to make CAPTCHA images (version 3) in VB .NET. |
Keywords | CAPTCHA, Turing test, image, image processing, distort image, VB.NET |
Categories | Graphics, 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. Vertical and horizontal lines are often useful to OCR programs so the code adds some random vertical and horizontal lines.
|
|
' 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("Arial", font_size, _
FontStyle.Bold)
DrawCharacter(txt.Substring(i, 1), gr, the_font, i _
* ch_wid, ch_wid, wid, hgt)
the_font.Dispose()
Next i
' Mess things up a bit.
Dim x As Integer = rnd.Next(16)
Do While x < wid
gr.DrawLine(Pens.Blue, x, 0, x, hgt)
x += 8 + rnd.Next(16)
Loop
Dim y As Integer = rnd.Next(16)
Do While y < hgt
gr.DrawLine(Pens.Blue, 0, y, wid, y)
y += 8 + rnd.Next(16)
Loop
For i As Integer = 1 To 20
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
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 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, _
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) < 30
angle = rnd.Next(-60, 60)
Loop
prev_angle = angle
Debug.WriteLine(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
|
|
|
|
|
|