paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Captcha: Rename component to TCaptchaLabel. Add demos folder. Add new simple_demo project. Move runtime_demo to demos folder.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8112 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2021-10-01 18:03:25 +00:00
parent 0e5f075b8b
commit e541f5c5df
9 changed files with 303 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

0
components/captcha/demo_runtime/capcha_demo.lpi → components/captcha/demos/runtime/capcha_demo.lpi
View File

0
components/captcha/demo_runtime/capcha_demo.lpr → components/captcha/demos/runtime/capcha_demo.lpr
View File

0
components/captcha/demo_runtime/main.lfm → components/captcha/demos/runtime/main.lfm
View File

2
components/captcha/demo_runtime/main.pas → components/captcha/demos/runtime/main.pas
View File

@ -59,7 +59,7 @@ type
procedure seCharCountChange(Sender: TObject); procedure seCharCountChange(Sender: TObject);
procedure seLinesCountChange(Sender: TObject); procedure seLinesCountChange(Sender: TObject);
private private
FCaptcha: TCaptcha; FCaptcha: TCaptchaLabel;
public public

95
components/captcha/demos/simple_demo/main.lfm Normal file
View File

@ -0,0 +1,95 @@
object Form1: TForm1
Left = 285
Height = 280
Top = 131
Width = 600
AutoSize = True
Caption = 'CAPTCHA Demo'
ClientHeight = 280
ClientWidth = 600
Constraints.MinWidth = 600
OnActivate = FormActivate
OnCreate = FormCreate
ShowHint = True
LCLVersion = '2.3.0.0'
object Captcha1: TCaptchaLabel
Left = 16
Height = 97
Hint = 'CAPTCHA text. Try to read this text and input its characters in the box below.'
Top = 16
Width = 568
Font1.Height = -48
Font2.Height = -48
Font2.Name = 'Courier New'
LowercaseChars = 'abcdefghijklmnopqrstuvwxyz'
NumericChars = '0123456789'
NewCaptchaEvent = nceDblClick
UppercaseChars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
Align = alTop
BorderSpacing.Left = 16
BorderSpacing.Top = 16
BorderSpacing.Right = 16
BorderSpacing.Bottom = 8
end
object GroupBox1: TGroupBox
Left = 16
Height = 71
Top = 129
Width = 568
Align = alTop
AutoSize = True
BorderSpacing.Around = 16
Caption = 'Enter CAPTCHA code to verify that you are a human'
ClientHeight = 51
ClientWidth = 564
TabOrder = 0
object edCaptcha: TEdit
AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = GroupBox1
AnchorSideRight.Control = btnVerify
Left = 16
Height = 23
Hint = 'Enter the CAPTCHA here'
Top = 12
Width = 366
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 16
BorderSpacing.Top = 12
BorderSpacing.Right = 8
BorderSpacing.Bottom = 16
TabOrder = 0
TextHint = 'Enter the CAPTCHA code here...'
end
object btnVerify: TButton
AnchorSideTop.Control = edCaptcha
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = btnRetry
Left = 390
Height = 25
Hint = 'Compares the user input with the CAPTCHA text'
Top = 11
Width = 75
Anchors = [akTop, akRight]
BorderSpacing.Right = 8
Caption = 'Verify'
OnClick = btnVerifyClick
TabOrder = 1
end
object btnRetry: TButton
AnchorSideTop.Control = edCaptcha
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = GroupBox1
AnchorSideRight.Side = asrBottom
Left = 473
Height = 25
Hint = 'Create a new CAPTCHA text (or double-click on the CAPTCHA)'
Top = 11
Width = 75
Anchors = [akTop, akRight]
BorderSpacing.Right = 16
Caption = 'Retry'
OnClick = btnRetryClick
TabOrder = 2
end
end
end

70
components/captcha/demos/simple_demo/main.pas Normal file
View File

