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