delphi 验证码图片

最新推荐文章于 2023-09-06 10:29:16 发布

看那山瞧那水

最新推荐文章于 2023-09-06 10:29:16 发布

阅读量375

点赞数

分类专栏： Delphi 文章标签： delphi 验证码图片

本文链接：https://blog.csdn.net/jankercsdn/article/details/129016657

版权

Delphi 专栏收录该内容

41 篇文章 2 订阅

订阅专栏

参考网上的一些文章，写一个简单的自用验证码图片产生器。

unit uVerifyCodeGenerate;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes,
  FMX.Types, FMX.Graphics, FMX.Objects;

type
  TJkVerifyCodeImage = class(TPersistent)
  private
    FMinRandomLine: Integer;
    FMaxRandomLine: Integer;
    FWidth: Integer;
    FFontName: string;
    FMinFontSize: Integer;
    FMaxFontSize: Integer;
    FSize: TSizeF;
    FHeight: Integer;
    FVerifyCodeCount: Integer;
    FVerifyCode: string;
    FImgeBitMap: TBitmap;
    FImageStream: TStream;
    FBackgroundColor: TAlphaColor;
    procedure SetFontName(const Value: string);
    procedure SetHeight(const Value: Integer);
    procedure SetSize(const Value: TSizeF);
    procedure SetWidth(const Value: Integer);
    procedure SetVerifyCodeCount(const Value: Integer);
    procedure SetBackgroundColor(const Value: TAlphaColor);
  public
    constructor Create();
    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;

    function GetVerifyCode: Boolean; overload;

    class function GetVerifyCode(const AWidth, AHeight: Integer; AImgeBitMap: TBitmap;
      const ABackgroundColor: TAlphaColor = TAlphaColor($FFE8E8E8);
      const AFontName: string = 'Segoe UI'; { 'Times New Roman';} { '宋体'; }
      const AVerifyCodeCount: Integer = 4): string; overload;

    property Width: Integer read FWidth write SetWidth;
    property Height: Integer read FHeight write SetHeight;
    property Size: TSizeF read FSize write SetSize;
    property FontName: string read FFontName write SetFontName;
    property VerifyCodeCount: Integer read FVerifyCodeCount write SetVerifyCodeCount;
    property BackgroundColor: TAlphaColor read FBackgroundColor write SetBackgroundColor;
    property VerifyCode: string read FVerifyCode;
    property ImgeBitMap: TBitmap read FImgeBitMap;
    property ImageStream: TStream read FImageStream;
  end;

implementation

{
  //图片高度建议>=30,太小了字体也小，难以辨认
  //验证码的数目和图片的宽度有关系，图片的宽度要保证能容纳验证码，代码未检查图片的宽度和验证码的数目
  //背景色根据客户端界面环境设置，建议用浅色，可以降低人眼识别难度
  //随机线的颜色浅一些，可以降低人眼识别难度
  //随机线数目控制在一定范围，太多会降低人眼识别难度(建议10-50，图片小时，10-30；图片大时20-40)
  //随机点的颜色浅一些，可以降低人眼识别难度
  //随机码的字体颜色深一些，可以降低人眼识别难度
  //字体的大小根据图片的大小调整，最小值建议>=图片高度的0.6，最大值<=0.9
  //字体名称可以为固定值。如果必要，可以选择几种字体，然后每个字符随机选择一种字体(未实现)
}

uses
  uCommUtils, System.Math,
  FMX.TextLayout;

{ TJkVerifyCodeImage }

procedure TJkVerifyCodeImage.Assign(Source: TPersistent);
var
  src: TJkVerifyCodeImage;
begin
  if (Source <> nil) and (Source is TJkVerifyCodeImage) then
  begin
    src := TJkVerifyCodeImage(Source);
    Self.FWidth := src.Width;
    Self.FHeight := src.Height;
    Self.FSize := src.Size;
    Self.FFontName := src.FontName;
    //Self.FMinFontSize := src.MinFontSize;
    Self.FVerifyCodeCount := src.VerifyCodeCount;
    Self.FBackgroundColor := src.BackgroundColor;
  end;
end;

