delphi7生成简单的验证识别码

delphi7生成简单的验证识别码 

URL: http://www.2ccc.com/article.asp?articleid=6505

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    btn1: TButton;
    Edit1: TEdit;
    Image1: TImage;
    cbb1: TComboBox;
    cbb2: TComboBox;
    lbl1: TLabel;
    Label1: TLabel;
    lbl2: TLabel;
    lbl3: TLabel;
    edt1: TEdit;
    procedure btn1Click(Sender: TObject);
    function PwdImg(img: Timage; ID: Byte; fontsID: Word; fontsize: Byte): string;
    procedure FormCreate(Sender: TObject);
    procedure edt1KeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btn1Click(Sender: TObject);
var sr: string;
begin
  Sr := PwdImg(Image1, cbb1.ItemIndex, cbb2.ItemIndex, StrToInt(edt1.Text));
  Edit1.Text := Sr;
end;

function TForm1.PwdImg(img: Timage; ID: Byte; fontsID: Word; fontsize: Byte): string;
var
  I, j, k: Integer;
  vPoint: TPoint;
  vLeft: Integer;
  //arrStr:array[1..36]of string ;
  arrStr: string;
  arrStr1: string[10];
  arrStr2: string[26];
  strResult: string;
begin
  strResult := '';
  arrStr1 := '0123456789';
  arrStr2 := 'ABCDEFGHIJKLMNOPQRST';
  case ID of
    0: //只有数字
      begin
        arrStr := arrStr1;
      end;
    1: //只有大写字母
      begin
        arrStr := UpperCase(arrStr2);
      end;
    2: //只有小写字母
      begin
        arrStr := LowerCase(arrStr2);
      end;
    3: //数字+大写字母
      begin
        arrStr := arrStr1 + UpperCase(arrStr2);
      end;
    4: //数字加小写字母
      begin
        arrStr := arrStr1 + LowerCase(arrStr2);
      end;
  else //数字加大小写字母
    begin
      arrStr := arrStr1 + UpperCase(arrStr2) + LowerCase(arrStr2);
    end;
  end;
 
  for j := 1 to 4 do
  begin
    Randomize;
    k := strtoint(Format('%.1d', [Random(Length(arrStr)) + 1]));
 
    strResult := strResult + trim(arrStr[k])
  end;
 
  vLeft := 10;
  img.picture := nil;
  for I := 1 to Length(strResult) do
  begin
    with Img do
    begin
      Randomize;
     // Canvas.Font.Size := Random(10) + 9;
      Canvas.Font.Size := Random(fontsize) + fontsize;
      Canvas.Font.Color := RGB(Random(256) and $C0,
        Random(256) and $C0, Random(256) and $C0);
      //  Canvas.Font.Name:='华文彩云';
      if Random(2) = 1 then
        Canvas.Font.Style := [fsBold]
      else Canvas.Font.Style := [fsItalic];

      begin
        Canvas.Font.Name := Screen.Fonts[fontsID];
        vPoint.X := Random(4) + vLeft;
        vPoint.Y := Random(5);
        Canvas.Brush.Style := bsClear; //文字透明！
        
        Canvas.TextOut(vPoint.X, vPoint.Y, strResult[I]);
        vLeft := vPoint.X + Canvas.TextWidth(strResult[I]);
      end;
    end;
  end;
  Result := strResult;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  cbb1.Clear;
  cbb1.Style := csOwnerDrawFixed;
  cbb1.Items.Add('数字');
  cbb1.Items.Add('大写字母');
  cbb1.Items.Add('小写字母');
  cbb1.Items.Add('数字+大写字母');
  cbb1.Items.Add('数字+小写字母');
  cbb1.Items.Add('数字+大小写字母');
  cbb1.ItemIndex := 0;

//载入字体

  cbb2.Clear;
  cbb2.Style := csOwnerDrawFixed;
  cbb2.Items.AddStrings(Screen.Fonts);
  cbb2.ItemIndex := 0;
  edt1.Text := '20' ;
end;

procedure TForm1.edt1KeyPress(Sender: TObject; var Key: Char);
begin
  SetWindowLong(edt1.Handle, GWL_STYLE,
    ES_NUMBER or GetWindowLong(edt1.Handle, GWL_STYLE))
end;

end.

object Form1: TForm1
  Left = 657
  Top = 500
  Width = 375
  Height = 288
  Caption = #31616#21333#30340#29983#25104#35782#21035#30721
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Image1: TImage
    Left = 32
    Top = 8
    Width = 193
    Height = 105
  end
  object lbl1: TLabel
    Left = 32
    Top = 128
    Width = 48
    Height = 13
    Caption = #36820#22238#25991#23383
  end
  object Label1: TLabel
    Left = 32
    Top = 160
    Width = 48
    Height = 13
    Caption = #26684#24335#36873#25321
  end
  object lbl2: TLabel
    Left = 32
    Top = 192
    Width = 48
    Height = 13
    Caption = #23383#20307#36873#25321
  end
  object lbl3: TLabel
    Left = 176
    Top = 128
    Width = 48
    Height = 13
    Caption = #23383#20307#22823#23567
  end
  object btn1: TButton
    Left = 264
    Top = 24
    Width = 75
    Height = 25
    Caption = #29983#25104#35782#21035#30721
    TabOrder = 0
    OnClick = btn1Click
  end
  object Edit1: TEdit
    Left = 88
    Top = 128
    Width = 73
    Height = 21
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'Tahoma'
    Font.Style = []
    ParentFont = False
    TabOrder = 1
    Text = 'Edit1'
  end
  object cbb1: TComboBox
    Left = 88
    Top = 160
    Width = 169
    Height = 21
    ItemHeight = 13
    TabOrder = 2
    Text = 'cbb1'
  end
  object cbb2: TComboBox
    Left = 88
    Top = 192
    Width = 169
    Height = 21
    ItemHeight = 13
    TabOrder = 3
    Text = 'cbb2'
  end
  object edt1: TEdit
    Left = 232
    Top = 128
    Width = 49
    Height = 21
    TabOrder = 4
    Text = 'edt1'
    OnKeyPress = edt1KeyPress
  end
end