You've already forked lazarus-ccr
captcha: Initial commit
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8111 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
62
components/captcha/README.txt
Normal file
62
components/captcha/README.txt
Normal file
@ -0,0 +1,62 @@
|
||||
--------------------------------------------------------------------------------
|
||||
Visual CAPTCHA component for Lazarus
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
Description
|
||||
-----------
|
||||
|
||||
The component TCaptcha descends from TGraphicControl and contains its own drawing
|
||||
routine. Just place it on the form and use it. It displays a random string with
|
||||
slanted characters and overlaid lines.
|
||||
|
||||
The method Verify() checks whether a user-provided string matches the
|
||||
captcha string and returns true.
|
||||
|
||||
There are several properties to define its behaviour:
|
||||
|
||||
* NumChars: Number of characters in the captcha
|
||||
|
||||
* NumLines: Number of lines drawn over the captcha
|
||||
|
||||
* Font1, Font2: two fonts to be mixed within the captcha randomly
|
||||
|
||||
* MaxAngle: maximum rotation angle for the characters which are rotated by a
|
||||
random angle between -MaxAngle and +MaxAngle
|
||||
|
||||
* Color: the background color of the area of the control covered by the captcha.
|
||||
Character and line colors are selected such that a minimum brightness difference
|
||||
to the background color is achieved.
|
||||
|
||||
* Options: This is a set of the following options which can be combined:
|
||||
* coAlphaUpper: Use uppercase characters as defined by the the UppercaseChars string
|
||||
* coAlphaLower: Use lowercase characters as defined by the LowercaseChars string
|
||||
* coNumeric: Use numeric characters as defined by the NumericChars string
|
||||
(the characters which are hard to distinguish are skipped,
|
||||
zero vs uppercase O, lowercase L vs upper case I)
|
||||
* coCustom: Use special characters as defined by the CustomChars string
|
||||
* coRotated: Characters are rotated
|
||||
* coFont1: Font1 is used
|
||||
* coFont2: Font2 is used
|
||||
* coLines: Lines are drawn over the captcha
|
||||
|
||||
* NewCaptchaEvent: Enumerated property for how to quickly select of a new captcha
|
||||
string at runtime:
|
||||
* nceNone: deactivated; captcha can only be changed by code.
|
||||
* nceClick: a new captcha is created when the user clicks on the control
|
||||
* nceDblClick: a new captcha is created when the user double-clicks on the control.
|
||||
|
||||
|
||||
Installation
|
||||
------------
|
||||
|
||||
* Load the package file captcha_pkg.lpk into the Lazarus Package Editor and
|
||||
click "Use" > "Install" to rebuild the Lazarus IDE. When Lazarus restarts you
|
||||
find the new component in the palette "Misc".
|
||||
|
||||
|
||||
License
|
||||
-------
|
||||
|
||||
LGPL with linking exception, like the Lazarus LCL.
|
||||
See the file COPYING.modifiedLGPL.txt, included in the Lazarus distribution,
|
||||
for details about the license.
|
||||
40
components/captcha/captcha_pkg.lpk
Normal file
40
components/captcha/captcha_pkg.lpk
Normal file
@ -0,0 +1,40 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<Package Version="5">
|
||||
<PathDelim Value="\"/>
|
||||
<Name Value="captcha_pkg"/>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<Author Value="W. Pamler"/>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<SearchPaths>
|
||||
<OtherUnitFiles Value="source"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
</CompilerOptions>
|
||||
<Description Value="A visual component which displays a CAPTCHA"/>
|
||||
<License Value="LGPL with linking exception (like Lazarus LCL)"/>
|
||||
<Version Minor="1"/>
|
||||
<Files Count="1">
|
||||
<Item1>
|
||||
<Filename Value="source\captchactrl.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="CaptchaCtrl"/>
|
||||
</Item1>
|
||||
</Files>
|
||||
<CompatibilityMode Value="True"/>
|
||||
<RequiredPkgs Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
</RequiredPkgs>
|
||||
<UsageOptions>
|
||||
<UnitPath Value="$(PkgOutDir)"/>
|
||||
</UsageOptions>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<UseFileFilters Value="True"/>
|
||||
</PublishOptions>
|
||||
</Package>
|
||||
</CONFIG>
|
||||
22
components/captcha/captcha_pkg.pas
Normal file
22
components/captcha/captcha_pkg.pas
Normal file
@ -0,0 +1,22 @@
|
||||
{ This file was automatically created by Lazarus. Do not edit!
|
||||
This source is only used to compile and install the package.
|
||||
}
|
||||
|
||||
unit captcha_pkg;
|
||||
|
||||
{$warn 5023 off : no warning about unused units}
|
||||
interface
|
||||
|
||||
uses
|
||||
CaptchaCtrl, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterUnit('CaptchaCtrl', @CaptchaCtrl.Register);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterPackage('captcha_pkg', @Register);
|
||||
end.
|
||||
89
components/captcha/demo_runtime/capcha_demo.lpi
Normal file
89
components/captcha/demo_runtime/capcha_demo.lpi
Normal file
@ -0,0 +1,89 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="12"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<CompatibilityMode Value="True"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<Title Value="capcha_demo"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<XPManifest>
|
||||
<DpiAware Value="True"/>
|
||||
</XPManifest>
|
||||
</General>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
<Modes Count="1">
|
||||
<Mode0 Name="default"/>
|
||||
</Modes>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="3">
|
||||
<Unit0>
|
||||
<Filename Value="capcha_demo.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="main.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="DemoForm"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="..\source\captchactrl.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="CaptchaUnit"/>
|
||||
</Unit2>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="bin\$(TargetCPU)-$(TargetOS)\capcha_demo"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<OtherUnitFiles Value="..\source"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<DebugInfoType Value="dsDwarf2Set"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
24
components/captcha/demo_runtime/capcha_demo.lpr
Normal file
24
components/captcha/demo_runtime/capcha_demo.lpr
Normal file
@ -0,0 +1,24 @@
|
||||
program capcha_demo;
|
||||
|
||||
{$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.Initialize;
|
||||
Application.CreateForm(TDemoForm, DemoForm);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
418
components/captcha/demo_runtime/main.lfm
Normal file
418
components/captcha/demo_runtime/main.lfm
Normal file
@ -0,0 +1,418 @@
|
||||
object DemoForm: TDemoForm
|
||||
Left = 285
|
||||
Height = 385
|
||||
Top = 131
|
||||
Width = 693
|
||||
AutoSize = True
|
||||
Caption = 'Captcha Demo'
|
||||
ClientHeight = 385
|
||||
ClientWidth = 693
|
||||
OnCreate = FormCreate
|
||||
LCLVersion = '2.3.0.0'
|
||||
object SettingsPanel: TPanel
|
||||
Left = 16
|
||||
Height = 239
|
||||
Top = 130
|
||||
Width = 661
|
||||
Align = alBottom
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 16
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 239
|
||||
ClientWidth = 661
|
||||
TabOrder = 1
|
||||
object clbBackgroundColor: TColorBox
|
||||
AnchorSideLeft.Control = cmbNewCaptchaEvent
|
||||
AnchorSideTop.Control = SettingsPanel
|
||||
AnchorSideRight.Control = cmbNewCaptchaEvent
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 113
|
||||
Height = 22
|
||||
Top = 0
|
||||
Width = 123
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
DropDownCount = 32
|
||||
ItemHeight = 16
|
||||
OnChange = clbBackgroundColorChange
|
||||
TabOrder = 0
|
||||
end
|
||||
object lblBackgroundColor: TLabel
|
||||
AnchorSideLeft.Control = SettingsPanel
|
||||
AnchorSideTop.Control = clbBackgroundColor
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 0
|
||||
Height = 15
|
||||
Top = 4
|
||||
Width = 94
|
||||
Caption = 'Background color'
|
||||
end
|
||||
object lblMaxAngle: TLabel
|
||||
AnchorSideLeft.Control = SettingsPanel
|
||||
AnchorSideTop.Control = seMaxAngle
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 0
|
||||
Height = 15
|
||||
Top = 30
|
||||
Width = 55
|
||||
Caption = 'Max angle'
|
||||
end
|
||||
object seMaxAngle: TSpinEdit
|
||||
AnchorSideLeft.Control = cmbNewCaptchaEvent
|
||||
AnchorSideTop.Control = clbBackgroundColor
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = cmbNewCaptchaEvent
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 113
|
||||
Height = 23
|
||||
Top = 26
|
||||
Width = 123
|
||||
Alignment = taRightJustify
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Top = 4
|
||||
Increment = 5
|
||||
MaxValue = 90
|
||||
OnChange = seMaxAngleChange
|
||||
TabOrder = 1
|
||||
end
|
||||
object cgOptions: TCheckGroup
|
||||
AnchorSideLeft.Control = clbBackgroundColor
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = SettingsPanel
|
||||
Left = 260
|
||||
Height = 103
|
||||
Top = 0
|
||||
Width = 418
|
||||
AutoFill = True
|
||||
AutoSize = True
|
||||
BorderSpacing.Left = 24
|
||||
Caption = 'Options'
|
||||
ChildSizing.LeftRightSpacing = 16
|
||||
ChildSizing.TopBottomSpacing = 6
|
||||
ChildSizing.HorizontalSpacing = 12
|
||||
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
|
||||
ChildSizing.EnlargeVertical = crsHomogenousChildResize
|
||||
ChildSizing.ShrinkHorizontal = crsScaleChilds
|
||||
ChildSizing.ShrinkVertical = crsScaleChilds
|
||||
ChildSizing.Layout = cclLeftToRightThenTopToBottom
|
||||
ChildSizing.ControlsPerLine = 4
|
||||
ClientHeight = 83
|
||||
ClientWidth = 414
|
||||
Columns = 4
|
||||
Items.Strings = (
|
||||
'Alpha uppercase'
|
||||
'Alpha lowercase'
|
||||
'Numeric'
|
||||
'Custom'
|
||||
'Rotated'
|
||||
'Font 1'
|
||||
'Font 2'
|
||||
'Lines'
|
||||
)
|
||||
OnItemClick = cgOptionsItemClick
|
||||
TabOrder = 4
|
||||
Data = {
|
||||
080000000202020202020202
|
||||
}
|
||||
object Label6: TLabel
|
||||
Left = 16
|
||||
Height = 25
|
||||
Top = 52
|
||||
Width = 108
|
||||
Caption = ' '
|
||||
end
|
||||
object btnFont1: TButton
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 136
|
||||
Height = 25
|
||||
Top = 52
|
||||
Width = 70
|
||||
AutoSize = True
|
||||
Caption = 'Font 1...'
|
||||
Constraints.MaxWidth = 70
|
||||
OnClick = btnFont1Click
|
||||
TabOrder = 0
|
||||
end
|
||||
object btnFont2: TButton
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 254
|
||||
Height = 25
|
||||
Top = 52
|
||||
Width = 70
|
||||
AutoSize = True
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Top = 8
|
||||
Caption = 'Font 2...'
|
||||
Constraints.MaxWidth = 70
|
||||
Constraints.MinWidth = 70
|
||||
OnClick = btnFont2Click
|
||||
TabOrder = 1
|
||||
end
|
||||
end
|
||||
object lblCharCount: TLabel
|
||||
AnchorSideLeft.Control = SettingsPanel
|
||||
AnchorSideTop.Control = seCharCount
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 0
|
||||
Height = 15
|
||||
Top = 57
|
||||
Width = 88
|
||||
Caption = 'Character count:'
|
||||
end
|
||||
object seCharCount: TSpinEdit
|
||||
AnchorSideLeft.Control = cmbNewCaptchaEvent
|
||||
AnchorSideTop.Control = seMaxAngle
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = cmbNewCaptchaEvent
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 113
|
||||
Height = 23
|
||||
Top = 53
|
||||
Width = 123
|
||||
Alignment = taRightJustify
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Top = 4
|
||||
MaxValue = 90
|
||||
OnChange = seCharCountChange
|
||||
TabOrder = 2
|
||||
end
|
||||
object lblLinesCount: TLabel
|
||||
AnchorSideLeft.Control = SettingsPanel
|
||||
AnchorSideTop.Control = seLinesCount
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 0
|
||||
Height = 15
|
||||
Top = 84
|
||||
Width = 61
|
||||
Caption = 'Lines count'
|
||||
end
|
||||
object seLinesCount: TSpinEdit
|
||||
AnchorSideLeft.Control = cmbNewCaptchaEvent
|
||||
AnchorSideTop.Control = seCharCount
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = cmbNewCaptchaEvent
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 113
|
||||
Height = 23
|
||||
Top = 80
|
||||
Width = 123
|
||||
Alignment = taRightJustify
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Top = 4
|
||||
MaxValue = 90
|
||||
OnChange = seLinesCountChange
|
||||
TabOrder = 3
|
||||
end
|
||||
object cmbNewCaptchaEvent: TComboBox
|
||||
AnchorSideLeft.Control = Label1
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = seLinesCount
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = seLinesCount
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 113
|
||||
Height = 23
|
||||
Top = 107
|
||||
Width = 123
|
||||
BorderSpacing.Left = 12
|
||||
BorderSpacing.Top = 4
|
||||
ItemHeight = 15
|
||||
ItemIndex = 0
|
||||
Items.Strings = (
|
||||
'none'
|
||||
'Click'
|
||||
'Double Click'
|
||||
)
|
||||
OnChange = cmbNewCaptchaEventChange
|
||||
TabOrder = 5
|
||||
Text = 'none'
|
||||
end
|
||||
object Label1: TLabel
|
||||
AnchorSideLeft.Control = SettingsPanel
|
||||
AnchorSideTop.Control = cmbNewCaptchaEvent
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 0
|
||||
Height = 15
|
||||
Top = 111
|
||||
Width = 101
|
||||
Caption = 'New captcha event'
|
||||
end
|
||||
object edUppercaseChars: TEdit
|
||||
AnchorSideLeft.Control = cmbNewCaptchaEvent
|
||||
AnchorSideRight.Control = cgOptions
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 113
|
||||
Height = 23
|
||||
Top = 135
|
||||
Width = 565
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
OnChange = edUppercaseCharsChange
|
||||
TabOrder = 6
|
||||
TextHint = 'Upper-case characters to be used'
|
||||
end
|
||||
object Label2: TLabel
|
||||
AnchorSideLeft.Control = SettingsPanel
|
||||
AnchorSideTop.Control = edUppercaseChars
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 0
|
||||
Height = 15
|
||||
Top = 139
|
||||
Width = 60
|
||||
Caption = 'Upper-case'
|
||||
end
|
||||
object Label3: TLabel
|
||||
AnchorSideLeft.Control = SettingsPanel
|
||||
AnchorSideTop.Control = edLowercaseChars
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 0
|
||||
Height = 15
|
||||
Top = 166
|
||||
Width = 60
|
||||
Caption = 'Lower-case'
|
||||
end
|
||||
object edLowercaseChars: TEdit
|
||||
AnchorSideLeft.Control = cmbNewCaptchaEvent
|
||||
AnchorSideTop.Control = edUppercaseChars
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = cgOptions
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 113
|
||||
Height = 23
|
||||
Top = 162
|
||||
Width = 565
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Top = 4
|
||||
OnChange = edLowercaseCharsChange
|
||||
TabOrder = 7
|
||||
TextHint = 'Lower-case characters to be used'
|
||||
end
|
||||
object Label4: TLabel
|
||||
AnchorSideLeft.Control = SettingsPanel
|
||||
AnchorSideTop.Control = edNumericChars
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 0
|
||||
Height = 15
|
||||
Top = 193
|
||||
Width = 77
|
||||
Caption = 'Numeric chars'
|
||||
end
|
||||
object edNumericChars: TEdit
|
||||
AnchorSideLeft.Control = cmbNewCaptchaEvent
|
||||
AnchorSideTop.Control = edLowercaseChars
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = cgOptions
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 113
|
||||
Height = 23
|
||||
Top = 189
|
||||
Width = 565
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Top = 4
|
||||
OnChange = edNumericCharsChange
|
||||
TabOrder = 8
|
||||
TextHint = 'Numeric characters'
|
||||
end
|
||||
object Label5: TLabel
|
||||
AnchorSideLeft.Control = SettingsPanel
|
||||
AnchorSideTop.Control = edCustomChars
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 0
|
||||
Height = 15
|
||||
Top = 220
|
||||
Width = 95
|
||||
Caption = 'Any custom chars'
|
||||
end
|
||||
object edCustomChars: TEdit
|
||||
AnchorSideLeft.Control = cmbNewCaptchaEvent
|
||||
AnchorSideTop.Control = edNumericChars
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = cgOptions
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 113
|
||||
Height = 23
|
||||
Top = 216
|
||||
Width = 565
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Top = 4
|
||||
OnChange = edCustomCharsChange
|
||||
TabOrder = 9
|
||||
TextHint = 'Any other characters to be included'
|
||||
end
|
||||
end
|
||||
object gbVerify: TGroupBox
|
||||
Left = 16
|
||||
Height = 69
|
||||
Top = 25
|
||||
Width = 661
|
||||
Align = alBottom
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 16
|
||||
Caption = 'Enter CAPTCHA code'
|
||||
ClientHeight = 49
|
||||
ClientWidth = 657
|
||||
TabOrder = 0
|
||||
object edTestCode: TEdit
|
||||
AnchorSideLeft.Control = gbVerify
|
||||
AnchorSideTop.Control = gbVerify
|
||||
AnchorSideTop.Side = asrCenter
|
||||
AnchorSideRight.Control = btnVerify
|
||||
Left = 16
|
||||
Height = 23
|
||||
Top = 13
|
||||
Width = 472
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Left = 16
|
||||
TabOrder = 0
|
||||
TextHint = 'Enter the CAPTCHA code here'
|
||||
end
|
||||
object btnVerify: TButton
|
||||
AnchorSideLeft.Control = edTestCode
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = gbVerify
|
||||
AnchorSideTop.Side = asrCenter
|
||||
AnchorSideRight.Control = btnTryAgain
|
||||
Left = 500
|
||||
Height = 25
|
||||
Top = 12
|
||||
Width = 56
|
||||
Anchors = [akTop, akRight]
|
||||
AutoSize = True
|
||||
BorderSpacing.Left = 12
|
||||
BorderSpacing.Right = 8
|
||||
BorderSpacing.Bottom = 12
|
||||
Caption = 'Verify'
|
||||
OnClick = btnVerifyClick
|
||||
TabOrder = 1
|
||||
end
|
||||
object btnTryAgain: TButton
|
||||
AnchorSideTop.Control = gbVerify
|
||||
AnchorSideTop.Side = asrCenter
|
||||
AnchorSideRight.Control = gbVerify
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 564
|
||||
Height = 25
|
||||
Top = 12
|
||||
Width = 77
|
||||
Anchors = [akTop, akRight]
|
||||
AutoSize = True
|
||||
BorderSpacing.Right = 16
|
||||
Caption = 'Try again!'
|
||||
OnClick = btnTryAgainClick
|
||||
TabOrder = 2
|
||||
end
|
||||
end
|
||||
object Bevel1: TBevel
|
||||
Left = 0
|
||||
Height = 4
|
||||
Top = 110
|
||||
Width = 693
|
||||
Align = alBottom
|
||||
Shape = bsBottomLine
|
||||
end
|
||||
object FontDialog: TFontDialog
|
||||
MinFontSize = 0
|
||||
MaxFontSize = 0
|
||||
Left = 496
|
||||
Top = 288
|
||||
end
|
||||
end
|
||||
192
components/captcha/demo_runtime/main.pas
Normal file
192
components/captcha/demo_runtime/main.pas
Normal file
@ -0,0 +1,192 @@
|
||||
unit main;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, ColorBox,
|
||||
StdCtrls, Spin, CaptchaCtrl;
|
||||
|
||||
type
|
||||
|
||||
{ TDemoForm }
|
||||
|
||||
TDemoForm = class(TForm)
|
||||
Bevel1: TBevel;
|
||||
btnTryAgain: TButton;
|
||||
btnFont1: TButton;
|
||||
btnFont2: TButton;
|
||||
btnVerify: TButton;
|
||||
cgOptions: TCheckGroup;
|
||||
clbBackgroundColor: TColorBox;
|
||||
cmbNewCaptchaEvent: TComboBox;
|
||||
edNumericChars: TEdit;
|
||||
edCustomChars: TEdit;
|
||||
edUppercaseChars: TEdit;
|
||||
edLowercaseChars: TEdit;
|
||||
edTestCode: TEdit;
|
||||
FontDialog: TFontDialog;
|
||||
gbVerify: TGroupBox;
|
||||
Label1: TLabel;
|
||||
Label2: TLabel;
|
||||
Label3: TLabel;
|
||||
Label4: TLabel;
|
||||
Label5: TLabel;
|
||||
Label6: TLabel;
|
||||
lblBackgroundColor: TLabel;
|
||||
lblMaxAngle: TLabel;
|
||||
lblCharCount: TLabel;
|
||||
lblLinesCount: TLabel;
|
||||
SettingsPanel: TPanel;
|
||||
seMaxAngle: TSpinEdit;
|
||||
seCharCount: TSpinEdit;
|
||||
seLinesCount: TSpinEdit;
|
||||
procedure btnTryAgainClick(Sender: TObject);
|
||||
procedure Button1Click(Sender: TObject);
|
||||
procedure btnFont1Click(Sender: TObject);
|
||||
procedure btnFont2Click(Sender: TObject);
|
||||
procedure btnVerifyClick(Sender: TObject);
|
||||
procedure cgOptionsItemClick(Sender: TObject; Index: integer);
|
||||
procedure clbBackgroundColorChange(Sender: TObject);
|
||||
procedure cmbNewCaptchaEventChange(Sender: TObject);
|
||||
procedure edCustomCharsChange(Sender: TObject);
|
||||
procedure edNumericCharsChange(Sender: TObject);
|
||||
procedure edLowercaseCharsChange(Sender: TObject);
|
||||
procedure edUppercaseCharsChange(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure seMaxAngleChange(Sender: TObject);
|
||||
procedure seCharCountChange(Sender: TObject);
|
||||
procedure seLinesCountChange(Sender: TObject);
|
||||
private
|
||||
FCaptcha: TCaptcha;
|
||||
|
||||
public
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
DemoForm: TDemoForm;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TDemoForm }
|
||||
|
||||
procedure TDemoForm.FormCreate(Sender: TObject);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Randomize;
|
||||
|
||||
FCaptcha := TCaptcha.Create(self);
|
||||
FCaptcha.Width := Width;
|
||||
FCaptcha.Parent := self;
|
||||
FCaptcha.Color := clWhite;
|
||||
FCaptcha.NumChars := 8;
|
||||
FCaptcha.Align := alClient;
|
||||
FCaptcha.BorderSpacing.Around := 6;
|
||||
FCaptcha.CustomChars := 'äöü:';
|
||||
FCaptcha.NumericChars := '0123';
|
||||
FCaptcha.Options := FCaptcha.Options - [coAlphaUpper, coAlphaLower, coNumeric];
|
||||
|
||||
clbBackgroundColor.Selected := FCaptcha.Color;
|
||||
seMaxAngle.Value := FCaptcha.MaxAngle;
|
||||
seCharCount.Value := FCaptcha.NumChars;
|
||||
seLinesCount.Value := FCaptcha.NumLines;
|
||||
edUpperCaseChars.Text := FCaptcha.UppercaseChars;
|
||||
edLowercaseChars.Text := FCaptcha.LowercaseChars;
|
||||
edNumericChars.Text := FCaptcha.NumericChars;
|
||||
edCustomChars.Text := FCaptcha.CustomChars;
|
||||
for i := 0 to cgOptions.Items.Count-1 do
|
||||
cgOptions.Checked[i] := TCaptchaOption(i) in FCaptcha.Options;
|
||||
end;
|
||||
|
||||
procedure TDemoForm.seMaxAngleChange(Sender: TObject);
|
||||
begin
|
||||
FCaptcha.MaxAngle := seMaxAngle.Value;
|
||||
end;
|
||||
|
||||
procedure TDemoForm.seCharCountChange(Sender: TObject);
|
||||
begin
|
||||
FCaptcha.NumChars := seCharCount.Value;
|
||||
end;
|
||||
|
||||
procedure TDemoForm.seLinesCountChange(Sender: TObject);
|
||||
begin
|
||||
FCaptcha.NumLines := seLinesCount.Value;
|
||||
end;
|
||||
|
||||
procedure TDemoForm.clbBackgroundColorChange(Sender: TObject);
|
||||
begin
|
||||
FCaptcha.Color := clbBackgroundColor.Selected;
|
||||
end;
|
||||
|
||||
procedure TDemoForm.cmbNewCaptchaEventChange(Sender: TObject);
|
||||
begin
|
||||
FCaptcha.NewCaptchaEvent := TNewCaptchaEvent(cmbNewCaptchaEvent.ItemIndex);
|
||||
end;
|
||||
|
||||
procedure TDemoForm.edCustomCharsChange(Sender: TObject);
|
||||
begin
|
||||
FCaptcha.CustomChars := edCustomChars.Text;
|
||||
end;
|
||||
|
||||
procedure TDemoForm.edNumericCharsChange(Sender: TObject);
|
||||
begin
|
||||
FCaptcha.NumericChars := edNumericChars.Text;
|
||||
end;
|
||||
|
||||
procedure TDemoForm.edLowercaseCharsChange(Sender: TObject);
|
||||
begin
|
||||
FCaptcha.LowercaseChars := edLowercaseChars.Text;
|
||||
end;
|
||||
|
||||
procedure TDemoForm.edUppercaseCharsChange(Sender: TObject);
|
||||
begin
|
||||
FCaptcha.UppercaseChars := edUppercaseChars.Text;
|
||||
end;
|
||||
|
||||
procedure TDemoForm.btnTryAgainClick(Sender: TObject);
|
||||
begin
|
||||
FCaptcha.NewCaptcha;
|
||||
end;
|
||||
|
||||
procedure TDemoForm.Button1Click(Sender: TObject);
|
||||
begin
|
||||
FCaptcha.AutoSize := not FCaptcha.AutoSize;
|
||||
end;
|
||||
|
||||
procedure TDemoForm.btnFont1Click(Sender: TObject);
|
||||
begin
|
||||
FontDialog.Font.Assign(FCaptcha.Font1);
|
||||
if FontDialog.Execute then
|
||||
FCaptcha.Font1 := FontDialog.Font;
|
||||
end;
|
||||
|
||||
procedure TDemoForm.btnFont2Click(Sender: TObject);
|
||||
begin
|
||||
FontDialog.Font.Assign(FCaptcha.Font2);
|
||||
if FontDialog.Execute then
|
||||
FCaptcha.Font2 := FontDialog.Font;
|
||||
end;
|
||||
|
||||
procedure TDemoForm.btnVerifyClick(Sender: TObject);
|
||||
begin
|
||||
if FCaptcha.Verify(edTestCode.Text) then
|
||||
ShowMessage('Valid.')
|
||||
else
|
||||
ShowMessage('NOT valid.' + LineEnding + 'The correct code would have been: "' + FCaptcha.Text + '"');
|
||||
end;
|
||||
|
||||
procedure TDemoForm.cgOptionsItemClick(Sender: TObject; Index: integer);
|
||||
begin
|
||||
if cgOptions.Checked[Index] then
|
||||
FCaptcha.Options := FCaptcha.Options + [TCaptchaOption(Index)]
|
||||
else
|
||||
FCaptcha.Options := FCaptcha.Options - [TCaptchaOption(Index)]
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
1
components/captcha/images/make_res.bat
Normal file
1
components/captcha/images/make_res.bat
Normal file
@ -0,0 +1 @@
|
||||
lazres ../source/captcha_images.res tcaptcha.png tcaptcha_150.png tcaptcha_200.png
|
||||
BIN
components/captcha/images/tcaptcha-screenshot.png
Normal file
BIN
components/captcha/images/tcaptcha-screenshot.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 19 KiB |
BIN
components/captcha/images/tcaptcha.png
Normal file
BIN
components/captcha/images/tcaptcha.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.3 KiB |
BIN
components/captcha/images/tcaptcha_150.png
Normal file
BIN
components/captcha/images/tcaptcha_150.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 2.0 KiB |
BIN
components/captcha/images/tcaptcha_200.png
Normal file
BIN
components/captcha/images/tcaptcha_200.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 2.8 KiB |
149
components/captcha/images/tcaptcha_200.svg
Normal file
149
components/captcha/images/tcaptcha_200.svg
Normal file
@ -0,0 +1,149 @@
|
||||
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
|
||||
<svg
|
||||
width="32"
|
||||
height="32"
|
||||
id="svg2"
|
||||
sodipodi:version="0.32"
|
||||
inkscape:version="1.1 (c68e22c387, 2021-05-23)"
|
||||
version="1.0"
|
||||
sodipodi:docname="tcaptcha_200.svg"
|
||||
inkscape:output_extension="org.inkscape.output.svg.inkscape"
|
||||
inkscape:export-filename="D:\Prog_Lazarus\wp-git\Captcha_Component\images\tcaptcha_200.png"
|
||||
inkscape:export-xdpi="144"
|
||||
inkscape:export-ydpi="144"
|
||||
xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
|
||||
xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
|
||||
xmlns="http://www.w3.org/2000/svg"
|
||||
xmlns:svg="http://www.w3.org/2000/svg"
|
||||
xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
|
||||
xmlns:cc="http://creativecommons.org/ns#"
|
||||
xmlns:dc="http://purl.org/dc/elements/1.1/">
|
||||
<defs
|
||||
id="defs4" />
|
||||
<sodipodi:namedview
|
||||
id="base"
|
||||
pagecolor="#ffffff"
|
||||
bordercolor="#666666"
|
||||
borderopacity="1.0"
|
||||
inkscape:pageopacity="0.0"
|
||||
inkscape:pageshadow="2"
|
||||
inkscape:zoom="22.283453"
|
||||
inkscape:cx="19.498774"
|
||||
inkscape:cy="15.661846"
|
||||
inkscape:document-units="px"
|
||||
inkscape:current-layer="layer1"
|
||||
showgrid="true"
|
||||
objecttolerance="10"
|
||||
gridtolerance="10"
|
||||
guidetolerance="10"
|
||||
showguides="true"
|
||||
inkscape:guide-bbox="true"
|
||||
inkscape:window-width="2560"
|
||||
inkscape:window-height="1017"
|
||||
inkscape:window-x="-8"
|
||||
inkscape:window-y="-8"
|
||||
inkscape:window-maximized="1"
|
||||
inkscape:snap-bbox="true"
|
||||
inkscape:bbox-paths="true"
|
||||
inkscape:bbox-nodes="true"
|
||||
inkscape:snap-bbox-edge-midpoints="true"
|
||||
inkscape:snap-bbox-midpoints="true"
|
||||
inkscape:object-paths="true"
|
||||
inkscape:snap-intersection-paths="true"
|
||||
inkscape:snap-smooth-nodes="true"
|
||||
inkscape:snap-midpoints="true"
|
||||
inkscape:snap-object-midpoints="true"
|
||||
inkscape:document-rotation="0"
|
||||
inkscape:pagecheckerboard="0">
|
||||
<inkscape:grid
|
||||
type="xygrid"
|
||||
id="grid2409"
|
||||
visible="true"
|
||||
enabled="true"
|
||||
spacingx="0.5"
|
||||
spacingy="0.5"
|
||||
empspacing="2"
|
||||
snapvisiblegridlinesonly="true"
|
||||
originx="0"
|
||||
originy="0" />
|
||||
</sodipodi:namedview>
|
||||
<metadata
|
||||
id="metadata7">
|
||||
<rdf:RDF>
|
||||
<cc:Work
|
||||
rdf:about="">
|
||||
<dc:format>image/svg+xml</dc:format>
|
||||
<dc:type
|
||||
rdf:resource="http://purl.org/dc/dcmitype/StillImage" />
|
||||
<dc:title />
|
||||
</cc:Work>
|
||||
</rdf:RDF>
|
||||
</metadata>
|
||||
<g
|
||||
inkscape:label="Ebene 1"
|
||||
inkscape:groupmode="layer"
|
||||
id="layer1">
|
||||
<path
|
||||
style="opacity:1;fill:#ffffff;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:1;stroke-linecap:square;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal"
|
||||
d="m 23.778199,13.878703 -8.485283,8.485282 H 12.464442 L 8.2218252,18.121319 16.707106,9.636038 h 2.82843 z"
|
||||
id="rect875"
|
||||
inkscape:connector-curvature="0"
|
||||
sodipodi:nodetypes="ccccccc" />
|
||||
<rect
|
||||
style="opacity:0.9;fill:#000000;stroke-width:1.99937;stroke-linecap:round;stroke-linejoin:round;paint-order:markers fill stroke"
|
||||
id="rect853"
|
||||
width="28"
|
||||
height="28"
|
||||
x="2"
|
||||
y="2"
|
||||
rx="6121.7002"
|
||||
ry="0" />
|
||||
<text
|
||||
xml:space="preserve"
|
||||
style="font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;font-size:16px;line-height:1.25;font-family:sans-serif;-inkscape-font-specification:'sans-serif, Normal';font-variant-ligatures:normal;font-variant-caps:normal;font-variant-numeric:normal;font-variant-east-asian:normal;fill:#000000;fill-opacity:1;stroke:none;stroke-width:0.372304"
|
||||
x="-3.9211442"
|
||||
y="18.060839"
|
||||
id="text857"
|
||||
transform="rotate(-22.87353)"><tspan
|
||||
sodipodi:role="line"
|
||||
id="tspan855"
|
||||
x="-3.9211442"
|
||||
y="18.060839"
|
||||
style="font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;font-size:16px;font-family:sans-serif;-inkscape-font-specification:'sans-serif, Normal';font-variant-ligatures:normal;font-variant-caps:normal;font-variant-numeric:normal;font-variant-east-asian:normal;fill:#ffff00;stroke-width:0.372304">a</tspan></text>
|
||||
<text
|
||||
xml:space="preserve"
|
||||
style="font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;font-size:16px;line-height:1.25;font-family:sans-serif;-inkscape-font-specification:'sans-serif, Normal';font-variant-ligatures:normal;font-variant-caps:normal;font-variant-numeric:normal;font-variant-east-asian:normal;fill:#000000;fill-opacity:1;stroke:none;stroke-width:0.462961"
|
||||
x="21.717392"
|
||||
y="8.9995241"
|
||||
id="text861"
|
||||
transform="rotate(14.80282)"><tspan
|
||||
sodipodi:role="line"
|
||||
id="tspan859"
|
||||
x="21.717392"
|
||||
y="8.9995241"
|
||||
style="font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;font-size:16px;font-family:sans-serif;-inkscape-font-specification:'sans-serif, Normal';font-variant-ligatures:normal;font-variant-caps:normal;font-variant-numeric:normal;font-variant-east-asian:normal;fill:#ff0000;stroke-width:0.462961">5</tspan></text>
|
||||
<text
|
||||
xml:space="preserve"
|
||||
style="font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;font-size:16px;line-height:1.25;font-family:sans-serif;-inkscape-font-specification:'sans-serif, Normal';font-variant-ligatures:normal;font-variant-caps:normal;font-variant-numeric:normal;font-variant-east-asian:normal;fill:#ff00ff;fill-opacity:1;stroke:none;stroke-width:0.382719"
|
||||
x="9.09375"
|
||||
y="29.832031"
|
||||
id="text865"><tspan
|
||||
sodipodi:role="line"
|
||||
id="tspan863"
|
||||
x="9.09375"
|
||||
y="29.832031"
|
||||
style="font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;font-size:16px;font-family:sans-serif;-inkscape-font-specification:'sans-serif, Normal';font-variant-ligatures:normal;font-variant-caps:normal;font-variant-numeric:normal;font-variant-east-asian:normal;fill:#ff00ff;stroke-width:0.382719">M</tspan></text>
|
||||
<path
|
||||
style="fill:#00ff00;stroke:#00ffff;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
|
||||
d="m 3,6 26,8"
|
||||
id="path867" />
|
||||
<path
|
||||
style="fill:none;stroke:#00ff00;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
|
||||
d="M 6,28 29,22"
|
||||
id="path869" />
|
||||
<path
|
||||
style="fill:none;stroke:#ffaaaa;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
|
||||
d="M 10,3 29,27"
|
||||
id="path871" />
|
||||
</g>
|
||||
</svg>
|
||||
|
After Width: | Height: | Size: 6.6 KiB |
BIN
components/captcha/source/captcha_images.res
Normal file
BIN
components/captcha/source/captcha_images.res
Normal file
Binary file not shown.
674
components/captcha/source/captchactrl.pas
Normal file
674
components/captcha/source/captchactrl.pas
Normal file
@ -0,0 +1,674 @@
|
||||
{@@ ----------------------------------------------------------------------------
|
||||
This unit implements a CAPTCHA component for Lazarus.
|
||||
|
||||
AUTHOR: Werner Pamler
|
||||
|
||||
LICENSE: LGPL with linking exception (like Lazarus LCL)
|
||||
See the file COPYING.modifiedLGPL.txt, included in the Lazarus
|
||||
distribution, for details about the license.
|
||||
-------------------------------------------------------------------------------}
|
||||
|
||||
unit CaptchaCtrl;
|
||||
|
||||
{$mode OBJFPC}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Graphics, Controls;
|
||||
|
||||
type
|
||||
TCaptchaChar = record
|
||||
Character: String; // Character (must be a string for UTF8)
|
||||
Angle: Integer; // Rotation angle of character, in degrees
|
||||
Position: TPoint; // Position of character within buffer bitmap (for TextOut)
|
||||
FontIndex: Integer; // Index of font to be used
|
||||
Color: TColor; // Random color of the character
|
||||
end;
|
||||
TCaptchaCharArray = array of TCaptchaChar;
|
||||
|
||||
TCaptchaLine = record
|
||||
StartPt: TPoint; // Random start point of the line
|
||||
EndPt: TPoint; // Random end point of the line
|
||||
Color: TColor; // Random line color
|
||||
end;
|
||||
TCaptchaLineArray = array of TCaptchaLine;
|
||||
|
||||
TCaptchaOption = (
|
||||
coAlphaUpper, coAlphaLower, coNumeric, coCustom,
|
||||
coRotated, coFont1, coFont2, coLines
|
||||
);
|
||||
TCaptchaOptions = set of TCaptchaOption;
|
||||
TCaptchaCharsOption = coAlphaUpper..coCustom;
|
||||
|
||||
TNewCaptchaEvent = (nceNone, nceClick, nceDblClick);
|
||||
|
||||
const
|
||||
DEFAULT_CAPTCHA_OPTIONS = [
|
||||
coAlphaUpper, coAlphaLower, coNumeric, coCustom,
|
||||
coRotated, coFont1, coFont2, coLines
|
||||
];
|
||||
DEFAULT_CAPTCHA_NUMCHARS = 10;
|
||||
DEFAULT_CAPTCHA_NUMLINES = 30;
|
||||
|
||||
type
|
||||
TCaptcha = class(TGraphicControl)
|
||||
private
|
||||
FBuffer: TBitmap;
|
||||
FCaptchaChars: TCaptchaCharArray;
|
||||
FCaptchaLines: TCaptchaLineArray;
|
||||
FValidChars: array[TCaptchaCharsOption] of string;
|
||||
FFonts: array[0..1] of TFont;
|
||||
FInitialized: Boolean;
|
||||
FMaxAngle: Integer;
|
||||
FNewCaptchaEvent: TNewCaptchaEvent;
|
||||
FNumChars: Integer;
|
||||
FNumLines: Integer;
|
||||
FOptions: TCaptchaOptions;
|
||||
function GetCaptchaText: String;
|
||||
function GetFont(AIndex: Integer): TFont;
|
||||
function GetValidChars(AIndex: Integer): String;
|
||||
procedure SetFont(AIndex: Integer; const AValue: TFont);
|
||||
procedure SetMaxAngle(const AValue: Integer);
|
||||
procedure SetNumChars(const AValue: Integer);
|
||||
procedure SetNumLines(const AValue: Integer);
|
||||
procedure SetOptions(const AValue: TCaptchaOptions);
|
||||
procedure SetValidChars(AIndex: Integer; const AValue: String);
|
||||
protected
|
||||
function AlmostBackgroundColor(AColor: TColor): Boolean;
|
||||
procedure CreateNewCaptcha(ANumChars, ANumLines: Integer; KeepText,KeepLines: Boolean);
|
||||
procedure DrawBuffer;
|
||||
procedure InitAngles;
|
||||
procedure InitCharPos(KeepVertPos: boolean);
|
||||
procedure InitFontIndex;
|
||||
procedure InitLineColors;
|
||||
procedure InitLines(ACount: Integer; KeepExisting: Boolean);
|
||||
procedure InitText(ACount: Integer; KeepExisting: Boolean);
|
||||
procedure InitTextColors;
|
||||
protected
|
||||
procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;
|
||||
WithThemeSpace: Boolean); override;
|
||||
procedure Click; override;
|
||||
procedure DblClick; override;
|
||||
procedure Paint; override;
|
||||
procedure Resize; override;
|
||||
procedure SetColor(AValue: TColor); override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure NewCaptcha;
|
||||
function Verify(const AText: String): Boolean;
|
||||
property Text: String read GetCaptchaText;
|
||||
published
|
||||
property CustomChars: String index ord(coCustom) read GetValidChars write SetValidChars;
|
||||
property Font1: TFont index 0 read GetFont write SetFont;
|
||||
property Font2: TFont index 1 read GetFont write SetFont;
|
||||
property Options: TCaptchaOptions read FOptions write SetOptions default DEFAULT_CAPTCHA_OPTIONS;
|
||||
property LowercaseChars: String index ord(coAlphaLower) read GetValidChars write SetValidChars;
|
||||
property MaxAngle: Integer read FMaxAngle write SetMaxAngle default 60;
|
||||
property NumericChars: String index ord(coNumeric) read GetValidChars write SetValidChars;
|
||||
property NewCaptchaEvent: TNewCaptchaEvent read FNewCaptchaEvent write FNewCaptchaEvent default nceNone;
|
||||
property NumChars: Integer read FNumChars write SetNumChars default DEFAULT_CAPTCHA_NUMCHARS;
|
||||
property NumLines: Integer read FNumLines write SetNumLines default DEFAULT_CAPTCHA_NUMLINES;
|
||||
property UppercaseChars: String index ord(coAlphaUpper) read GetValidChars write SetValidChars;
|
||||
|
||||
property Align;
|
||||
property AutoSize default true;
|
||||
property BorderSpacing;
|
||||
property Color default clBlack;
|
||||
property OnClick;
|
||||
property OnDblClick;
|
||||
property OnMouseDown;
|
||||
property OnMouseEnter;
|
||||
property OnMouseLeave;
|
||||
property OnMouseUp;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
{$R captcha_images.res}
|
||||
|
||||
uses
|
||||
LCLIntf, Types, GraphUtil, Math, LazUTF8;
|
||||
|
||||
{ Component registration }
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('Misc', [TCaptcha]);
|
||||
end;
|
||||
|
||||
|
||||
{ Utility functions }
|
||||
|
||||
function RotatePoint(const APoint: TPoint; Angle: Double): TPoint;
|
||||
var
|
||||
sinphi, cosphi: Double;
|
||||
begin
|
||||
Angle := DegToRad(Angle);
|
||||
SinCos(angle, sinphi, cosphi);
|
||||
Result.X := Round( cosphi * APoint.X + sinphi * APoint.Y);
|
||||
Result.Y := Round(-sinphi * APoint.X + cosphi * APoint.Y);
|
||||
end;
|
||||
|
||||
function RotateRect(const Width, Height: Integer; Angle: Double): TRect;
|
||||
var
|
||||
P0, P1, P2, P3: TPoint;
|
||||
begin
|
||||
P0 := Point(0, 0);
|
||||
P1 := RotatePoint(Point(0, Height), Angle);
|
||||
P2 := RotatePoint(Point(Width, 0), Angle);
|
||||
P3 := RotatePoint(Point(Width, Height), Angle);
|
||||
Result.Left := MinValue([P0.X, P1.X, P2.X, P3.X]);
|
||||
Result.Top := MinValue([P0.Y, P1.Y, P2.Y, P3.Y]);
|
||||
Result.Right := MaxValue([P0.X, P1.X, P2.X, P3.X]);
|
||||
Result.Bottom := MaxValue([P0.Y, P1.Y, P2.Y, P3.Y]);
|
||||
end;
|
||||
|
||||
|
||||
{ TCaptcha }
|
||||
|
||||
constructor TCaptcha.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
with GetControlClassDefaultSize do
|
||||
SetInitialBounds(0, 0, 300, 100);
|
||||
AutoSize := true;
|
||||
Color := clBlack;
|
||||
|
||||
FBuffer := TBitmap.Create;
|
||||
FBuffer.PixelFormat := pf32bit;
|
||||
|
||||
FFonts[0] := TFont.Create;
|
||||
FFonts[0].Size := 36;
|
||||
|
||||
FFonts[1] := TFont.Create;
|
||||
{$IF DEFINED(MSWindows)}
|
||||
FFonts[1].Name := 'Courier New';
|
||||
{$ELSEIF DEFINED(Linux)}
|
||||
FFonts[1].Name := 'FreeMono';
|
||||
{$ELSEIF DEFINED(Darwin)}
|
||||
Fronts[1].Name := 'Courier';
|
||||
{$IFEND}
|
||||
FFonts[1].Size := 36;
|
||||
|
||||
FOptions := DEFAULT_CAPTCHA_OPTIONS;
|
||||
FMaxAngle := 60;
|
||||
FNumChars := DEFAULT_CAPTCHA_NUMCHARS;
|
||||
FNumLines := DEFAULT_CAPTCHA_NUMLINES;
|
||||
FValidChars[coAlphaUpper] := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
|
||||
FValidChars[coAlphaLower] := 'abcdefghijklmnopqrstuvwxyz';
|
||||
FValidChars[coNumeric] := '0123456789';
|
||||
FValidChars[coCustom] := '';
|
||||
FInitialized := false;
|
||||
|
||||
// Do not call Randomize at runtime to facilitate debugging.
|
||||
if (csDesigning in ComponentState) then
|
||||
Randomize;
|
||||
end;
|
||||
|
||||
destructor TCaptcha.Destroy;
|
||||
begin
|
||||
Finalize(FCaptchaChars);
|
||||
Finalize(FCaptchaLines);
|
||||
FreeAndNil(FFonts[0]);
|
||||
FreeAndNil(FFonts[1]);
|
||||
FreeAndNil(FBuffer);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TCaptcha.AlmostBackgroundColor(AColor: TColor): Boolean;
|
||||
const
|
||||
TOLERANCE = 64;
|
||||
var
|
||||
colorH, colorL, colorS: Byte;
|
||||
bgColorH, bgColorL, bgColorS: Byte;
|
||||
begin
|
||||
ColorToHLS(ColorToRGB(AColor), colorH, colorL, colorS);
|
||||
ColorToHLS(ColorToRGB(Self.Color), bgColorH, bgColorL, bgColorS);
|
||||
Result := abs(colorL - bgColorL) < TOLERANCE;
|
||||
end;
|
||||
|
||||
procedure TCaptcha.CalculatePreferredSize(
|
||||
var PreferredWidth, PreferredHeight: integer;
|
||||
WithThemeSpace: Boolean);
|
||||
begin
|
||||
inherited;
|
||||
|
||||
CreateNewCaptcha(FNumChars, FNumLines, true, true);
|
||||
|
||||
PreferredWidth := FBuffer.Width;
|
||||
PreferredHeight := 0;
|
||||
if (coFont1 in FOptions) then
|
||||
begin
|
||||
FBuffer.Canvas.Font.Assign(FFonts[0]);
|
||||
PreferredHeight := FBuffer.Canvas.TextHeight('Tg');
|
||||
end;
|
||||
if (coFont2 in FOptions) then
|
||||
begin
|
||||
FBuffer.Canvas.Font.Assign(FFonts[1]);
|
||||
PreferredHeight := Max(PreferredHeight, FBuffer.Canvas.TextHeight('Tg'));
|
||||
end;
|
||||
PreferredHeight := 3*PreferredHeight div 2;
|
||||
end;
|
||||
|
||||
procedure TCaptcha.Click;
|
||||
begin
|
||||
inherited;
|
||||
if FNewCaptchaEvent = nceClick then
|
||||
NewCaptcha;
|
||||
end;
|
||||
|
||||
procedure TCaptcha.CreateNewCaptcha(ANumChars, ANumLines: Integer;
|
||||
KeepText, KeepLines: Boolean);
|
||||
begin
|
||||
if not KeepText then
|
||||
FCaptchaChars := nil;
|
||||
FCaptchaLines := nil;
|
||||
InitText(ANumChars, KeepText);
|
||||
InitTextColors; // after InitText
|
||||
InitAngles;
|
||||
InitCharPos(false);
|
||||
InitLines(ANumLines, KeepLines); // after InitCharPos
|
||||
InitLineColors; // after InitLines
|
||||
DrawBuffer;
|
||||
end;
|
||||
|
||||
procedure TCaptcha.DblClick;
|
||||
begin
|
||||
inherited;
|
||||
if FNewCaptchaEvent = nceDblClick then
|
||||
NewCaptcha;
|
||||
end;
|
||||
|
||||
procedure TCaptcha.DrawBuffer;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if not Assigned(FBuffer) then
|
||||
exit;
|
||||
|
||||
// Fill the buffer background in the requested color.
|
||||
FBuffer.Canvas.Brush.Color := Self.Color;
|
||||
FBuffer.Canvas.Brush.Style := bsSolid;
|
||||
FBuffer.Canvas.FillRect(0, 0, FBuffer.Width, FBuffer.Height);
|
||||
|
||||
// Draw the captcha characters to the buffer bitmap
|
||||
if (FOptions * [coAlphaUpper, coAlphaLower, coNumeric, coCustom] <> []) and
|
||||
(FOptions * [coFont1, coFont2] <> []) then
|
||||
begin
|
||||
FBuffer.Canvas.Brush.Style := bsClear;
|
||||
for i := 0 to High(FCaptchaChars) do
|
||||
with FCaptchaChars[i] do
|
||||
begin
|
||||
FBuffer.Canvas.Font.Assign(FFonts[FontIndex]);
|
||||
FBuffer.Canvas.Font.Color := Color;
|
||||
if coRotated in FOptions then
|
||||
FBuffer.Canvas.Font.Orientation := Angle * 10
|
||||
else
|
||||
FBuffer.Canvas.Font.Orientation := 0;
|
||||
FBuffer.Canvas.TextOut(Position.X, Position.Y, Character);
|
||||
end;
|
||||
end;
|
||||
|
||||
// Draw the captcha lines
|
||||
if coLines in FOptions then
|
||||
begin
|
||||
for i := 0 to High(FCaptchaLines) do
|
||||
with FCaptchaLines[i] do
|
||||
begin
|
||||
FBuffer.Canvas.Pen.Color := Color;
|
||||
FBuffer.Canvas.Line(StartPt.X, StartPt.Y, EndPt.X, EndPt.Y);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCaptcha.GetFont(AIndex: Integer): TFont;
|
||||
begin
|
||||
Result := FFonts[AIndex];
|
||||
end;
|
||||
|
||||
function TCaptcha.GetCaptchaText: string;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result := '';
|
||||
for i := 0 to High(FCaptchaChars) do
|
||||
Result := Result + FCaptchaChars[i].Character;
|
||||
end;
|
||||
|
||||
function TCaptcha.GetValidChars(AIndex: Integer): String;
|
||||
begin
|
||||
Result := FValidChars[TCaptchaCharsOption(AIndex)];
|
||||
end;
|
||||
|
||||
procedure TCaptcha.InitAngles;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to High(FCaptchaChars) do
|
||||
FCaptchaChars[i].Angle := Random(FMaxAngle*2) - FMaxAngle;
|
||||
end;
|
||||
|
||||
{ Calculates the character positions and stores them in the ChaptchaChars array
|
||||
When KeepVertPos is false, the vertical position of the characters is selected
|
||||
randomly within the height of the control. Otherwise the already stored
|
||||
vertical positions are used. }
|
||||
procedure TCaptcha.InitCharPos(KeepVertPos: Boolean);
|
||||
var
|
||||
x: Integer;
|
||||
i: Integer;
|
||||
R: TRect;
|
||||
ext: TSize;
|
||||
w, h: Integer;
|
||||
fnt: TFont;
|
||||
maxHeight: Integer;
|
||||
begin
|
||||
maxHeight := 0;
|
||||
x := 0;
|
||||
for i := 0 to High(FCaptchaChars) do
|
||||
begin
|
||||
// Set character font
|
||||
fnt := FFonts[FCaptchaChars[i].FontIndex];
|
||||
FBuffer.Canvas.Font.Assign(fnt);
|
||||
|
||||
// Get character size
|
||||
ext := FBuffer.Canvas.TextExtent(FCaptchaChars[i].Character);
|
||||
|
||||
// Rotate the character and get the bounds of the enclosing rectangle.
|
||||
// The rotation occurs around the upper left corner of the character.
|
||||
if coRotated in FOptions then
|
||||
R := RotateRect(ext.CX, ext.CY, FCaptchaChars[i].Angle)
|
||||
else
|
||||
// unrotated: add some extra space for better legibility
|
||||
R := Rect(0, 0, ext.CX * 6 div 5, ext.CY);
|
||||
w := R.Right - R.Left;
|
||||
h := R.Bottom - R.Top;
|
||||
|
||||
// Horizontal drawing coordinate
|
||||
FCaptchaChars[i].Position.X := x - R.Left;
|
||||
|
||||
// Vertical drawing coordinate: randomly inside control
|
||||
if not KeepVertPos then
|
||||
begin
|
||||
if Self.Height > h then
|
||||
FCaptchaChars[i].Position.Y := Max(0, Random(Height - h) - R.Top)
|
||||
else
|
||||
FCaptchaChars[i].Position.Y := 0;
|
||||
end;
|
||||
|
||||
// Find max y coordinate needed to enclose the entire text
|
||||
maxHeight := Max(maxHeight, FCaptchaChars[i].Position.Y + h);
|
||||
// Next drawing position
|
||||
x := x + w;
|
||||
end;
|
||||
|
||||
// Set size of the bitmap buffer so that the entire captcha is enclosed.
|
||||
FBuffer.SetSize(x, maxHeight);
|
||||
end;
|
||||
|
||||
procedure TCaptcha.InitFontIndex;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if FOptions * [coFont1, coFont2] = [coFont1] then
|
||||
for i := 0 to High(FCaptchaChars) do
|
||||
FCaptchaChars[i].FontIndex := 0
|
||||
else
|
||||
if FOptions * [coFont1, coFont2] = [coFont2] then
|
||||
for i := 0 to High(FCaptchaChars) do
|
||||
FCaptchaChars[i].FontIndex := 1
|
||||
else
|
||||
for i := 0 to High(FCaptchaChars) do
|
||||
FCaptchaChars[i].FontIndex := Random(2);
|
||||
end;
|
||||
|
||||
{ Pick random color for a line.
|
||||
Make sure that the color is not too close to the background color. }
|
||||
procedure TCaptcha.InitLineColors;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
// Line colors
|
||||
if (FOptions * [coLines] <> []) then
|
||||
for i := 0 to High(FCaptchaLines) do
|
||||
repeat
|
||||
FCaptchaLines[i].Color := TColor(Random($FFFFFF));
|
||||
until not AlmostBackgroundColor(FCaptchaLines[i].Color);
|
||||
end;
|
||||
|
||||
procedure TCaptcha.InitLines(ACount: Integer; KeepExisting: Boolean);
|
||||
var
|
||||
i, n: Integer;
|
||||
begin
|
||||
if coLines in FOptions then
|
||||
begin
|
||||
if KeepExisting then
|
||||
n := Length(FCaptchaLines)
|
||||
else
|
||||
n := 0;
|
||||
SetLength(FCaptchaLines, ACount);
|
||||
for i := n to High(FCaptchaLines) do
|
||||
begin
|
||||
// Select random start and end points
|
||||
FCaptchaLines[i].StartPt := Point(
|
||||
Random(FBuffer.Width),
|
||||
Random(FBuffer.Height)
|
||||
);
|
||||
FCaptchaLines[i].EndPt := Point(
|
||||
Random(FBuffer.Width),
|
||||
Random(FBuffer.Height)
|
||||
);
|
||||
|
||||
// Select random line color
|
||||
repeat
|
||||
FCaptchaLines[i].Color := TColor(Random($FFFFFF));
|
||||
until not AlmostBackgroundColor(FCaptchaLines[i].Color);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCaptcha.InitText(ACount: Integer; KeepExisting: Boolean);
|
||||
var
|
||||
i, j, n: Integer;
|
||||
ok: Boolean;
|
||||
validChars: String;
|
||||
co: TCaptchaCharsOption;
|
||||
begin
|
||||
if (FOptions * [coAlphaUpper, coAlphaLower, coNumeric, coCustom] <> []) and
|
||||
(FOptions * [coFont1, coFont2] <> []) then
|
||||
begin
|
||||
// Prepare character list for captcha
|
||||
validChars := '';
|
||||
for co in TCaptchaCharsOption do
|
||||
if co in FOptions then
|
||||
validChars := validChars + FValidChars[co];;
|
||||
// Remove characters which are hard to distinguish
|
||||
if FOptions * [coAlphaUpper, coAlphaLower] = [coAlphaUpper, coAlphaLower] then
|
||||
begin
|
||||
i := Pos('I', validChars); // Remove upper-case I
|
||||
if i > 0 then Delete(validChars, i, 1);
|
||||
i := Pos('l', validChars); // Remove lower-case L
|
||||
if i > 0 then Delete(validChars, i, 1);
|
||||
end;
|
||||
if FOptions * [coAlphaUpper, coNumeric] = [coAlphaUpper, coNumeric] then
|
||||
begin
|
||||
i := Pos('O', validChars); // Remove upper-case O
|
||||
if i > 0 then Delete(validChars, i, 1);
|
||||
i := Pos('0', validChars); // Remove number zero
|
||||
if i > 0 then Delete(validChars, i, 1);
|
||||
end;
|
||||
|
||||
if KeepExisting then
|
||||
n := Length(FCaptchaChars)
|
||||
else
|
||||
n := 0;
|
||||
// Get random captcha characters, but keep previously assigned chars.
|
||||
SetLength(FCaptchaChars, ACount);
|
||||
for i := n to High(FCaptchaChars) do
|
||||
begin
|
||||
// Pick random character from the validChars. Take care of UTF8.
|
||||
FCaptchaChars[i].Character := UTF8Copy(validChars, random(UTF8Length(validChars)) + 1, 1);
|
||||
|
||||
// Pick one of the fonts
|
||||
if FOptions * [coFont1, coFont2] = [coFont1] then
|
||||
FCaptchaChars[i].FontIndex := 1
|
||||
else
|
||||
if FOptions * [coFont1, coFont2] = [coFont2] then
|
||||
FCaptchaChars[i].FontIndex := 2
|
||||
else
|
||||
FCaptchaChars[i].FontIndex := Random(2);
|
||||
|
||||
if KeepExisting then
|
||||
begin
|
||||
// Set random text color
|
||||
repeat
|
||||
FCaptchaChars[i].Color := TColor(Random($FFFFFF));
|
||||
until not AlmostbackgroundColor(FCaptchaChars[i].Color);
|
||||
|
||||
// Set random rotation angle
|
||||
if (coRotated in FOptions) then
|
||||
FCaptchaChars[i].Angle := Random(FMaxAngle*2) - FMaxAngle;
|
||||
end;
|
||||
end;
|
||||
end else
|
||||
SetLength(FCaptchaChars, 0);
|
||||
end;
|
||||
|
||||
{ Pick random color for a character.
|
||||
Make sure that the color is not too close to the background color. }
|
||||
procedure TCaptcha.InitTextColors;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
// Character colors
|
||||
if (FOptions * [coAlphaUpper, coAlphaLower, coNumeric, coCustom] <> []) then
|
||||
for i := 0 to High(FCaptchaChars) do
|
||||
repeat
|
||||
FCaptchaChars[i].Color := TColor(Random($FFFFFF));
|
||||
until not AlmostbackgroundColor(FCaptchaChars[i].Color);
|
||||
end;
|
||||
|
||||
procedure TCaptcha.NewCaptcha;
|
||||
begin
|
||||
CreateNewCaptcha(FNumChars, FNumLines, false, false);
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TCaptcha.Paint;
|
||||
begin
|
||||
Canvas.Draw((Width - FBuffer.Width) div 2, (Height - FBuffer.Height) div 2, FBuffer);
|
||||
end;
|
||||
|
||||
procedure TCaptcha.Resize;
|
||||
begin
|
||||
inherited;
|
||||
if Assigned(FBuffer) and not FInitialized then
|
||||
begin
|
||||
CreateNewCaptcha(FNumChars, FNumLines, false, false);
|
||||
FInitialized := true;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCaptcha.SetColor(AValue: TColor);
|
||||
begin
|
||||
if AValue = Color then
|
||||
exit;
|
||||
inherited SetColor(AValue);
|
||||
InitTextColors;
|
||||
InitLineColors;
|
||||
DrawBuffer;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TCaptcha.SetFont(AIndex: Integer; const AValue: TFont);
|
||||
begin
|
||||
if FFonts[AIndex].IsEqual(AValue) then
|
||||
exit;
|
||||
FFonts[AIndex].Assign(AValue);
|
||||
InitFontIndex;
|
||||
InitCharPos(true);
|
||||
DrawBuffer;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TCaptcha.SetMaxAngle(const AValue: Integer);
|
||||
begin
|
||||
if AValue = FMaxAngle then
|
||||
exit;
|
||||
FMaxAngle := AValue;
|
||||
InitAngles;
|
||||
InitCharPos(true);
|
||||
DrawBuffer;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TCaptcha.SetNumChars(const AValue: Integer);
|
||||
begin
|
||||
if AValue = FNumChars then
|
||||
exit;
|
||||
FNumChars := AValue;
|
||||
InitText(FNumChars, true);
|
||||
InitAngles;
|
||||
InitCharPos(false);
|
||||
InitLines(FNumLines, false);
|
||||
DrawBuffer;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TCaptcha.SetNumLines(const AValue: Integer);
|
||||
begin
|
||||
if AValue = FNumLines then
|
||||
exit;
|
||||
FNumLines := AValue;
|
||||
InitLines(FNumLines, true);
|
||||
DrawBuffer;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TCaptcha.SetOptions(const AValue: TCaptchaOptions);
|
||||
var
|
||||
oldOptions: TCaptchaOptions;
|
||||
begin
|
||||
if AValue = FOptions then
|
||||
exit;
|
||||
oldOptions := FOptions;
|
||||
FOptions := AValue;
|
||||
if (oldOptions * [coAlphaUpper, coAlphaLower, coNumeric, coCustom] <>
|
||||
AValue * [coAlphaUpper, coAlphaLower, coNumeric, coCustom])
|
||||
then
|
||||
InitText(FNumChars, false);
|
||||
if (oldOptions * [coFont1, coFont2] <> AValue * [coFont1, coFont2]) then
|
||||
begin
|
||||
InitFontIndex;
|
||||
InitCharPos(false);
|
||||
end;
|
||||
if (oldOptions * [coRotated] <> AValue * [coRotated]) then
|
||||
begin
|
||||
InitAngles;
|
||||
InitCharPos(true);
|
||||
end;
|
||||
if oldOptions * [coLines] <> AValue * [coLines] then
|
||||
InitLines(FNumLines, true);
|
||||
DrawBuffer;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TCaptcha.SetValidChars(AIndex: Integer; const AValue: String);
|
||||
begin
|
||||
if FValidChars[TCaptchaCharsOption(AIndex)] = AValue then
|
||||
exit;
|
||||
FValidChars[TCaptchaCharsOption(AIndex)] := AValue;
|
||||
NewCaptcha;
|
||||
end;
|
||||
|
||||
|
||||
function TCaptcha.Verify(const AText: String): Boolean;
|
||||
begin
|
||||
Result := (AText = GetCaptchaText);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user