captcha: Initial commit

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8111 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2021-10-01 17:02:14 +00:00
parent 97d465e2b3
commit 0e5f075b8b
15 changed files with 1671 additions and 0 deletions
--- a/components/captcha/demo_runtime/main.pas
+++ b/components/captcha/demo_runtime/main.pas
@ -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.
+