This site uses cookies own and third. If you continue to browse consider to accept the use of cookies. OK More Info.

Captcha en Delphi

  • 0 Replies
  • 3471 Views

0 Members and 1 Guest are viewing this topic.

Offline ANTRAX

  • *
  • Administrator
  • Posts: 5849
  • Actividad:
    66.67%
  • Country: ar
  • Reputación 43
  • ANTRAX
  • Twitter: @Underc0de
    • View Profile
    • Underc0de
    • Email

Captcha en Delphi

  • on: February 24, 2010, 04:55:33 pm
Este codigo genera imagenes Captcha (You are not allowed to view links. Register or Login). 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.



« Last Edit: April 15, 2013, 11:24:47 pm by Expermicid »