Пример взят с форума UniGUI и немного изменен. Вот что у нас получится в итоге
Пример использования. Мы можем настраивать число цифр, число полосок, углы, цвета и так далее. Смотрите код.
|
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 |
unit Main; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, uniGUITypes, uniGUIAbstractClasses, uniGUIClasses, uniGUIForm, Unit_Captcha, uniGUIBaseClasses, uniCanvas, uniButton, uniBitBtn, uniImage, uniEdit; type TMainForm = class(TUniForm) UniCanvas1: TUniCanvas; bCreateNewCaptcha: TUniBitBtn; bCheck: TUniBitBtn; UniEdit1: TUniEdit; procedure bCreateNewCaptchaClick(Sender: TObject); procedure bCheckClick(Sender: TObject); private { Private declarations } public { Public declarations } end; function MainForm: TMainForm; implementation {$R *.dfm} uses uniGUIVars, MainModule, uniGUIApplication; var i:Integer; function MainForm: TMainForm; begin Result := TMainForm(UniMainModule.GetFormInstance(TMainForm)); end; procedure TMainForm.bCreateNewCaptchaClick(Sender: TObject); begin i:=random(1000000); UniCanvas1.Bitmap := nil; CretedCaptcha(UniCanvas1, inttostr(i), 2); // << Here we adjust CAPTCHA Caption:=IntToStr(i) end; procedure TMainForm.bCheckClick(Sender: TObject); begin if UniEdit1.Text=Caption then ShowMessage('Ok'); end; initialization RegisterMainFormClass(TMainForm); end. |
Код юнита CAPTCHA
|
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 65 66 67 68 69 70 71 |
unit Unit_Captcha; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, uniGUITypes, uniGUIAbstractClasses, uniGUIClasses, uniGUIForm, uniGUIBaseClasses, uniCanvas; procedure CretedCaptcha(aImage: TUniCanvas; TextCaptcha: string; SetLinetoCaptcha: Integer); implementation procedure letrasAnguladas(aImage: TUniCanvas; c: string; angulo: Integer; nextPos: Integer); var logfont: TLogFont; font: Thandle; i: Integer; 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(aImage.BitmapCanvas.handle, font); SetTextColor(aImage.BitmapCanvas.handle, rgb(Random(255), Random(255), Random(255))); SetBKmode(aImage.BitmapCanvas.handle, transparent); aImage.BitmapCanvas.textout(nextPos, aImage.Height div 3, c); SetTextColor(aImage.BitmapCanvas.handle, rgb(Random(255), Random(255), Random(255))); deleteobject(font); end; procedure SetLine(aImage: TUniCanvas; Count: Integer); var i: Integer; begin for i := 0 to Count do begin aImage.BitmapCanvas.Pen.Color := Random(100000); aImage.BitmapCanvas.MoveTo(Random(aImage.Width), Random(aImage.Height)); aImage.BitmapCanvas.LineTo(Random(aImage.Width), Random(aImage.Height)); end; end; procedure CretedCaptcha(aImage: TUniCanvas; TextCaptcha: string; SetLinetoCaptcha: Integer); var i: Integer; begin for i := 1 to Length(TextCaptcha) do letrasAnguladas(aImage, TextCaptcha[i], Random(600) + 1, 25 * i - 15); SetLine(aImage, SetLinetoCaptcha); end; end. |
В принципе ничего сложного, все сделано на Delphi UniGUI.