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, _
            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.
    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

    gr.Dispose()

    Return bm
End Function

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
    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