1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64

function CreateCaptcha(Imagem: TImage; Num_Chars : Integer) : String; 
var 
  Chars, Captcha : String; 
  I, X, Y, Tamanho, Espaco, Cor : Integer;
begin 
  Randomize;
  Chars := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'+
  'abcdefghijklmnopqrstuvwxyz1234567890';
 
  Y := 6; 
  X := 10; 
  Tamanho := 20;
  Espaco  := 40; 
  Cor := 5999857; 
 
  { Preparando o TImage. } 
  with (Imagem) do 
  begin 
    Refresh; 
    Canvas.LineTo(10, 20); 
    Picture.Bitmap := nil; 
    Canvas.Brush.Color := $00F7F8F9; 
    Canvas.Pen.Color := $00F7F8F9; 
    Canvas.Rectangle(0, 0, Width, Height); 
  end; 
 
  { Selecionando os caracteres. } 
  Captcha := ''; 
  for I := 0 to Num_Chars do 
  begin 
    Captcha := Captcha + 
    Copy(Chars, Random(Length(Chars)), 1); 
  end; 
 
  { Desenhando os caracteres. } 
  for I := 1 to Length(Captcha) - 1 do 
  begin 
    with (Imagem) do 
    begin 
      Canvas.Font.Size := 
        Random(Tamanho) + 15; 
      Canvas.Font.Color := Random(Cor); 
      Canvas.Font.Name := 'Times New Roman'; 
      Canvas.Font.Style := 
        Canvas.Font.Style + [fsBold]; 
      Canvas.TextOut(X, Random(Y), 
        Copy(Captcha, i, 1)); 
    end; 
 
    Inc(X, Espaco); 
 
    { Criando os traços do Capcha. } 
    with (Imagem) do 
    begin 
      Canvas.Pen.Width := 3; 
      Canvas.Pen.Color := Random(Cor); 
      Canvas.LineTo(Random(250), random(200)); 
      Canvas.LineTo(random(250), random(200)); 
    end; 
  end; 
 
  { Retorna o código para validação } 
  Result := Copy(Captcha, 1, Length(Captcha) - 1);
end;

function CreateCaptcha(Imagem: TImage; Num_Chars : Integer) : String; var Chars, Captcha : String; I, X, Y, Tamanho, Espaco, Cor : Integer; begin Randomize; Chars := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'+ 'abcdefghijklmnopqrstuvwxyz1234567890'; Y := 6; X := 10; Tamanho := 20; Espaco := 40; Cor := 5999857; { Preparando o TImage. } with (Imagem) do begin Refresh; Canvas.LineTo(10, 20); Picture.Bitmap := nil; Canvas.Brush.Color := $00F7F8F9; Canvas.Pen.Color := $00F7F8F9; Canvas.Rectangle(0, 0, Width, Height); end; { Selecionando os caracteres. } Captcha := ''; for I := 0 to Num_Chars do begin Captcha := Captcha + Copy(Chars, Random(Length(Chars)), 1); end; { Desenhando os caracteres. } for I := 1 to Length(Captcha) - 1 do begin with (Imagem) do begin Canvas.Font.Size := Random(Tamanho) + 15; Canvas.Font.Color := Random(Cor); Canvas.Font.Name := 'Times New Roman'; Canvas.Font.Style := Canvas.Font.Style + [fsBold]; Canvas.TextOut(X, Random(Y), Copy(Captcha, i, 1)); end; Inc(X, Espaco); { Criando os traços do Capcha. } with (Imagem) do begin Canvas.Pen.Width := 3; Canvas.Pen.Color := Random(Cor); Canvas.LineTo(Random(250), random(200)); Canvas.LineTo(random(250), random(200)); end; end; { Retorna o código para validação } Result := Copy(Captcha, 1, Length(Captcha) - 1); end;

1
2
3
4

procedure TFrmPrincipal.BtnGenerateNewClick(Sender: TObject);
begin
  vCaptcha := CreateCaptcha(Image1, 4);
end;

procedure TFrmPrincipal.BtnGenerateNewClick(Sender: TObject); begin vCaptcha := CreateCaptcha(Image1, 4); end;

1
2
3
4
5
6
7

procedure TFrmPrincipal.BtnVerificarClick(Sender: TObject);
begin
  if (EdtCod.Text = vCaptcha) then
    ShowMessage('Código válido!')
  else
    ShowMessage('Código inválido!');
end;

procedure TFrmPrincipal.BtnVerificarClick(Sender: TObject); begin if (EdtCod.Text = vCaptcha) then ShowMessage('Código válido!') else ShowMessage('Código inválido!'); end;