unit uCaptchaGenerator;

interface

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

type
  TCaptchaGenerator = class
  private const
    CharSet: array[0..34] of Char = (
      '1','2','3','4','5','6','7','8','9',
      'A','B','C','D','E','F','G','H','I',
      'J','K','L','M','N','O','P','Q','R',
      'S','T','U','V','W','X','Y','Z');
  private
    FWidth: Integer;
    FHeight: Integer;
    FCharCount: Integer;
    FFontFamily: String;
    FMinFontSize: Integer;
    FNoiseLines: Integer;
    FOpacity: Byte;
    FXJitter: Integer;
    FYJitter: Integer;
    function DrawCaptcha(Image: TImage): String;
  public
    constructor Create;
    procedure GenerateCaptcha(Stream: TStream; var Code: String);
  published
    property Width: Integer read FWidth write FWidth;
    property Height: Integer read FHeight write FHeight;
    property CharCount: Integer read FCharCount write FCharCount;
    property FontFamily: String read FFontFamily write FFontFamily;
    property MinFontSize: Integer read FMinFontSize write FMinFontSize;
    property NoiseLines: Integer read FNoiseLines write FNoiseLines;
    property Opacity: Byte read FOpacity write FOpacity;
    property XJitter: Integer read FXJitter write FXJitter;
    property YJitter: Integer read FYJitter write FYJitter;
  end;

implementation

constructor TCaptchaGenerator.Create;
begin
  inherited;
  FWidth := 120;
  FHeight := 40;
  FCharCount := 5;
  FFontFamily := 'Arial';
  FMinFontSize := 16;
  FNoiseLines := 120;
  FOpacity := 180;
  FXJitter := 6;
  FYJitter := 5;
end;

procedure TCaptchaGenerator.GenerateCaptcha(Stream: TStream; var Code: String);
var
  Bitmap: TBitmap;
begin
  Bitmap := TBitmap.Create(FWidth, FHeight);
  try
    Bitmap.Canvas.BeginScene;
    Code := DrawCaptcha(TImage.Create);
    Bitmap.SaveToStream(Stream);
  finally
    Bitmap.Free;
  end;
end;

function TCaptchaGenerator.DrawCaptcha(Image: TImage): String;
var
  I: Integer;
  X, Y, W, H: Single;
  Position: Single;
  ResultText: String;
begin
  for I := 1 to FCharCount do
  begin
    ResultText := ResultText + CharSet[Random(35)];
  end;

  Position := 8;
  Image.Bitmap.Canvas.Font.Family := FFontFamily;

  // ノイズ線の描画
  for I := 1 to FNoiseLines do
  begin
    Image.Bitmap.Canvas.Stroke.Color := TAlphaColorRec.Create(
      Random(192), Random(192), Random(192), FOpacity);
    Image.Bitmap.Canvas.DrawLine(
      PointF(Random(FWidth), Random(FHeight)),
      PointF(Random(FWidth), Random(FHeight)), 1);
  end;

  // 文字色の設定
  Image.Bitmap.Canvas.Fill.Color := TAlphaColorRec.Create(
    Random(192), Random(192), Random(192));
  
  // 背景の塗りつぶし
  Image.Bitmap.Clear(TAlphaColorRec.White);

  // 文字列の描画
  for I := 1 to Length(ResultText) do
  begin
    Image.Bitmap.Canvas.Font.Size := Random(10) + FMinFontSize;
    if Random(2) = 0 then
      Image.Bitmap.Canvas.Font.Style := [TFontStyle.fsBold]
    else
      Image.Bitmap.Canvas.Font.Style := [TFontStyle.fsItalic];

    X := Random(FXJitter) + Position;
    Y := Random(FYJitter);
    W := Image.Bitmap.Canvas.TextWidth(ResultText[I]);
    H := Image.Bitmap.Canvas.TextHeight(ResultText[I]);
    
    Image.Bitmap.Canvas.FillText(
      TRectF.Create(X, Y, X + W, Y + H),
      ResultText[I], False, 1, [], TTextAlign.taCenter, TTextAlign.taCenter);
      
    Position := X + W + 2;
  end;

  Result := ResultText;
end;

end.

var
  CaptchaGen: TCaptchaGenerator;
begin
  CaptchaGen := TCaptchaGenerator.Create;
end;

procedure TForm1.GenerateBtnClick(Sender: TObject);
var
  Stream: TMemoryStream;
  CaptchaCode: String;
begin
  Stream := TMemoryStream.Create;
  try
    CaptchaGen.GenerateCaptcha(Stream, CaptchaCode);
    CaptchaLabel.Text := CaptchaCode;
    Stream.Position := 0;
    CaptchaImage.Bitmap.LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

// HTML
<img src="CaptchaImage" id="captcha-img" style="cursor:pointer">

// JavaScript
document.getElementById('captcha-img').addEventListener('click', function() {
  this.src = 'CaptchaImage?r=' + Math.random();
});

// サーバーサイド
function TWebModule.GetCaptcha(Request: TWebRequest; Response: TWebResponse): Boolean;
var
  Code: String;
begin
  Response.ContentType := 'image/png';
  Response.ContentStream := TMemoryStream.Create;
  try
    CaptchaGen.GenerateCaptcha(Response.ContentStream, Code);
    // 実際の実装ではCodeをセッションに保存
  finally
    Result := True;
  end;
end;