Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 20.02.2011, 17:19
Аватар для alikoder
alikoder alikoder вне форума
Начинающий
 
Регистрация: 05.12.2007
Сообщения: 126
Репутация: 10
Сообщение Создание капчи

Вот везде пишут, как прочитать или получить капчу, а у меня возникла необходимость ее создать=)
Предположим так:
Возьмем Memo и при oncreate формы, впендюрим туда некий текст(случайный). А вот edit, если в него вписать текст из Memo и нажать на button, вызываем функцию... ну мол сообщение, что все ок, а если текст не такой как в мемо то, пишем мол ошибочка=)
Ответить с цитированием
  #2  
Старый 20.02.2011, 17:22
Аватар для alikoder
alikoder alikoder вне форума
Начинающий
 
Регистрация: 05.12.2007
Сообщения: 126
Репутация: 10
По умолчанию

но это я так, простенько обьяснил,
что не понятно мне конкретно это, как создать в место мемо капчу в timage и проверять разумеется
Ответить с цитированием
  #3  
Старый 20.02.2011, 17:45
Аватар для M.A.D.M.A.N.
M.A.D.M.A.N. M.A.D.M.A.N. вне форума
Sir Richard Abramson
 
Регистрация: 05.04.2008
Сообщения: 5,505
Версия Delphi: XE10
Репутация: выкл
По умолчанию

Вариант 1.
Написать функцию, которая будет рисовать на канве буквочки и циферки, в эту функцию будет передаваться твоя рандомная строчка, по завершении работы функция вернет тебе, например, хеш текста твоей капчи. При вводе в едит ты сравнишь хеши текста в эдите и самой капчи.
__________________
— Как тебя понимать?
— Понимать меня не обязательно. Обязательно меня любить и кормить вовремя.


На Delphi, увы, больше не программирую.
Рекомендуемая литература по программированию
Ответить с цитированием
  #4  
Старый 20.02.2011, 18:28
Аватар для v1s2222
v1s2222 v1s2222 вне форума
Продвинутый
 
Регистрация: 07.09.2010
Сообщения: 726
Репутация: 26711
По умолчанию

Код не мой. Взял с какого-то сайта, уже не помню где
Код:
type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    EditCaptcha: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure Captcha_(Code: Integer);
    procedure SetCaptcha_;
    function TestCaptcha(C: String): Boolean;
  end;

var
  Form1: TForm1;

  CurCod: Integer;

implementation

{$R *.dfm}

procedure TForm1.Captcha_(Code: Integer);
const
	lines = 6;
var
	x,y,g : integer;
  str   : string;
begin
  Image1.Canvas.Brush.Color := clWhite;
  Image1.Canvas.Brush.Style := bsSolid;
  Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
  if (Code < 99999) or (Code > 1000000) then
  	Image1.Canvas.TextOut(4,4,'INVALID CODE');
  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')), IntToStr(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.SetCaptcha_;
begin
  Randomize;
  CurCod := Random(899999) + 100000;
  Captcha_(CurCod);
end;

function TForm1.TestCaptcha(C: String): Boolean;
begin
  Result := IntToStr(CurCod) = C;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if(not(TestCaptcha(EditCaptcha.Text))) then begin
    ShowMessage('Капча не верна');
    EditCaptcha.Clear;
      SetCaptcha_;
    Exit;
  end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  SetCaptcha_;
end;
__________________
Помогаю за Спасибо
Ответить с цитированием
  #5  
Старый 21.02.2011, 09:37
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

вариантов много:



Код:
function CreateCaptcha(s: String): TBitmap;
var
  i: Integer;
  x: Integer;
  y: Integer;
  a: Integer;

  procedure CanvasSetAngle(C: TCanvas; A: Single);
  var
    LogRec: TLogFont;
  begin
    GetObject(C.Font.Handle, SizeOf(LogRec), @LogRec);
    DeleteObject(C.Font.Handle);
    LogRec.lfEscapement:=Trunc(A*10);
    C.Font.Handle:=CreateFontIndirect(LogRec);
  end;

begin
  Result:=TBitmap.Create;
  Result.Canvas.Font.Name:='Comic Sans MS';
  Result.Canvas.Font.Size:=16;
  Result.Width:=2*Result.Canvas.TextWidth('W')*(Length(s)+2);
  Result.Height:=50;
  Result.Canvas.Brush.Color:=clWhite;
  Result.Canvas.FillRect(Rect(0, 0, Result.Width, Result.Height));
  Result.Canvas.Brush.Style:=bsClear;
  for i:=1 to 5*Result.Width do
  begin
    Result.Canvas.Pen.Color:=Random($ffffff);
    x:=Random(Result.Width);
    y:=Random(Result.Height);
    Result.Canvas.MoveTo(x, y);
    Result.Canvas.LineTo(x+Random(2), y+Random(2));
  end;
  x:=Result.Canvas.TextWidth('W');
  for i:=1 to Length(s) do
  begin
    a:=Random(90)-45;
    CanvasSetAngle(Result.Canvas, a);
    Result.Canvas.Font.Color:=Random($ffffff);
    Result.Canvas.TextOut(x, Result.Height div 2, s[i]);
    Inc(x, 2*Result.Canvas.TextWidth('W'));
  end;
  Result.Canvas.Pen.Color:=clBlack;
end;

http://data.cod.ru/90139
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 05:16.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025