参考网上的一些文章,写一个简单的自用验证码图片产生器。
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.