@ -0,0 +1,70 @@
unit Main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, CaptchaCtrl;
type
{ TForm1 }
TForm1 = class(TForm)
btnVerify: TButton;
btnRetry: TButton;
Captcha1: TCaptchaLabel;
edCaptcha: TEdit;
GroupBox1: TGroupBox;
procedure btnRetryClick(Sender: TObject);
procedure btnVerifyClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.btnRetryClick(Sender: TObject);
begin
Captcha1.NewCaptcha;
edCaptcha.Clear;
end;
procedure TForm1.btnVerifyClick(Sender: TObject);
begin
if edCaptcha.Text = '' then
ShowMessage('No CAPTCHA code entered.')
else
if Captcha1.Verify(edCaptcha.Text) then
ShowMessage('Input accepted.')
else
ShowMessage('Sorry. Your input does not match.' + LineEnding +
'The correct value would have been: ' + Captcha1.Text);
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
Constraints.MinHeight := Height;
Constraints.MaxHeight := Height;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Randomize;
cInputQueryEditSizePercents := 0;
end;
end.

80
components/captcha/demos/simple_demo/simpledemo.lpi Normal file
View File

@ -0,0 +1,80 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<Title Value="SimpleDemo"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
</XPManifest>
<Icon Value="0"/>
</General>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<RequiredPackages>
<Item>
<PackageName Value="captcha_pkg"/>
</Item>
<Item>
<PackageName Value="LCL"/>
</Item>
</RequiredPackages>
<Units>
<Unit>
<Filename Value="SimpleDemo.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="main.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Main"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="SimpleDemo"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

25
components/captcha/demos/simple_demo/simpledemo.lpr Normal file
View File

