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

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;