constructor TJkVerifyCodeImage.Create;
begin
  FWidth := 100;
  FHeight := 40;
  FSize := TSizeF.Create(100, 40);
  FFontName := '宋体';
  FMinFontSize := Round(FHeight * 0.6);
  FMaxFontSize := Round(FHeight * 0.9);
  FVerifyCodeCount := 4;
  FBackgroundColor :=  TAlphaColor($FFE8E8E8); // TAlphaColors.White;
  FMinRandomLine := 10;
  FMaxRandomLine := 30;
  FVerifyCode := '';
  FImgeBitMap := nil;
  FImageStream := nil;
end;

destructor TJkVerifyCodeImage.Destroy;
begin
  if Assigned(FImgeBitMap) then
    FImgeBitMap.Free;
  if Assigned(FImageStream) then
    FImageStream.Free;
  inherited;
end;

class function TJkVerifyCodeImage.GetVerifyCode(const AWidth, AHeight: Integer;
  AImgeBitMap: TBitmap; const ABackgroundColor: TAlphaColor; {const AMinFontSize: Integer;}
  const AFontName: string; const AVerifyCodeCount: Integer): string;
var
  LObj: TJkVerifyCodeImage;
begin
  Result := '';
  LObj := TJkVerifyCodeImage.Create;
  try
    LObj.Width := AWidth;
    LObj.Height := AHeight;
    LObj.FontName := AFontName;
    LObj.FMinFontSize := Round(AHeight * 0.6);
    LObj.FMaxFontSize := Round(AHeight * 0.9);
    LObj.VerifyCodeCount := AVerifyCodeCount;
    LObj.BackgroundColor := ABackgroundColor;
    LObj.FMinRandomLine := 10;
    LObj.FMaxRandomLine := 30;
    LObj.FVerifyCode := '';
    LObj.FImgeBitMap := nil;
    LObj.FImageStream := nil;

    if LObj.GetVerifyCode then
    begin
      if AImgeBitMap <> nil then
        AImgeBitMap.Assign(LObj.ImgeBitMap);
      Result := LObj.VerifyCode;
    end;
  finally
    LObj.Free;
  end;
end;

function TJkVerifyCodeImage.GetVerifyCode: Boolean;
var
  LCanvas: TCanvas;

  procedure DrawRandomLine(const ACanvas: TCanvas);
  var
    LLineCount: Integer;
    LP1, LP2: TPointF;
    LColor: TAlphaColor;
  begin
    Randomize;
    LLineCount := RandomRange(FMinRandomLine, FMaxRandomLine);
    for var I := 0 to LLineCount - 1 do
    begin
      LColor := TAlphaColorF.Create(RandomRange(10,160), RandomRange(10,160),
        RandomRange(10,160), 1).ToAlphaColor;
      LP1 := TPointF.Create(RandomRange(1, FWidth div 3), RandomRange(1, FHeight));
      LP2 := TPointF.Create(RandomRange(2 * FWidth div 3, FWidth), RandomRange(1, FHeight));
      LCanvas.Stroke.Color := LColor;
      ACanvas.DrawLine(LP1, LP2, 1);
    end;
  end;

  procedure DrawRandomPoint(const ACanvas: TCanvas);
  var
    LDot: TRectF;
    LDotLeft: Single;
    LDotRight: Single;
    LDotTop: Single;
    LDotBot: Single;
    LCount: Integer;
    LRadiu: Single;
    LColor: TAlphaColor;
  begin
    Randomize;
    LCount := RandomRange(100, 200);
    for var I := 50 to LCount-1 do
    begin
      LRadiu := RandomRange(1, 5);
      LColor := TAlphaColorF.Create(RandomRange(10,160), RandomRange(10,160),
        RandomRange(10,160), 1).ToAlphaColor;

      LDotLeft := RandomRange(1, FWidth- Round(LRadiu -1));
      LDotTop := RandomRange(1, FHeight- Round(LRadiu -1));
      LDotRight := LDotLeft + LRadiu;
      LDotBot := LDotTop + LRadiu;
      LDot := TRectF.Create(LDotLeft, LDotTop, LDotRight, LDotBot);
      LCanvas.Stroke.Kind := TBrushKind.None;
      LCanvas.Fill.Color := LColor;
      LCanvas.FillEllipse(LDot, 1);
    end;
  end;
  //FMX框架下，文本输出建议用 TTextLayout, 不要直接用TCanvas.FillText();
  procedure DrawRandowText(const ACanvas: TCanvas);
  var
    LTextLayout: TTextLayout;
    LX1, LY1, LX2, LY2: Single;
    LCharWidth: Single;
    LCharHeight: Single;
    LYH: Single;
  begin
    LTextLayout := TTextLayoutManager.DefaultTextLayout.Create;
    try
      Randomize;
      LX1 := RandomRange(0, 5) + 5;
      for var C in FVerifyCode do
      begin
        LY1 := RandomRange(0, 5);
        LTextLayout.BeginUpdate;
        try
          LTextLayout.Text := C;
          LTextLayout.Font.Family := FFontName;
          LTextLayout.Color := TAlphaColorF.Create(RandomRange(100,255), RandomRange(100,255),
            RandomRange(100,255), 1).ToAlphaColor;
          LTextLayout.Font.Size := RandomRange(FMinFontSize, FMaxFontSize);
          if LTextLayout.Font.Size < 20 then
            LTextLayout.Font.Size := 20;
          LCharWidth := GetTextLineWidth(C, FFontName, LTextLayout.Font.Size);
          LCharHeight := GetTextLineHeight(C, FFontName, LTextLayout.Font.Size);
          LX2 := LX1 + LCharWidth + 1;
          LY2 := LY1 + LCharHeight + 1;
          if LY2 > FHeight - 1 then
          begin
            LYH := LY2 - FHeight + 1;
            LY1 := LY1 - LYH;
            LY2 := LY2 - LYH;
            if LY1 < 1 then
            begin
              LY1 := 1;
              LY2 := LY1 + LCharHeight + 1;
            end;
          end;
          LTextLayout.TopLeft := PointF(LX1, LY1);
          LTextLayout.MaxSize := PointF(LX2, LY2);
          LTextLayout.RenderLayout(ACanvas);
          LX1 := LX2;
        finally
          LTextLayout.EndUpdate;
        end;
      end;
    finally
      LTextLayout.Free;
    end;
  end;

