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 := TCaptchaLabel.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.