Buenas
Os dejo este sencillo y pequeño algoritmo para generar captchas para nuestras aplicaciones.
Se puede extender para añadir "ruido" en la imagen, o alterar la posición y la rotación de las letras, pero eso no lo he implementado ya que me parece algo excesivo para "autentificar" una simple aplicación de escritorio.
(http://i.imgur.com/vVdRdt6.png) (http://i.imgur.com/5F6RgcW.png) (http://i.imgur.com/Oze19vN.png) (http://i.imgur.com/V1ZNVn5.png) (http://i.imgur.com/hif1FVw.png)
Modo de empleo:
Dim captcha As KeyValuePair(Of Bitmap, String) = GenerateCaptcha(length:=5, size:=PictureBox1.Size)
PictureBox1.BackgroundImage = captcha.Key
Console.WriteLine(captcha.Value)
Código fuente:
Dim rand As New Random
''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Generates a captcha image.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' Dim captcha As KeyValuePair(Of Bitmap, String) = GenerateCaptcha(5, PictureBox1.ClientSize)
''' PictureBox1.BackgroundImage = captcha.Key
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
''' <param name="length">
''' The character length.
''' </param>
'''
''' <param name="size">
''' The image size.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' A <see cref="KeyValuePair(Of Bitmap, String)"/> that contains the captcha image and the resulting string.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepThrough>
Public Shared Function GenerateCaptcha(ByVal length As Integer,
ByVal size As Size) As KeyValuePair(Of Bitmap, String)
Return GenerateCaptcha(length, size.Width, size.Height)
End Function
''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Generates a captcha image.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' Dim captcha As KeyValuePair(Of Bitmap, String) = GenerateCaptcha(5, PictureBox1.Width, PictureBox1.Height)
''' PictureBox1.BackgroundImage = captcha.Key
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
''' <param name="length">
''' The character length.
''' </param>
'''
''' <param name="width">
''' The image width.
''' </param>
'''
''' <param name="height">
''' The image height.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' A <see cref="KeyValuePair(Of Bitmap, String)"/> that contains the captcha image and the resulting string.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepThrough>
Public Shared Function GenerateCaptcha(ByVal length As Integer,
ByVal width As Integer,
ByVal height As Integer) As KeyValuePair(Of Bitmap, String)
Dim captcha As New Bitmap(width, height)
Dim fontHeight As Integer = (height \ 2)
Dim vLineSpacing As Integer = 2
Dim hLineSpacing As Integer = 2
Dim str As String = String.Join("", (From c As Char In "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
Order By rand.Next Select c).Take(length))
Using g As Graphics = Graphics.FromImage(captcha)
g.InterpolationMode = InterpolationMode.High
g.SmoothingMode = SmoothingMode.HighQuality
g.TextRenderingHint = TextRenderingHint.AntiAliasGridFit
g.CompositingQuality = CompositingQuality.HighQuality
Using gradientBrush As New LinearGradientBrush(New Point(0, (height \ 2)),
New Point(width, (height \ 2)),
Color.FromArgb(rand.Next(&HFF7D7D7D, &HFFFFFFFF)),
Color.FromArgb(rand.Next(&HFF7D7D7D, &HFFFFFFFF)))
' Draw gradient background.
g.FillRectangle(gradientBrush, New Rectangle(0, 0, width, height))
End Using ' gradientBrush
Using linesPen As New Pen(Brushes.Black, 1)
' Draw vertical lines.
For i As Integer = 1 To width
Dim ptop As New Point(i * vLineSpacing, 0)
Dim pBottom As New Point(i * vLineSpacing, height)
g.DrawLine(linesPen, ptop, pBottom)
Next i
' Draw horizontal lines.
For i As Integer = 1 To height
Dim ptop As New Point(0, i * hLineSpacing)
Dim pBottom As New Point(width, i * hLineSpacing)
g.DrawLine(linesPen, ptop, pBottom)
Next i
End Using ' linesPen
Using font As New Font("Arial", fontHeight)
Using path As New GraphicsPath
For i As Integer = 0 To (str.Length - 1)
Dim charX As Integer =
(((i * (width - (g.MeasureString(str(i), font, width).ToSize.Width \ length)))) \ length)
Dim charY As Integer = (height \ 2)
path.AddString(str(i), font.FontFamily, FontStyle.Bold, fontHeight,
New Point(charX, charY), New StringFormat With {.LineAlignment = StringAlignment.Center})
Next i
' Draw characters.
g.DrawPath(Pens.Black, path)
g.FillPath(Brushes.Gainsboro, path)
End Using
End Using ' font
End Using ' g
Return New KeyValuePair(Of Bitmap, String)(captcha, str)
End Function
Saludos
Simple y sencillo, se ve estupéndamente EleKtro, como curiosidad, ¿has probado a pasarle OCR?
Saludos!
Cita de: kub0x en 21 Diciembre 2015, 14:15 PMSimple y sencillo, se ve estupéndamente EleKtro, como curiosidad, ¿has probado a pasarle OCR?
Segurísimo que cualquier motor OCR leería perfectamente las letras, ni falta que hace probarlo creo yo, ya que no implementé medidas de seguridad por así decirlo, vaya.
El propósito del código que compartí era mostrar las letras lo más legible posible para el usuario, sin sobrecargar la imagen, ya que considero que una aplicación no necesita más.
Aquí les dejo una versión alternativa para mostrar maneras de extender el código, con fuentes de letra aleatorias, posición de letras aleatoria, curvas y ruido,
aunque no me gusta como ha quedado el resultado, se podría hacer mucho mejor pero no soy ningún gurú del GDI+ y no invertiré más tiempo en ello, ya que como dije, no quería sobrecargar la imagen.
(http://i.imgur.com/4Sc5i9U.png) (http://i.imgur.com/4B3NOCB.png) (http://i.imgur.com/1i2F9ZL.png) (http://i.imgur.com/XfsfHgr.png)
(http://i.imgur.com/CEAB81x.png) (http://i.imgur.com/w0PG22c.png) (http://i.imgur.com/oCEZRWD.png) (http://i.imgur.com/YVkX6Jy.png)
Private Shared rand As New Random
Public Shared Function GenerateCaptcha(ByVal length As Integer,
ByVal width As Integer,
ByVal height As Integer) As KeyValuePair(Of Bitmap, String)
Dim vLinesGdi As New Dictionary(Of Point, Point)
Dim hLinesGdi As New Dictionary(Of Point, Point)
Dim charsGdi As New Dictionary(Of Char, Point)
Dim captcha As New Bitmap(width, height)
Dim fontHeight As Integer = (height \ 2)
Dim vLineSpacing As Integer = 2
Dim hLineSpacing As Integer = 2
Dim str As String =
String.Join("", (From c As Char In "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
Order By rand.Next Select c).Take(length))
' Set vertical lines.
For i As Integer = 1 To width
vLinesGdi.Add(New Point(i * vLineSpacing, 0), New Point(i * vLineSpacing, height))
Next i
' Set horizontal lines.
For i As Integer = 1 To height
hLinesGdi.Add(New Point(0, i * hLineSpacing), New Point(width, i * hLineSpacing))
Next i
' Set char positions.
Using g As Graphics = Graphics.FromImage(captcha)
For i As Integer = 0 To (length - 1)
Using font As New Font(GetRandomFont, fontHeight)
Dim charPosX As Integer =
(((i * (width - (g.MeasureString(str(i), font, width).ToSize.Width \ length)))) \ length)
Dim charPosY As Integer = rand.Next((fontHeight \ 2), height - (fontHeight \ 2))
charsGdi.Add(str(i), New Point(charPosX, charPosY))
End Using ' font
Next
End Using ' g
Using g As Graphics = Graphics.FromImage(captcha)
g.InterpolationMode = InterpolationMode.HighQualityBicubic
g.SmoothingMode = SmoothingMode.HighQuality
g.TextRenderingHint = TextRenderingHint.AntiAliasGridFit
g.CompositingQuality = CompositingQuality.GammaCorrected
g.PixelOffsetMode = PixelOffsetMode.HighQuality
' Draw background.
Using bgBrush As New LinearGradientBrush(New Point(0, (height \ 2)),
New Point(width, (height \ 2)),
Color.FromArgb(rand.Next(&HFF7D7D7D, &HFFFFFFFF)),
Color.FromArgb(rand.Next(&HFF7D7D7D, &HFFFFFFFF)))
g.FillRectangle(bgBrush, New Rectangle(0, 0, width, height))
End Using ' bgBrush
' Draw rectangles.
Using linePen As New Pen(Brushes.Gray, 1)
' Draw vertical rect-lines.
For Each linePair As KeyValuePair(Of Point, Point) In vLinesGdi
g.DrawLine(linePen, linePair.Key, linePair.Value)
Next linePair
' Draw horizontal rect-lines.
For Each linePair As KeyValuePair(Of Point, Point) In hLinesGdi
g.DrawLine(linePen, linePair.Key, linePair.Value)
Next linePair
End Using ' linePen
' Draw characters.
For Each charPoint As KeyValuePair(Of Char, Point) In charsGdi
Using font As New Font(GetRandomFont, fontHeight)
Using path As New GraphicsPath
path.FillMode = FillMode.Alternate
path.AddString(charPoint.Key, font.FontFamily, FontStyle.Bold, fontHeight,
New Point(charPoint.Value.X, charPoint.Value.Y),
New StringFormat With {
.Alignment = StringAlignment.Near,
.LineAlignment = StringAlignment.Center,
.FormatFlags = StringFormatFlags.NoFontFallback Or StringFormatFlags.NoWrap
})
g.DrawPath(Pens.Black, path)
g.FillPath(Brushes.Gainsboro, path)
End Using ' path
End Using ' font
Next charPoint
' Draw curve.
Using curvePen As New Pen(Brushes.Black, 1.5F)
g.DrawCurve(curvePen, charsGdi.Values.ToArray, 0, (length - 1), 10.0F)
End Using ' curvePen
'' Add noise.
'' Nota: Usar "Bitmap.Lockbits()" para quien quiera una implementación más rápida y eficiente.
'For x As Integer = 0 To (width - 1) Step 6
' For y As Integer = 0 To (height - 1) Step 6
' Dim num As Integer = rand.Next(0, 256)
' captcha.SetPixel(x, y, Color.FromArgb(255, num, num, num))
' Next
'Next
End Using ' g
Return New KeyValuePair(Of Bitmap, String)(captcha, str)
End Function
Public Shared Function GetRandomFont() As FontFamily
Using fontCol As New InstalledFontCollection
Return (From family As FontFamily In fontCol.Families
Order By rand.Next Select family).First
End Using
End FunctionNotas:
No lo he probado con un OCR.
El código es solo un ejemplo, una base donde agarrarse.
Conviene usar una colección de fuentes óptima y personalizada, para evitar fuentes de texto incompletas y/o simbólicas como la fuente Widenings de Microsoft.
Saludos!