begin
  Result := False;
  if not Assigned(FImgeBitMap) then
    FImgeBitMap := TBitmap.Create(FWidth, FHeight);
  FVerifyCode := GetRandomNumCharsWithRandomCase;
  LCanvas := FImgeBitMap.Canvas;
  FImgeBitMap.Clear(FBackgroundColor);
  LCanvas.BeginScene;
  try
    try
      //绘制随机线
      DrawRandomLine(LCanvas);
      //绘制随机点
      DrawRandomPoint(LCanvas);
      //绘制随机码
      DrawRandowText(LCanvas);
    except
      Exit;
    end;
  finally
    LCanvas.EndScene;
  end;

  if not Assigned(FImageStream) then
    FImageStream := TMemoryStream.Create
  else
    TMemoryStream(FImageStream).Clear;
  FImgeBitMap.SaveToStream(FImageStream);
  Result := True;
end;

procedure TJkVerifyCodeImage.SetBackgroundColor(const Value: TAlphaColor);
begin
  FBackgroundColor := Value;
end;

procedure TJkVerifyCodeImage.SetFontName(const Value: string);
begin
  FFontName := Value;
end;

procedure TJkVerifyCodeImage.SetHeight(const Value: Integer);
begin
  FHeight := Value;
end;

procedure TJkVerifyCodeImage.SetSize(const Value: TSizeF);
begin
  FSize := Value;
end;

procedure TJkVerifyCodeImage.SetVerifyCodeCount(const Value: Integer);
begin
  FVerifyCodeCount := Value;
end;

procedure TJkVerifyCodeImage.SetWidth(const Value: Integer);
begin
  FWidth := Value;
end;

end.

随机码产生：

unit uCommUtils

interface

uses
  System.SysUtils, System.Classes, System.Types,  System.UITypes,
  FMX.Types, FMX.Graphics, FMX.TextLayout;

//通用的文本高度计算
function GetTextLineHeight(const ALineText: string; const AFontFamily: string; const AFontSize: Single): Single;
//通用的文本宽度计算
function GetTextLineWidth(const ALineText: string; const AFontFamily: string; const AFontSize: Single): Single;
//通用的文本行大小计算
function GetTextLineSize(const ALineText: string; const AFontFamily: string; const AFontSize: Single): TSizeF;
//随机码
function GetRandomNumCharsWithRandomCase(const ABitCount: Integer = 4): string;

