Underc0de

ProgramaciĆ³n General => Delphi => Topic started by: ANTRAX on February 24, 2010, 04:55:33 pm

Title: Captcha en Delphi
Post by: ANTRAX on February 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.

Code: (delphi) You are not allowed to view links. Register or Login
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.