lazarus-ccr/components/captcha/demos/runtime/main.pas

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: TCaptchaLabel;

  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.