implementation

function GetTextLineHeight(const ALineText: string; const AFontFamily: string; const AFontSize: Single): Single;
var
  LTextLayout: TTextLayout;
begin
  LTextLayout := TTextLayoutManager.DefaultTextLayout.Create();
  try
    LTextLayout.BeginUpdate;
    try
      LTextLayout.Font.Family := AFontFamily;
      LTextLayout.Font.Size := AFontSize;
      LTextLayout.Text := ALineText;
    finally
      LTextLayout.EndUpdate;
    end;
    Result := LTextLayout.Height;  //TextHeight
  finally
    LTextLayout.Free;
  end;
end;

function GetTextLineWidth(const ALineText: string; const AFontFamily: string; const AFontSize: Single): Single;
var
  LTextLayout: TTextLayout;
begin
  LTextLayout := TTextLayoutManager.DefaultTextLayout.Create();
  try
    LTextLayout.BeginUpdate;
    try
      LTextLayout.Font.Family := AFontFamily;
      LTextLayout.Font.Size := AFontSize;
      LTextLayout.Text := ALineText;
    finally
      LTextLayout.EndUpdate;
    end;
    Result := LTextLayout.Width;  //TextHeight
  finally
    LTextLayout.Free;
  end;
end;

function GetTextLineSize(const ALineText: string; const AFontFamily: string; const AFontSize: Single): TSizeF;
var
  LTextLayout: TTextLayout;
begin
  Result := TSizeF.Create(0, 0);
  LTextLayout := TTextLayoutManager.DefaultTextLayout.Create();
  try
    LTextLayout.BeginUpdate;
    try
      LTextLayout.Font.Family := AFontFamily;
      LTextLayout.Font.Size := AFontSize;
      LTextLayout.Text := ALineText;
    finally
      LTextLayout.EndUpdate;
    end;
    Result.Height := LTextLayout.Height;  //TextHeight
    Result.Width := LTextLayout.Width;    //TextWidth
  finally
    LTextLayout.Free;
  end;
end;

function GetRandomNumCharsWithRandomCase(const ABitCount: Integer): string;
const
  DefSeed = '123456789abcdefghizklmnopqrstuvwxyz';
var
  i, k, l: Integer;
  LChar: Char;
begin
  Result := '';
  Randomize;
  for i := 0 to ABitCount - 1 do
  begin
    k := Random(DefSeed.Length);
    LChar := DefSeed.Chars[k];
    l := Random(100);
    //小写的'l'和大写的'I'与数字'1'容易混肴，因此固定'l'为大写,'i'为小写('l'='L','I'='i')
    if LChar = 'l' then
      LChar := UpCase(LChar)
    else if (LChar <> 'i') and (l mod 2 = 0) then
      LChar := UpCase(LChar);
    Result := Result +LChar;
  end;
end;

end.

测试：

unit uMain;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Controls.Presentation,
  FMX.StdCtrls, FMX.Layouts, FMX.Objects, FMX.Edit, FMX.Memo.Types, FMX.ScrollBox, FMX.Memo;

type
  TForm1 = class(TForm)
    btn1: TButton;
    lyt1: TLayout;
    edt1: TEdit;
    img1: TImage;
    rct1: TRectangle;
    mmo1: TMemo;
    lbl1: TLabel;
    lyt2: TLayout;
    img2: TImage;
    procedure btn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

uses
  System.NetEncoding,
  JkSoft.JkComm.VerifyCodeGenerate;

procedure TForm1.btn1Click(Sender: TObject);
var
  LStream: TBytesStream;
  LMS: TMemoryStream;
begin
  edt1.Text := TJkVerifyCodeImage.GetVerifyCode(Round(img1.Width), Round(img1.Height), img1.Bitmap);
  LStream := TBytesStream.Create;
  LMS := TMemoryStream.Create;
  try
    img1.Bitmap.SaveToStream(LStream);
    //LStream.Position := 0;
    mmo1.Lines.Clear;
    mmo1.Lines.Add(TNetEncoding.Base64.EncodeBytesToString(LStream.Bytes));
    lbl1.Text := LStream.Size.ToString;
    LMS.CopyFrom(LStream, 0);
    img2.Bitmap.LoadFromStream(LMS);
  finally
    LMS.Free;
    LStream.Free;
  end;
end;

end.