2.3 Код программы

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, ExtCtrls, StdCtrls, Mask, XPMan;

type

TForm1 = class (TForm)

Image1: TImage;

Label1: TLabel;

MaskEdit1: TMaskEdit;

ButtonTest: TButton;

Button1: TButton;

XPManifest1: TXPManifest;

Button2: TButton;

procedure FormCreate (Sender: TObject);

procedure SetCaptcha;

function TestCaptcha (C: String): Boolean;

procedure ButtonTestClick (Sender: TObject);

procedure Image1Click (Sender: TObject);

procedure Captcha (Code: string);

function RandStr (len: integer): string;

procedure Button1Click (Sender: TObject);

procedure Button2Click (Sender: TObject);

end;

var

Form1: TForm1;

CurCod: string;

implementation

{$R *. dfm}

// ************************************************************

// Создание формы

procedure TForm1. FormCreate (Sender: TObject);

begin

SetCaptcha;

end;

// ************************************************************

// Клик по картинке, обновление капчи

procedure TForm1. Image1Click (Sender: TObject);

begin

SetCaptcha;

end;

procedure TForm1. Button1Click (Sender: TObject);

begin

SetCaptcha;

end;

// ************************************************************

// Генерация капчи

procedure TForm1. SetCaptcha;

begin

CurCod: = RandStr (6);

Captcha (CurCod);

end;

// ************************************************************

// Создание случайной строки

function TForm1. RandStr (len: integer): string;

const

alfa=QWERTYUIOPASDFGHJKLZXCVBNM;

var

i: integer;

begin

randomize;

result: =;

for i: = 1 to len do

result: =result+alfa [random (length (alfa) - 1) +1];

end;

// ************************************************************

procedure TForm1. Captcha (Code: string);

const

lines = 3;

var

x,y,g: integer;

begin

// Установки картинки

Image1. Canvas. Brush. Color: = clWhite;

Image1. Canvas. Brush. Style: = bsSolid;

Image1. Canvas. FillRect (Image1. Canvas. ClipRect);

// Точки на капче

for x: = 0 to Image1. Width - 1 do

for y: = 0 to Image1. Height - 1 do

if Random (1000) mod 2 = 0 then begin

g: = Random (100) +100;

Image1. Canvas. Pixels [x,y]: = rgb (g,g,g);

end;

// Буквы на капче

Image1. Canvas. Brush. Style: = bsClear;

for x: = 1 to 6 do begin

g: = Random (100) +100;

// Случайный цвет

case Random (3) of

0: Image1. Canvas. Font. Color: = rgb (g,0,0);

1: Image1. Canvas. Font. Color: = rgb (0,g,0);

2: Image1. Canvas. Font. Color: = rgb (0,0,g);

end;

// Случайный шрифт

case random (2) of

0: Image1. Canvas. Font. Style: = [fsBold];

1: Image1. Canvas. Font. Style: = [];

end;

// Случайный размер и положение

Image1. Canvas. Font. Size: = 15 + Random (6);

Image1. Canvas. TextOut ( (x-1) *15+10,random (image1. Height-Image1. Canvas. TextHeight (1)), Code [x]);

end;

// Линии на капче

Image1. Canvas. Pen. Color: = clBlack;

for x: = 0 to lines - 1 do begin

Image1. Canvas. MoveTo (0, Random (Image1. Height));

Image1. Canvas. LineTo (Image1. Width, Random (Image1. Height));

end;

end;

// ************************************************************ // Проверка

procedure TForm1. ButtonTestClick (Sender: TObject);

begin

if TestCaptcha (MaskEdit1. Text) then

ShowMessage (Капча верная! )

else

ShowMessage (Капча неверная! )

end;

// ************************************************************

// Функция проверки

function TForm1. TestCaptcha (C: String): Boolean;

begin

Result: = (CurCod = C);

end;

// ************************************************************

procedure TForm1. Button2Click (Sender: TObject);

begin

close;

end;

end.