Underc0de

Programación General => Delphi => Mensaje iniciado por: ANTRAX en Febrero 24, 2010, 04:55:33 PM

Título: Captcha en Delphi
Publicado por: ANTRAX en Febrero 24, 2010, 04:55:33 PM
Este codigo genera imagenes Captcha (http://es.wikipedia.org/wiki/Captcha). Muy util para aplicacion intraweb o simplemente para validad que el usuario que se esta loggeando en un ser humano.

Nota: Se necesita una imagen (blanco.bmp), yo en lo personal utilizo un bmp del fondo de matrix que con el color verde de las letras es ideal para el proposito. Cualquier aportacion en bienvenida.

Código (delphi) [Seleccionar]
unit fmain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    procedure letrasAnguladas(c : string; angulo : integer; nextPos : Integer);
    function PalabraAleatoria(Longitud: integer): string;
    procedure generaImg();
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.letrasAnguladas(c : string; angulo : integer; nextPos : Integer);
var
   logfont:TLogFont;
   font: Thandle;
begin
   LogFont.lfheight:=30;
   logfont.lfwidth:=10;
   logfont.lfweight:=900;

   LogFont.lfEscapement:=angulo;
   logfont.lfcharset:=1;
   logfont.lfoutprecision:=OUT_TT_ONLY_PRECIS;
   logfont.lfquality:= DEFAULT_QUALITY;
   logfont.lfpitchandfamily:= FF_SWISS;
   logfont.lfUnderline := 0;
   logfont.lfStrikeOut := 0;

   font:=createfontindirect(logfont);

   Selectobject(Image1.canvas.handle,font);

   SetTextColor(Image1.canvas.handle,rgb(0,180,0));
   SetBKmode(Image1.canvas.handle,transparent);

   Image1.canvas.textout(nextPos,5,c);
   SetTextColor(Image1.canvas.handle,rgb(Random(255),Random(255),Random(255)));
   deleteobject(font);
end;

function TForm1.PalabraAleatoria(Longitud: integer): string;
const
  Letras = '01234567890ABCDEFGHIJKLMNPRSTUVWXYZ';
var
  n  : integer;
begin
  Result:='';
  for n:=1 to Longitud do Result:=Result+Letras[1+Random(Length(Letras))];
end;

procedure TForm1.generaImg();
var
   palabra : string;
   vX : integer;
begin
   Randomize;
   palabra := PalabraAleatoria(Random(6)+4);
   if length(palabra) > 6 then
      palabra := copy(palabra,1,6);
   for vX := 1 to Length(palabra) do
      letrasAnguladas(palabra[vX],Random(600)+1,25*vX-15);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   Image1.Picture.LoadFromFile('blanco.bmp');
   generaImg;
end;

end.