验证码生成器（在TImage.Canvas上写字，很好看）

Posted 2020-08-21 朝闻道

  生成验证码的方式有很多种，如下则是比较简单的实现，且运用了正余弦曲线来扭曲验证码字符。    

unit AuthenticodeGenerate;

interface

uses
  SysUtils, Windows, ExtCtrls, Graphics;

function GenerateAuthenticode(const Img: TImage; const Len: Integer = 4): string;

implementation

const
  cCharDigitArrayLen = 6;
  cCharDigitArray      : array[0..cCharDigitArrayLen - 1] of Char = (\'3\', \'4\', \'5\', \'6\', \'7\', \'8\');

  cCharLowerLetterArrayLen = 13;
  cCharLowerLetterArray: array[0..cCharLowerLetterArrayLen - 1] of Char = (\'b\', \'c\', \'e\', \'h\', \'j\', \'k\', \'m\', \'n\', \'s\', \'t\', \'v\', \'w\', \'y\');

  cCharUpperLetterArrayLen = 19;
  cCharUpperLetterArray: array[0..cCharUpperLetterArrayLen - 1] of Char = (\'A\', \'B\', \'C\', \'E\', \'F\', \'G\', \'H\', \'J\', \'K\', \'L\', \'M\', \'N\', \'P\', \'Q\', \'R\', \'S\', \'V\', \'W\', \'Y\');
  
  cArrayTypeNum = 3;

  cFontNameNum = 5;
  cFontNameArray: array[0..cFontNameNum - 1] of string = (\'Arial\', \'Tahoma\', \'宋体\', \'幼圆\', \'微软雅黑\');

function TwistImage(const SrcBmp: TBitmap; XDir: Boolean; MultFactor: Double; Phase: Double; SinTrick: Boolean): TBitmap;
const
  cTwicePi = 6.283185;
var
  BaseAxisLen : Double;
  I, J        : Integer;
  DestX, DestY: Double;
  OldX, OldY  : Integer;
  Color       : TColor;
begin
  Result := TBitmap.Create;
  Result.SetSize(SrcBmp.Width, SrcBmp.Height);

  if XDir then
    BaseAxisLen := Result.Height
  else
    BaseAxisLen := Result.Width;

  for I := 0 to Result.Width - 1 do
  begin
    for J := 0 to Result.Height - 1 do
    begin
      if XDir then
        DestX := (cTwicePi * J) / BaseAxisLen
      else
        DestX := (cTwicePi * I) / BaseAxisLen;

      if SinTrick then
      begin
        DestX := DestX + Phase;
        DestY := Sin(DestX);
      end else
      begin
        DestX := DestX + Phase;
        DestY := Cos(DestX);
      end;

      if XDir then
      begin
        OldX := I + Round(DestY * MultFactor);
        OldY := J;
      end else
      begin
        OldX := I;
        OldY := J + Round(DestY * MultFactor);
      end;

      Color := SrcBmp.Canvas.Pixels[I, J];
      if (OldX >= 0) and (OldX < Result.Width) and (OldY >= 0) and (OldY < Result.Height) then
        Result.Canvas.Pixels[OldX, OldY] := Color;
    end;
  end;
end;

procedure NoiseImage(const Img: TImage);
const
  cNoiseLineNum  = 5;
  cNoisePointNum = 50;
var
  I: Integer;
  X: Integer;
  Y: Integer;
begin
  for I := 0 to cNoiseLineNum - 1 do
  begin
    Img.Canvas.Pen.Style := psSolid;
    
    case Random(3) of
      0: Img.Canvas.Pen.Color := clBlack;
      1: Img.Canvas.Pen.Color := clGray;
    else
      Img.Canvas.Pen.Color := clSilver;
    end;

    X := Random(Img.Width);
    Y := Random(Img.Height);
    Img.Canvas.MoveTo(X, Y);
    Img.Canvas.LineTo(X + Random(Img.Width - X), Y + Random(Img.Height - Y));
  end;

  for I := 0 to cNoisePointNum - 1 do
  begin
    case Random(3) of
      0: Img.Canvas.Pixels[Random(Img.Width), Random(Img.Height)] := clBlack;
      1: Img.Canvas.Pixels[Random(Img.Width), Random(Img.Height)] := clGray;
    else
      Img.Canvas.Pixels[Random(Img.Width), Random(Img.Height)] := clSilver;
    end;
  end;
end;

function GenerateCharacterAuthenticode(const Img: TImage; const Len: Integer = 4): string;
var
  I: Integer;
  V: Char;
  X: Integer;
  Y: Integer;
  L: Integer;
begin
  Result := \'\';

  for I := 0 to Len - 1 do
  begin
    case Random(cArrayTypeNum) of
      0:
        begin
          V := cCharDigitArray[Random(cCharDigitArrayLen)];
          Result := Result + V;
        end;
      1:
        begin
          V := cCharLowerLetterArray[Random(cCharLowerLetterArrayLen)];
          Result := Result + V;
        end;
    else
        begin
          V := cCharUpperLetterArray[Random(cCharUpperLetterArrayLen)];
          Result := Result + V;
        end;
    end;
  end;

  L := 2 + Random(2);
  Img.Picture := nil;

  for I := 0 to Length(Result) - 1 do
  begin
    Img.Canvas.Font.Size := Random(5) + 17;
    Img.Canvas.Font.Color := RGB(Random(256) and $C0, Random(256) and $C0, Random(256) and $C0);
    case Random(3) of
      0: Img.Canvas.Font.Style := [fsBold];
      1: Img.Canvas.Font.Style := [fsItalic];
    end;
    Img.Canvas.Font.Name := cFontNameArray[Random(cFontNameNum)];
    X := Random(4) + L;
    Y := Random(2) + 4;
    Img.Canvas.TextOut(X, Y, Result[I + 1]);
    L := X + Img.Canvas.TextWidth(Result[I + 1]) + Random(2);
  end;

  if Random(2) = 0 then
  begin
    if Random(2) = 0 then
      Img.Picture.Bitmap := TwistImage(Img.Picture.Bitmap, True, 8 + Random(3), 1 + Random(2), True)
    else
      Img.Picture.Bitmap := TwistImage(Img.Picture.Bitmap, False, 8 + Random(3), 1 + Random(2), True);
  end else
  begin
    if Random(2) = 0 then
      Img.Picture.Bitmap := TwistImage(Img.Picture.Bitmap, True, 8 + Random(3), 1 + Random(2), False)
    else
      Img.Picture.Bitmap := TwistImage(Img.Picture.Bitmap, False, 8 + Random(3), 1 + Random(2), False);
  end;

  NoiseImage(Img);
end;

function GenerateAuthenticode(const Img: TImage; const Len: Integer): string;
begin
  Result := GenerateCharacterAuthenticode(Img, Len);
end;

initialization
  Randomize;

end.

    调用很简单：

uses
  AuthenticodeGenerate;

procedure TfrmMain.btnTestClick(Sender: TObject);
begin
  lbl1.Caption := GenerateAuthenticode(img1);
end;

    于是就有：

 

    注：

    1)、为减少识别难度，去掉了几个不易识别的字符如 1、I 等；

    2)、验证码背景色当然也可以（应该）随机。

 

http://www.cnblogs.com/ecofast/p/4224016.html