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