1 respuesta en este tema

[fredycc]

Había estado leyendo varios post en el foro Oficial de uniGUI a cerca de los captcha, había varias funciones propuesta, me decidí a unir algunas funciones propuestas además de modificar algunas otras y al final solo es necesario tener esto para hacerlo funcional:

delphi

Procedure Distort(aBitmap: TBitmap);
var
  b : TBitmap;
  x,y : integer;
begin
  b := TBitmap.Create;
  b.Width  := aBitmap.Width;
  b.Height := aBitmap.Height;
  for x := 0 to aBitmap.Canvas.ClipRect.Right do
  begin
    for y := 0 to aBitmap.Canvas.ClipRect.Bottom do
    begin
      b.Canvas.Pixels[x,y +trunc(sin(x/4)*3)] :=
        aBitmap.Canvas.Pixels[x,y];
    end;
  end;
  aBitmap.Assign(b);
  b.Free;
end;
 
procedure letrasAnguladas(c : string; angulo : integer; nextPos : Integer; Image1: TBitmap);
var
   logfont:TLogFont;
   font: Thandle;
begin
   LogFont.lfheight:=25;
   logfont.lfwidth:=12;
   logfont.lfweight:=800;
 
   LogFont.lfEscapement:=angulo;
   logfont.lfcharset:= ANSI_CHARSET;
   logfont.lfoutprecision:= OUT_TT_ONLY_PRECIS;
   logfont.lfquality:= CLEARTYPE_QUALITY;
   logfont.lfpitchandfamily:= FF_SWISS;
   logfont.lfUnderline := 0;
   logfont.lfStrikeOut := 1;
 
   font:=createfontindirect(logfont);
 
   Selectobject(Image1.canvas.handle,font);
 
   SetTextColor(Image1.canvas.handle,rgb(Random(200),Random(200),Random(200)));
   Image1.canvas.textout(nextPos,6,c);
 
   deleteobject(font);
end;
 
function PalabraAleatoria(Longitud: integer): string;
const
  Letras = 'abcdefghjkmnopqrstuvwxyz/01234567890ABCDEFGHIJKLMNOPRSTUVWXYZ%?¿';
var
  n  : integer;
begin
  Result:='';
  for n:=1 to Longitud do
    Result:=Result + Letras[1 + Random(Length(Letras))];
end;
 
procedure TMainForm.generaImg();
var
   vX : integer;
   Image1: TBitmap;
begin
   Randomize;
   Image1 := TBitmap.Create;
   with Image1 do
   begin
    Image1.Width  := 240;
    Image1.height := 80;
   end;
 
   palabra := PalabraAleatoria(Random(6)+5);
   if length(palabra) > 6 then
      palabra := copy(palabra,1,6);
   for vX := 1 to Length(palabra) do
      letrasAnguladas(palabra[vX],Random(200)+1,25*vX-15,Image1);
   distort(Image1);
   MainForm.UniImage1.Picture.Bitmap := Image1;
   Image1.Free;
end;
 
procedure TMainForm.UniBitBtn1Click(Sender: TObject);
begin
   generaImg;
end;
 
procedure TMainForm.UniButton1Click(Sender: TObject);
begin
//Validado la palabra generada vs palabra ingresada por el usuario
  if UpperCase(palabra) = Uppercase(uniEdit1.Text) then
    Showmessage('Correcto!')
  else
    Showmessage('Incorrecto, vuelve a intentar');
end;

Al final un par de procedimientos y una comparación común y corriente, basta para tener nuestro captcha funcionando. Adjunto el proyecto.

Espero les sea de utilidad.

Saludos

Archivos adjuntos

•  3533_79de3d7957fb4e583d56a30984c5aac7f54ca5db.zip   6,95KB   30 descargas

[estor485]

Muy buena la aplicación, solamente me marco un error con la linea

delphi

logfont.lfquality:= CLEARTYPE_QUALITY;

pero por lo que leí es para Windows XP (si mal no entendí) y al comentarla a corrido sin problemas, gracias por el aporte  .