@ -0,0 +1,25 @@
program SimpleDemo;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
{$IFDEF HASAMIGA}
athreads,
{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Main
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Scaled:=True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

64
components/captcha/source/captchactrl.pas
View File

@ -52,7 +52,7 @@ const
DEFAULT_CAPTCHA_NUMLINES = 30; DEFAULT_CAPTCHA_NUMLINES = 30;
type type
TCaptcha = class(TGraphicControl) TCaptchaLabel = class(TGraphicControl)
private private
FBuffer: TBitmap; FBuffer: TBitmap;
FCaptchaChars: TCaptchaCharArray; FCaptchaChars: TCaptchaCharArray;
@ -137,7 +137,7 @@ uses
procedure Register; procedure Register;
begin begin
RegisterComponents('Misc', [TCaptcha]); RegisterComponents('Misc', [TCaptchaLabel]);
end; end;
@ -168,9 +168,9 @@ begin
end; end;
{ TCaptcha } { TCaptchaLabel }
constructor TCaptcha.Create(AOwner: TComponent); constructor TCaptchaLabel.Create(AOwner: TComponent);
begin begin
inherited; inherited;
with GetControlClassDefaultSize do with GetControlClassDefaultSize do
@ -209,7 +209,7 @@ begin
Randomize; Randomize;
end; end;
destructor TCaptcha.Destroy; destructor TCaptchaLabel.Destroy;
begin begin
Finalize(FCaptchaChars); Finalize(FCaptchaChars);
Finalize(FCaptchaLines); Finalize(FCaptchaLines);
@ -219,7 +219,7 @@ begin
inherited; inherited;
end; end;
function TCaptcha.AlmostBackgroundColor(AColor: TColor): Boolean; function TCaptchaLabel.AlmostBackgroundColor(AColor: TColor): Boolean;
const const
TOLERANCE = 64; TOLERANCE = 64;
var var
@ -231,7 +231,7 @@ begin
Result := abs(colorL - bgColorL) < TOLERANCE; Result := abs(colorL - bgColorL) < TOLERANCE;
end; end;
procedure TCaptcha.CalculatePreferredSize( procedure TCaptchaLabel.CalculatePreferredSize(
var PreferredWidth, PreferredHeight: integer; var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean); WithThemeSpace: Boolean);
begin begin
@ -254,14 +254,14 @@ begin
PreferredHeight := 3*PreferredHeight div 2; PreferredHeight := 3*PreferredHeight div 2;
end; end;
procedure TCaptcha.Click; procedure TCaptchaLabel.Click;
begin begin
inherited; inherited;
if FNewCaptchaEvent = nceClick then if FNewCaptchaEvent = nceClick then
NewCaptcha; NewCaptcha;
end; end;
procedure TCaptcha.CreateNewCaptcha(ANumChars, ANumLines: Integer; procedure TCaptchaLabel.CreateNewCaptcha(ANumChars, ANumLines: Integer;
KeepText, KeepLines: Boolean); KeepText, KeepLines: Boolean);
begin begin
if not KeepText then if not KeepText then
@ -276,14 +276,14 @@ begin
DrawBuffer; DrawBuffer;
end; end;
procedure TCaptcha.DblClick; procedure TCaptchaLabel.DblClick;
begin begin
inherited; inherited;
if FNewCaptchaEvent = nceDblClick then if FNewCaptchaEvent = nceDblClick then
NewCaptcha; NewCaptcha;
end; end;
procedure TCaptcha.DrawBuffer; procedure TCaptchaLabel.DrawBuffer;
var var
i: Integer; i: Integer;
begin begin
@ -325,12 +325,12 @@ begin
end; end;
end; end;
function TCaptcha.GetFont(AIndex: Integer): TFont; function TCaptchaLabel.GetFont(AIndex: Integer): TFont;
begin begin
Result := FFonts[AIndex]; Result := FFonts[AIndex];
end; end;
function TCaptcha.GetCaptchaText: string; function TCaptchaLabel.GetCaptchaText: string;
var var
i: Integer; i: Integer;
begin begin
@ -339,12 +339,12 @@ begin
Result := Result + FCaptchaChars[i].Character; Result := Result + FCaptchaChars[i].Character;
end; end;
function TCaptcha.GetValidChars(AIndex: Integer): String; function TCaptchaLabel.GetValidChars(AIndex: Integer): String;
begin begin
Result := FValidChars[TCaptchaCharsOption(AIndex)]; Result := FValidChars[TCaptchaCharsOption(AIndex)];
end; end;
procedure TCaptcha.InitAngles; procedure TCaptchaLabel.InitAngles;
var var
i: Integer; i: Integer;
begin begin
@ -356,7 +356,7 @@ end;
When KeepVertPos is false, the vertical position of the characters is selected When KeepVertPos is false, the vertical position of the characters is selected
randomly within the height of the control. Otherwise the already stored randomly within the height of the control. Otherwise the already stored
vertical positions are used. } vertical positions are used. }
procedure TCaptcha.InitCharPos(KeepVertPos: Boolean); procedure TCaptchaLabel.InitCharPos(KeepVertPos: Boolean);
var var
x: Integer; x: Integer;
i: Integer; i: Integer;
@ -409,7 +409,7 @@ begin
FBuffer.SetSize(x, maxHeight); FBuffer.SetSize(x, maxHeight);
end; end;
procedure TCaptcha.InitFontIndex; procedure TCaptchaLabel.InitFontIndex;
var var
i: Integer; i: Integer;
begin begin
@ -427,7 +427,7 @@ end;
{ Pick random color for a line. { Pick random color for a line.
Make sure that the color is not too close to the background color. } Make sure that the color is not too close to the background color. }
procedure TCaptcha.InitLineColors; procedure TCaptchaLabel.InitLineColors;
var var
i: Integer; i: Integer;
begin begin
@ -439,7 +439,7 @@ begin
until not AlmostBackgroundColor(FCaptchaLines[i].Color); until not AlmostBackgroundColor(FCaptchaLines[i].Color);
end; end;
procedure TCaptcha.InitLines(ACount: Integer; KeepExisting: Boolean); procedure TCaptchaLabel.InitLines(ACount: Integer; KeepExisting: Boolean);
var var
i, n: Integer; i, n: Integer;
begin begin
@ -470,7 +470,7 @@ begin
end; end;
end; end;
procedure TCaptcha.InitText(ACount: Integer; KeepExisting: Boolean); procedure TCaptchaLabel.InitText(ACount: Integer; KeepExisting: Boolean);
var var
i, j, n: Integer; i, j, n: Integer;
ok: Boolean; ok: Boolean;
@ -539,7 +539,7 @@ end;
{ Pick random color for a character. { Pick random color for a character.
Make sure that the color is not too close to the background color. } Make sure that the color is not too close to the background color. }
procedure TCaptcha.InitTextColors; procedure TCaptchaLabel.InitTextColors;
var var
i: Integer; i: Integer;
begin begin
@ -551,18 +551,18 @@ begin
until not AlmostbackgroundColor(FCaptchaChars[i].Color); until not AlmostbackgroundColor(FCaptchaChars[i].Color);
end; end;
procedure TCaptcha.NewCaptcha; procedure TCaptchaLabel.NewCaptcha;
begin begin
CreateNewCaptcha(FNumChars, FNumLines, false, false); CreateNewCaptcha(FNumChars, FNumLines, false, false);
Invalidate; Invalidate;
end; end;
procedure TCaptcha.Paint; procedure TCaptchaLabel.Paint;
begin begin
Canvas.Draw((Width - FBuffer.Width) div 2, (Height - FBuffer.Height) div 2, FBuffer); Canvas.Draw((Width - FBuffer.Width) div 2, (Height - FBuffer.Height) div 2, FBuffer);
end; end;
procedure TCaptcha.Resize; procedure TCaptchaLabel.Resize;
begin begin
inherited; inherited;
if Assigned(FBuffer) and not FInitialized then if Assigned(FBuffer) and not FInitialized then
@ -572,7 +572,7 @@ begin
end; end;
end; end;
procedure TCaptcha.SetColor(AValue: TColor); procedure TCaptchaLabel.SetColor(AValue: TColor);
begin begin
if AValue = Color then if AValue = Color then
exit; exit;
@ -583,7 +583,7 @@ begin
Invalidate; Invalidate;
end; end;
procedure TCaptcha.SetFont(AIndex: Integer; const AValue: TFont); procedure TCaptchaLabel.SetFont(AIndex: Integer; const AValue: TFont);
begin begin
if FFonts[AIndex].IsEqual(AValue) then if FFonts[AIndex].IsEqual(AValue) then
exit; exit;
@ -594,7 +594,7 @@ begin
Invalidate; Invalidate;
end; end;
procedure TCaptcha.SetMaxAngle(const AValue: Integer); procedure TCaptchaLabel.SetMaxAngle(const AValue: Integer);
begin begin
if AValue = FMaxAngle then if AValue = FMaxAngle then
exit; exit;
@ -605,7 +605,7 @@ begin
Invalidate; Invalidate;
end; end;
procedure TCaptcha.SetNumChars(const AValue: Integer); procedure TCaptchaLabel.SetNumChars(const AValue: Integer);
begin begin
if AValue = FNumChars then if AValue = FNumChars then
exit; exit;
@ -618,7 +618,7 @@ begin
Invalidate; Invalidate;
end; end;
procedure TCaptcha.SetNumLines(const AValue: Integer); procedure TCaptchaLabel.SetNumLines(const AValue: Integer);
begin begin
if AValue = FNumLines then if AValue = FNumLines then
exit; exit;
@ -628,7 +628,7 @@ begin
Invalidate; Invalidate;
end; end;
procedure TCaptcha.SetOptions(const AValue: TCaptchaOptions); procedure TCaptchaLabel.SetOptions(const AValue: TCaptchaOptions);
var var
oldOptions: TCaptchaOptions; oldOptions: TCaptchaOptions;
begin begin
@ -656,7 +656,7 @@ begin
Invalidate; Invalidate;
end; end;
procedure TCaptcha.SetValidChars(AIndex: Integer; const AValue: String); procedure TCaptchaLabel.SetValidChars(AIndex: Integer; const AValue: String);
begin begin
if FValidChars[TCaptchaCharsOption(AIndex)] = AValue then if FValidChars[TCaptchaCharsOption(AIndex)] = AValue then
exit; exit;
@ -665,7 +665,7 @@ begin
end; end;
function TCaptcha.Verify(const AText: String): Boolean; function TCaptchaLabel.Verify(const AText: String): Boolean;
begin begin
Result := (AText = GetCaptchaText); Result := (AText = GetCaptchaText);
end; end;