{***************************************************************************}
{ TIWAdvCaptchaImage component                                              }
{ for Delphi & C++Builder                                                   }
{                                                                           }
{ written by TMS Software                                                   }
{            copyright © 2009 - 2013                                        }
{            Email : info@tmssoftware.com                                   }
{            Web : http://www.tmssoftware.com                               }
{                                                                           }
{ The source code is given as is. The author is not responsible             }
{ for any possible damage done due to the use of this code.                 }
{ The component can be freely used in any application. The complete         }
{ source code remains property of the author and may not be distributed,    }
{ published, given or sold in any form as such. No parts of the source      }
{ code can be included in any other component or application without        }
{ written authorization of the author.                                      }
{***************************************************************************}

unit IWAdvCaptchaImage;

{$I TMSDEFS.INC}

interface
uses
  Classes, Windows, Forms, Dialogs, Controls, Graphics, Messages, ExtCtrls,
  SysUtils, Math, IWAdvGDIP, Types
{----------------------------------------------}
{  I M P O R T A N T   N O T I C E             }
{                                              }
{ If there is a "File not found" compiler      }
{ error, please comment/uncomment the required }
{ lines based on the IntraWeb version.         }
{----------------------------------------------}
  //, Vcl.Imaging.JPeg
  , JPeg
  {$IFDEF DELPHIXE2_LVL}
  , System.UITypes
  {$ENDIF}
  ;

const
  MAJ_VER = 1; // Major version nr.
  MIN_VER = 0; // Minor version nr.
  REL_VER = 0; // Release nr.
  BLD_VER = 0; // Build nr.

type
  TCaptchaType = (ctAlphanumeric, ctNumeric, ctAlpha, ctCustom);
  TCaptchaBackground = (cbNoise, cbRaster, cbHorzLines, cbVertLines, cbSolid);   // MedNoise, MedLines
  TCaptchaCodeStyle = (csStraight, csWave, csFlow);
  TCaptchaCodeTexture = (ctSolid, ctHatch);
  TIWCaptchaImageType = (ciJPEG, ciBMP);
  TCaptchaShapeType = (stArbitrary, stLines, stRaster, stNone);

  TFillOpacity = 0..255;

  TIWAdvCaptchaImage = class(TGraphicControl)
  private
    FCaptchaFont: TFont;
    FCaptchaType: TCaptchaType;
    FCaptchaBackgroundColor: TColor;
    FCaptchaLength: Integer;
    FCaptchaBackground: TCaptchaBackground;
    FCaptchaCode: string;
    FBitmap: TBitmap;
    FUpperCaseAlpha: Boolean;
    FAvoidChars: string;
    FCaptchaBackgroundColorTo: TColor;
    FCaptchaCodeStyle: TCaptchaCodeStyle;
    FCaptchaCodeTexture: TCaptchaCodeTexture;
    FShapeType: TCaptchaShapeType;
    FShapeOpacity: TFillOpacity;
    FShapeAngle: Integer;
    FShapeColor: TColor;
    FShapePenWidth: Byte;
    FShapeDistance: Integer;
    FCaptchaCodeHatchStyle: THatchStyle;
    FFirstPaint: Boolean;
    FGPpts: array[0..8] of TGPPoint;
    FArrayInit: Boolean;
    FTension: Integer;
    procedure OnFontChanged(Sender: TObject);
    function GetVersion: string;
    procedure SetVersion(const Value: string);
    procedure SetCaptchaBackgroundColor(const Value: TColor);
    procedure SetCaptchaFont(const Value: TFont);
    procedure SetCaptchaLength(const Value: Integer);
    procedure SetCaptchaType(const Value: TCaptchaType);
    procedure SetCaptchaBackground(const Value: TCaptchaBackground);
    procedure SetCaptchaCode(const Value: string);
    function InternalGenerate(s: string): TBitmap;
    procedure InternalUpdate;
    function GetNewCaptchaCode: string;
    procedure DrawArbitraryShape(g: TGPGraphics);
    procedure DrawNoise(g: TGPGraphics);
    procedure DrawBackGround(g: TGPGraphics);
    procedure DrawCaptchaCode(g: TGPGraphics; aCanvas: TCanvas; s: string);
    procedure SetUpperCaseAlpha(const Value: Boolean);
    procedure SetAvoidChars(const Value: string);
    procedure SetCaptchaBackgroundColorTo(const Value: TColor);
    procedure SetCaptchaCodeStyle(const Value: TCaptchaCodeStyle);
    procedure SetCaptchaCodeTexture(const Value: TCaptchaCodeTexture);
    procedure SetShapeType(const Value: TCaptchaShapeType);
    procedure SetShapeAngle(const Value: Integer);
    procedure SetShapeColor(const Value: TColor);
    procedure SetShapeOpacity(const Value: TFillOpacity);
    procedure SetShapePenWidth(const Value: Byte);
    procedure SetShapeDistance(const Value: Integer);
    procedure SetCaptchaCodeHatchStyle(const Value: THatchStyle);
  protected                                                
    procedure Loaded; override;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    function GetVersionNr: Integer; virtual;
    procedure SaveToFile(FileName: string; ImageType: TIWCaptchaImageType = ciJPEG);  // ImageType = (itJPG, itBMP, itPNG)
    procedure SaveToStream(AStream: TMemoryStream; ImageType: TIWCaptchaImageType = ciJPEG);  // ImageType = (itJPG, itBMP, itPNG)
    procedure GenerateNew;
    procedure Update; override;
    procedure DrawCaptchaImage(ACanvas: TCanvas);    
    property CaptchaCode: string read FCaptchaCode write SetCaptchaCode;
  published
    property Align;
    property Anchors;
    property AvoidChars: string read FAvoidChars write SetAvoidChars;
    property CaptchaType: TCaptchaType read FCaptchaType write SetCaptchaType default ctAlphanumeric;
    property CaptchaLength: Integer read FCaptchaLength write SetCaptchaLength default 6;
    property CaptchaBackground: TCaptchaBackground read FCaptchaBackground write SetCaptchaBackground default cbNoise;
    property CaptchaFont: TFont read FCaptchaFont write SetCaptchaFont;
    property CaptchaBackgroundColor: TColor read FCaptchaBackgroundColor write SetCaptchaBackgroundColor default clSilver;
    property CaptchaBackgroundColorTo: TColor read FCaptchaBackgroundColorTo write SetCaptchaBackgroundColorTo default clNone;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property CaptchaCodeHatchStyle: THatchStyle read FCaptchaCodeHatchStyle write SetCaptchaCodeHatchStyle default HatchStyleSmallConfetti;
    property CaptchaCodeTexture: TCaptchaCodeTexture read FCaptchaCodeTexture write SetCaptchaCodeTexture default ctSolid;
    property CaptchaCodeStyle: TCaptchaCodeStyle read FCaptchaCodeStyle write SetCaptchaCodeStyle default csWave;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property ShapeType: TCaptchaShapeType read FShapeType write SetShapeType default stArbitrary;
    property ShapeOpacity: TFillOpacity read FShapeOpacity write SetShapeOpacity default 150;
    property ShapeColor: TColor read FShapeColor write SetShapeColor default clBlack;
    property ShapePenWidth: Byte read FShapePenWidth write SetShapePenWidth default 1;
    property ShapeAngle: Integer read FShapeAngle write SetShapeAngle default 0;
    property ShapeDistance: Integer read FShapeDistance write SetShapeDistance default 8;
    property UpperCaseAlpha: Boolean read FUpperCaseAlpha write SetUpperCaseAlpha default False;
    property Version: string read GetVersion write SetVersion;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseDown;
    {$IFDEF DELPHI2006_LVL}
    property OnMouseEnter;
    property OnMouseLeave;
    {$ENDIF}
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;

implementation
uses
  ActiveX,
  IWApplication;

type
  TGDIPGradient = (ggRadial, ggVertical, ggDiagonalForward, ggDiagonalBackward);

//------------------------------------------------------------------------------

procedure DrawGDIPGradBackground(Graphics: TGPGraphics; R: TRect; CF,CT: TColor; Gradient: TGDIPGradient);
var
  path: TGPGraphicsPath;
  pthGrBrush: TGPPathGradientBrush;
  linGrBrush: TGPLinearGradientBrush;
  solGrBrush: TGPSolidBrush;

  w, h: Integer;
  colors : array[0..0] of TGPColor;
  count: Integer;
begin
  w := r.Right - r.Left;
  h := r.Bottom - r.Top;

  if (CT = clNone) then
  begin
    solGrBrush := TGPSolidBrush.Create(ColorToARGB(CF));
    Graphics.FillRectangle(solGrBrush, MakeRect(r.Left , r.Top, r.Right , r.Bottom));
    solGrBrush.Free;
    Exit;
  end;

  // Create a path that consists of a single ellipse.
  path := TGPGraphicsPath.Create;

  path.AddEllipse(r.Left, r.Top, r.Right , r.Bottom);

  pthGrBrush := nil;
  linGrBrush := nil;

  case Gradient of
  ggRadial: pthGrBrush := TGPPathGradientBrush.Create(path);
  ggVertical: linGrBrush := TGPLinearGradientBrush.Create(MakeRect(r.Left,r.Top,w,h),ColorToARGB(CF),ColorToARGB(CT), LinearGradientModeVertical);
  ggDiagonalForward: linGrBrush := TGPLinearGradientBrush.Create(MakeRect(r.Left,r.Top,w,h),ColorToARGB(CF),ColorToARGB(CT), LinearGradientModeForwardDiagonal);
  ggDiagonalBackward: linGrBrush := TGPLinearGradientBrush.Create(MakeRect(r.Left,r.Top,w,h),ColorToARGB(CF),ColorToARGB(CT), LinearGradientModeBackwardDiagonal);
  end;

  if Gradient = ggRadial then
  begin
    pthGrBrush.SetCenterPoint(MakePoint(r.Left + w div 2, r.Bottom));

    // Set the color at the center point to blue.
    pthGrBrush.SetCenterColor(ColorToARGB(CF));
    colors[0] := ColorToARGB(CT);

    count := 1;
    pthGrBrush.SetSurroundColors(@colors, count);
    graphics.FillRectangle(pthGrBrush, r.Left, r.Top, r.Right, r.Bottom);
    pthGrBrush.Free;
  end
  else
  begin
    graphics.FillRectangle(linGrBrush, r.Left, r.Top, r.Right, r.Bottom);
    linGrBrush.Free;
  end;

  path.Free;
end;

//------------------------------------------------------------------------------

function BrightnessColor(Col: TColor; Brightness: integer): TColor;
var
  r1,g1,b1: Integer;
begin
  Col := ColorToRGB(Col);
  r1 := GetRValue(Col);
  g1 := GetGValue(Col);
  b1 := GetBValue(Col);

  if r1 = 0 then
    r1 := Max(0,Brightness)
  else
    r1 := Round( Min(100,(100 + Brightness))/100 * r1 );

  if g1 = 0 then
    g1 := Max(0,Brightness)
  else
    g1 := Round( Min(100,(100 + Brightness))/100 * g1 );

  if b1 = 0 then
    b1 := Max(0,Brightness)
  else
    b1 := Round( Min(100,(100 + Brightness))/100 * b1 );

  Result := RGB(r1,g1,b1);
end;

//------------------------------------------------------------------------------

function GetCaptchaCode(FromS: string; Length: Integer): string;
var
  i, l, j: Integer;
begin
  Result := '';
  l := System.Length(FromS) + 1;
  for I := 1 to Length do
  begin
    j := RandomRange(1, l);
    Result := Result + FromS[j];
  end;  
end;

//------------------------------------------------------------------------------

function RemoveChars(FromS, Chars: string): string;
var
  i, j, p: Integer;
begin
  Result := FromS;
  if (FromS = '') then
    Exit;

  j := Length(Chars);
  for I := 1 to j do
  begin
    p := Pos(Chars[i], Result);
    if (p > 0) then
    begin
      //Delete(Result, p, 1);
      if (p = 1) then
        Result := Copy(Result, p + 1, Length(Result))
      else
        Result := Copy(Result, 1, p - 1) + Copy(Result, p + 1, Length(Result));
    end;
  end;
end;

//------------------------------------------------------------------------------

procedure ProduceWave(bmp: TBitmap; Distortion: double);
var
  x, y, nx, ny: Integer;
  bmp2: TBitmap;
begin
  if not Assigned(bmp) then
    Exit;

  bmp2 := TBitmap.Create;
  bmp2.Assign(bmp);
  for y := 0 to bmp.Height do
  begin
    for x := 0 to bmp.Width - 1 do
    begin
      nx := Round(x + (Distortion * Sin(PI * y / 90.0)));
      ny := Round(y + (Distortion * Cos(PI * x / 48.0)));
      if (nx < 0) or (nx >= bmp.Width) then nx := 0;
      if (ny < 0) or (ny >= bmp.Height) then ny := 0;
      bmp.Canvas.Pixels[x, y] := bmp2.Canvas.Pixels[nx, ny];
    end;
  end;

  bmp2.Free;
end;

//------------------------------------------------------------------------------

procedure DrawGDIPImage(gr: TGPGraphics; Canvas: TCanvas; P: TPoint; bmp: TGraphic; Transparent: Boolean = False); overload;
var
  Img: TGPImage;
  pstm: IStream;
  hGlobal: THandle;
  pcbWrite: Longint;
  ms: TMemoryStream;
  graphics: TGPGraphics;
  ImageAttributes: TGPImageAttributes;
  r, g, b: byte;
  GPBmp: TGPBitmap;
  Aclr: TGPColor;
begin
  if (not Assigned(gr) and not Assigned(Canvas)) then
    Exit;

  graphics := gr;
  if not Assigned(graphics) then
  begin
    graphics := TGPGraphics.Create(Canvas.Handle);
    graphics.SetSmoothingMode(SmoothingModeAntiAlias);
  end;

  ms := TMemoryStream.Create;
  bmp.SaveToStream(ms);
  hGlobal := GlobalAlloc(GMEM_MOVEABLE, ms.Size);
  if (hGlobal = 0) then
  begin
    ms.Free;
    raise Exception.Create('Could not allocate memory for image');
  end;

  try
    pstm := nil;

    // Create IStream* from global memory
    CreateStreamOnHGlobal(hGlobal, TRUE, pstm);
    pstm.Write(ms.Memory, ms.Size,@pcbWrite);

    Img := TGPImage.Create(pstm);

    if Transparent and (Img.GetFormat <> ifPNG) then
    begin
      GPBmp := TGPBitmap.Create(pstm);
      GPBmp.GetPixel(0, 0, AClr);
      GPBmp.Free;

      r := IWADVGDIP.GetRed(AClr);
      g := IWADVGDIP.GetGreen(AClr);
      b := IWADVGDIP.GetBlue(AClr);

      ImageAttributes := TGPImageAttributes.Create;
      ImageAttributes.SetColorKey(MakeColor(r, g, b), MakeColor(r, g, b), ColorAdjustTypeDefault);
      graphics.DrawImage(Img, MakeRect(P.X, P.Y, Img.GetWidth, Img.Getheight),  // destination rectangle
       0, 0,        // upper-left corner of source rectangle
       Img.GetWidth,       // width of source rectangle
       Img.GetHeight,      // height of source rectangle
       UnitPixel,
       ImageAttributes);
      //graphics.DrawImage(Img, P.X, P.y);
      ImageAttributes.Free;
    end
    else
      graphics.DrawImage(Img, P.X, P.y);

    Img.Free;
    ms.Free;
  finally
    GlobalFree(hGlobal);
  end;

  if not Assigned(gr) then
    graphics.Free;
end;

//------------------------------------------------------------------------------

{ TIWCaptchaImage }

constructor TIWAdvCaptchaImage.Create(AOwner: TComponent);
begin
  inherited;
  FBitmap := nil;
  FCaptchaCode := '';
  FAvoidChars := 'ol01';  // confusing chars
  FCaptchaFont := TFont.Create;
  FCaptchaFont.Name := 'Tahoma';
  FCaptchaFont.Size := 48;
  FCaptchaFont.OnChange := OnFontChanged;
  FCaptchaType := ctAlphanumeric;
  FCaptchaLength := 6;
  FCaptchaBackgroundColor := clSilver;
  FCaptchaBackgroundColorTo := clNone;
  FCaptchaBackground := cbNoise;
  FCaptchaCodeTexture := ctSolid;
  FCaptchaCodeStyle := csWave;
  FShapeType := stArbitrary;
  FShapeOpacity := 150;
  FShapeAngle := 0;
  FShapeColor := clBlack;
  FShapePenWidth := 1;
  FShapeDistance := 8;
  FCaptchaCodeHatchStyle := HatchStyleSmallConfetti;
  Randomize;
  FArrayInit := False;
  FTension := 15;
  Width := 230;
  Height := 150;
  FFirstPaint := True;
  FGPpts[0].X := -10;
  FGPpts[0].Y := -10;
end;

//------------------------------------------------------------------------------

destructor TIWAdvCaptchaImage.Destroy;
begin
  FCaptchaFont.Free;
  if Assigned(FBitmap) then
    FBitmap.Free;
  inherited;
end;

//------------------------------------------------------------------------------

function TIWAdvCaptchaImage.GetNewCaptchaCode: string;
var
  FromS: String;
begin
  if (CaptchaType = ctCustom) then
  begin
    Result := CaptchaCode;
    Exit;
  end;
  
  case CaptchaType of
    ctAlphanumeric:
    begin
      if UpperCaseAlpha then
        FromS := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789'
      else
        FromS := 'abcdefghijklmnopqrstuvwxyz0123456789';
    end;
    ctNumeric: FromS := '0123456789';
    ctAlpha:
    begin
      if UpperCaseAlpha then
        FromS := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
      else
        FromS := 'abcdefghijklmnopqrstuvwxyz';
    end;
    ctCustom: FromS := CaptchaCode;
  end;

  FromS := RemoveChars(FromS, FAvoidChars);
  Result := GetCaptchaCode(FromS, CaptchaLength);
end;

//------------------------------------------------------------------------------

function TIWAdvCaptchaImage.GetVersion: string;
var
  vn: Integer;
begin
  vn := GetVersionNr;
  Result := IntToStr(Hi(Hiword(vn)))+'.'+IntToStr(Lo(Hiword(vn)))+'.'+IntToStr(Hi(Loword(vn)))+'.'+IntToStr(Lo(Loword(vn)));
end;

//------------------------------------------------------------------------------

function TIWAdvCaptchaImage.GetVersionNr: Integer;
begin
  Result := MakeLong(MakeWord(BLD_VER,REL_VER),MakeWord(MIN_VER,MAJ_VER));
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.SetVersion(const Value: string);
begin

end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.InternalUpdate;
begin
  //if not (csDesigning in ComponentState) then
  begin
    if Assigned(FBitmap) then
      FBitmap.Free;
    FBitmap := InternalGenerate(CaptchaCode);
    Invalidate;
  end;
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.Update;
begin
  inherited;
  if not (csDesigning in ComponentState) then  
    InternalUpdate;
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.Loaded;
begin
  inherited;
  GenerateNew;
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.OnFontChanged(Sender: TObject);
begin
  InternalUpdate;
end;

//------------------------------------------------------------------------------

function TIWAdvCaptchaImage.InternalGenerate(s: string): TBitmap;
var
  graphics: TGPGraphics;
begin
  Result := TBitmap.Create;
  Result.Width := Self.Width;
  Result.Height := Self.Height;

  graphics := TGPGraphics.Create(Result.Canvas.Handle);
  graphics.SetSmoothingMode(SmoothingModeAntiAlias);
  DrawBackGround(graphics);
  DrawCaptchaCode(graphics, Result.Canvas, s);
  if (ShapeType <> stNone) then  
    DrawArbitraryShape(graphics);  
  graphics.Free;
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.DrawCaptchaImage(ACanvas: TCanvas);
var
  graphics: TGPGraphics;
begin
  graphics := TGPGraphics.Create(ACanvas.Handle);
  graphics.SetSmoothingMode(SmoothingModeAntiAlias);
  DrawBackGround(graphics);
  DrawCaptchaCode(graphics, ACanvas, CaptchaCode);
  if (ShapeType <> stNone) then
    DrawArbitraryShape(graphics);
  graphics.Free;
end;


//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.DrawNoise(g: TGPGraphics);
var
  s, w, h, i, j, x, y: Integer;
  HB: TGPHatchBrush;
begin
  w := Width;
  h := Height;
  s := Max(6, Max(w, h) div 50);
  j := (w * h div 60);
  HB := TGPHatchBrush.Create(HatchStyleTrellis, ColorToARGB(CaptchaBackgroundColorTo), ColorToARGB(CaptchaBackgroundColor));
  for i := 0 to j do
  begin
    x := Random(Width);
    y := Random(Height);
    w := 1 + Random(s);
    h := 1 + Random(s);
    g.FillEllipse(HB, x, y, w, h);
  end;
  HB.Free;
end;

//------------------------------------------------------------------------------

procedure DrawLineNoise(g: TGPGraphics; w, h: Integer; Clr: TColor);
var
  s, i, j, x, y, x2, y2: Integer;
  pen: TGPPen;
begin
  s := Max(6, Max(w, h) div 50);
  j := (w * h div 50);
  pen := TGPPen.Create(ColorToARGB(Clr), 1.3);
  for i := 0 to j do
  begin
    x := Random(w);
    y := Random(h);
    x2 := 2 + Random(s);
    y2 := 2 + Random(s);
    g.DrawLine(pen, x, y, x + x2, y + y2);
  end;
  pen.Free;
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.DrawBackGround(g: TGPGraphics);
var
  R: TRect;
  HB: TGPHatchBrush;
begin
  R := ClientRect;
  case CaptchaBackground of
    cbNoise:
    begin
      HB := TGPHatchBrush.Create(HatchStyleSmallConfetti, ColorToARGB(CaptchaBackgroundColorTo), ColorToARGB(CaptchaBackgroundColor));
      g.FillRectangle(HB, R.left, R.Top, R.Right - R.Left, R.Bottom - R.Top);
      HB.Free;

      //--- Some noise
      DrawNoise(g);
      DrawLineNoise(g, R.Right - R.Left, R.Bottom - R.Top, CaptchaBackgroundColorTo);
    end;
    cbRaster:
    begin
      HB := TGPHatchBrush.Create(HatchStyleCross, ColorToARGB(CaptchaBackgroundColorTo), ColorToARGB(CaptchaBackgroundColor));
      g.FillRectangle(HB, R.left, R.Top, R.Right - R.Left, R.Bottom - R.Top);
      HB.Free;
    end;
    cbHorzLines:
    begin
      HB := TGPHatchBrush.Create(HatchStyleHorizontal, ColorToARGB(CaptchaBackgroundColorTo), ColorToARGB(CaptchaBackgroundColor));
      g.FillRectangle(HB, R.left, R.Top, R.Right - R.Left, R.Bottom - R.Top);
      HB.Free;
    end;
    cbVertLines:
    begin
      HB := TGPHatchBrush.Create(HatchStyleVertical, ColorToARGB(CaptchaBackgroundColorTo), ColorToARGB(CaptchaBackgroundColor));
      g.FillRectangle(HB, R.left, R.Top, R.Right - R.Left, R.Bottom - R.Top);
      HB.Free;
    end;
    cbSolid:
    begin
      DrawGDIPGradBackground(g, R, CaptchaBackgroundColor, CaptchaBackgroundColorTo, ggVertical);
    end;
  end;
end;

//------------------------------------------------------------------------------

procedure DrawGDIPLines(g: TGPGraphics; ShapeAngle: double; ShapeDistance: Integer; Raster: Boolean; ShapeOpacity: TFillOpacity; ShapeColor: TColor; ShapePenWidth: Integer; Height, Width: Integer);
var
  w2, h2, i, j: Integer;
  Pen: TGPPen;
  rc, gc, bc: Byte;
  x, y, x1, y1, x2, y2, ang: double;
begin
  if Assigned(g) then
  begin
    rc := GetRValue(ShapeColor);
    gc := GetGValue(ShapeColor);
    bc := GetBValue(ShapeColor);

    Pen := TGPPen.Create(MakeColor(ShapeOpacity, rc, gc, bc), ShapePenWidth);
    ang := -ShapeAngle;

    i := Max(Width, Height);
    w2 := i *2;
    h2 := i *2;

    //bmp := TBitmap.Create;
    //bmp.Width := w2;
    //bmp.Height := h2;

    //bmp.Canvas.Brush.Color := CaptchaBackgroundColor;
    //bmp.Canvas.FillRect(Rect(0, 0, bmp.Width, bmp.Height));

    //bmpG := TGPGraphics.Create(bmp.Canvas.Handle);

    G.RotateTransform(ang);
    y := h2;
    j := (w2 div ShapeDistance) * 2;
    x1 := -Width - (Width div 2);
    x2 := x1 + w2 * 2;
    for I := 0 to j do
    begin
      y1 := y + Height div 2;
      y2 := y1;
      G.DrawLine(Pen, x1, y1, x2, y2);
      y := y - ShapeDistance;
    end;

    if Raster then
    begin
      x := w2;
      y1 := -Width - (Width div 2);
      y2 := y1 + w2 * 2;
      for I := 0 to j do
      begin
        x1 := x + (Width div 2);
        x2 := x1;
        G.DrawLine(Pen, x1, y1, x2, y2);
        x := x - ShapeDistance;
      end;
    end;

    G.ResetTransform;
    //DrawGDIPImage(g, nil, Point(0, 0), bmp, True);
    //bmpG.Free;
    //bmp.Free;
    Pen.Free;
  end;

end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.DrawArbitraryShape(g: TGPGraphics);
var
  pc, w2, h2, i, t: Integer;
  GPptsF: array[0..8] of TGPPoint;
  Path: TGPGraphicsPath;
  Pen: TGPPen;
  rc, gc, bc: Byte;
begin
  w2 := Width div 2;
  h2 := Height div 2;
  rc := GetRValue(ShapeColor);
  gc := GetGValue(ShapeColor);
  bc := GetBValue(ShapeColor);

  case ShapeType of
    stArbitrary:
    begin
      pc := 9;
      if (csDesigning in ComponentState) and FArrayInit then
      begin
        for I := 0 to pc - 1 do
        begin
          GPptsF[I].X := FGPpts[I].X;
          GPptsF[I].Y := FGPpts[I].Y;
        end;
        t := FTension;
      end
      else
      begin
        GPptsF[0].X := Random(w2);
        GPptsF[0].Y := Random(h2);
        GPptsF[1].X := w2 + Random(w2);
        GPptsF[1].Y := Random(h2);
        GPptsF[2].X := Random(w2);
        GPptsF[2].Y := h2 + Random(Height);
        GPptsF[3].X := w2 + Random(w2);
        GPptsF[3].Y := h2 + Random(Height);
        GPptsF[4].X := Random(Width);
        GPptsF[4].Y := Random(Height);
        GPptsF[5].X := Random(Width);
        GPptsF[5].Y := Random(Height);
        GPptsF[6].X := (w2 div 2) + Random(Width - w2);
        GPptsF[6].Y := (h2 div 2) + Random(Height - h2);
        GPptsF[7].X := (w2 div 2) + Random(Width - w2);
        GPptsF[7].Y := (h2 div 2) + Random(Height - h2);
        GPptsF[8].X := w2 + Random(10);
        GPptsF[8].Y := h2 + Random(20);

        t := Random(30);

        if (csDesigning in ComponentState) and (w2 > 0) and (h2 > 0) then
        begin
          for I := 0 to pc - 1 do
          begin
            FGPpts[I].X := GPptsF[I].X;
            FGPpts[I].Y := GPptsF[I].Y;
          end;
          FTension := t;
          FArrayInit := True;
        end;
      end;

      Path := TGPGraphicsPath.Create();
      Path.AddCurve(PGPPoint(@GPPtsF), pc, t);
      Path.CloseFigure;
      //Path.AddPolygon(PGPPoint(@GPPtsF), pc);
      //Path.AddLines(PGPPoint(@GPPtsF), 20);
      Pen := TGPPen.Create(MakeColor(ShapeOpacity, rc, gc, bc), ShapePenWidth);
      g.DrawPath(pen, Path);
      Path.Free;
      Pen.Free;
    end;
    stLines:
    begin
      DrawGDIPLines(g, ShapeAngle,ShapeDistance, False, ShapeOpacity, ShapeColor, ShapePenWidth, Height, Width);
    end;
    stRaster:
    begin
      DrawGDIPLines(g, ShapeAngle,ShapeDistance, True, ShapeOpacity, ShapeColor, ShapePenWidth, Height, Width);
    end;
  end;
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.DrawCaptchaCode(g: TGPGraphics; aCanvas: TCanvas; s: string);
var
  graphics, bmpG: TGPGraphics;
  fontFamily: TGPFontFamily;
  gpfont: TGPFont;
  stringFormat: TGPStringFormat;
  Path: TGPGraphicsPath;
  w, h, fs: integer;
  R: TRect;
  RF: TGPRectF;
  GPptsF: array[0..4] of TGPPointF;
  f: double;
  Matrx: TGPMatrix;
  GPBrsh: TGPBrush;
  bmp: TBitmap;
begin
  if (s <> '') and (Assigned(g) or Assigned(aCanvas)) then
  begin
    R := ClientRect;
    InflateRect(R, -3, -3);
    w := R.Right - R.Left;
    h := R.Bottom - R.Top;
    RF := MakeRect(R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top);

    graphics := g;
    if not Assigned(graphics) then
      graphics := TGPGraphics.Create(aCanvas.Handle);
    graphics.SetSmoothingMode(SmoothingModeAntiAlias);
    graphics.SetTextRenderingHint(TextRenderingHintAntiAlias);

    fontFamily:= TGPFontFamily.Create(FCaptchaFont.Name);
    if (fontFamily.Status in [FontFamilyNotFound, FontStyleNotFound]) then
    begin
      fontFamily.Free;
      fontFamily := TGPFontFamily.Create('Arial');
    end;

    fs := IWAdvGDIP.TFontStyle(byte(FCaptchaFont.Style));
    gpfont := TGPFont.Create(fontFamily, FCaptchaFont.Size , fs, UnitPoint);

    stringFormat := TGPStringFormat.Create;
    stringFormat.SetAlignment(StringAlignmentCenter);
    stringFormat.SetLineAlignment(StringAlignmentCenter);
    stringFormat.SetHotkeyPrefix(HotkeyPrefixShow);

    Path := TGPGraphicsPath.Create;
    Path.AddString(s, Length(s), fontFamily, fs, FCaptchaFont.Size, RF, stringFormat);

    GPBrsh := nil;
    case CaptchaCodeTexture of
      ctSolid: GPBrsh := TGPSolidBrush.Create(ColorToARGB(FCaptchaFont.Color));
      ctHatch: GPBrsh := TGPHatchBrush.Create(CaptchaCodeHatchStyle, ColorToARGB(BrightnessColor(FCaptchaFont.Color, 200)), ColorToARGB(FCaptchaFont.Color));
    end;

    case CaptchaCodeStyle of
      csStraight:
      begin
        if Assigned(GPBrsh) then
          graphics.FillPath(GPBrsh, Path);
      end;
      csWave:
      begin
        bmp := TBitmap.Create;
        bmp.Width := w;
        bmp.Height := h;

        bmp.Canvas.Brush.Color := clWhite;
        bmp.Canvas.FillRect(Rect(0, 0, bmp.Width, bmp.Height));

        bmpG := TGPGraphics.Create(bmp.Canvas.Handle);
        //bmpG.SetSmoothingMode(SmoothingModeAntiAlias);
        if Assigned(GPBrsh) then
          bmpG.FillPath(GPBrsh, Path);

        f := -(5 + Random(15));
        ProduceWave(bmp, f);

        DrawGDIPImage(graphics, Canvas, Point(R.Left, R.Top), bmp, True);
        
        bmpG.Free;
        bmp.Free;
      end;
      csFlow:
      begin
        f := 3.6;
        GPPtsF[0].X := 5 + Random(w) / f;
        GPPtsF[0].Y := 5 + Random(h) / f;
        GPPtsF[1].X := w - (Random(w) / f);
        GPPtsF[1].Y := 5 + Random(h) / f;
        GPPtsF[2].X := 5 + Random(w) / f;
        GPPtsF[2].Y := h - (Random(h) / f);
        GPPtsF[3].X := w - (Random(w) / f);
        GPPtsF[3].Y := h - (Random(h) / f);
        GPPtsF[4].X := w div 2 - (Random(w));
        GPPtsF[4].Y := h div 2 - (Random(h));

        Matrx := TGPMatrix.Create;
        Matrx.Translate(0, 0);
        Path.Warp(PGPPointF(@GPPtsF), 5, RF, Matrx, WarpModePerspective{WarpModeBilinear}, 0);
        Matrx.Free;
        
        if Assigned(GPBrsh) then
          graphics.FillPath(GPBrsh, Path);
      end;
    end;

    fontFamily.Free;
    gpfont.Free;
    Path.Free;

    if not Assigned(g) then
      graphics.Free;
  end;
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.GenerateNew;
begin
  //if not (csDesigning in ComponentState) then
  begin
    if (CaptchaType <> ctCustom) then
      FCaptchaCode := GetNewCaptchaCode;
    InternalUpdate;
  end;
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.Paint;
begin
  inherited;
  if FFirstPaint then
  begin
    FArrayInit := False;
    if (csDesigning in ComponentState) then
      GenerateNew;
    FFirstPaint := False;
  end;

  if Assigned(FBitmap) {and not (csDesigning in ComponentState)} then
  begin
    Canvas.Draw(0, 0, FBitmap);
  end;
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.SaveToStream(AStream: TMemoryStream; ImageType: TIWCaptchaImageType = ciJPEG);
var
  JP: TJPEGImage;
begin
  if Assigned(AStream) and Assigned(FBitmap) then
  begin
    case ImageType of
      ciJPEG:
      begin
        jp := TJPEGImage.Create;
        try
          with jp do
          begin
            Assign(FBitmap);
            SaveToStream(AStream);
          end;
        finally
          jp.Free;
        end;
      end;
      ciBMP:
      begin
        FBitmap.SaveToStream(AStream);
      end;
    end;
  end;

end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.SaveToFile(FileName: string; ImageType: TIWCaptchaImageType = ciJPEG);
var
  JP: TJPEGImage;
begin
  if (FileName <> '') and Assigned(FBitmap) then
  begin
    case ImageType of
      ciJPEG:
      begin
        //if (Pos('.jpg', FileName) <= 0) then
          //FileName := FileName + '.jpg';
        jp := TJPEGImage.Create;
        try
          with jp do
          begin
            Assign(FBitmap);
            SaveToFile(FileName);
          end;
        finally
          jp.Free;
        end;
      end;
      ciBMP:
      begin
        if (Pos('.bmp', FileName) <= 0) then
          FileName := FileName + '.bmp';
        FBitmap.SaveToFile(FileName);
      end;
    end;
  end;
end;

{
procedure TIWAdvCaptchaImage.SaveToImage(Filename: String; ImageWidth,
  ImageHeight: integer; ImageType: TIWCaptchaImageType = ciJPEG;);
var
  img, finalimg: graphics.TBitmap;
  gpimg: TGPImage;
  g: TGPGraphics;
  enc: TEncoderParameters;
begin
  img := nil;
  gpimg := nil;
  g := nil;
  finalimg := nil;
  try
    img := graphics.TBitmap.Create;
    img.Width := Width;
    img.Height := Height;

    DrawLabel(img.Canvas);

    finalimg := graphics.TBitmap.Create;
    finalimg.Width := ImageWidth;
    finalimg.Height := ImageHeight;
    finalimg.Canvas.StretchDraw(Bounds(0, 0, ImageWidth, ImageHeight), img);

    gpimg := TGPImage.Create(CreateStream(finalimg));

    enc := GetEncoderQualityParameters(ImageQualityPercentage);

    gpimg.Save(filename, GetCLSID(ImageType), @enc);

  finally
    gpimg.Free;
    finalimg.Free;
    g.Free;
    img.Free;
  end;
end;
}

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.SetAvoidChars(const Value: string);
begin
  if (FAvoidChars <> Value) then
  begin
    FAvoidChars := Value;
    GenerateNew;
  end;
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited;
  //if not (csDesigning in ComponentState) then  
    InternalUpdate;
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.SetCaptchaBackgroundColor(const Value: TColor);
begin
  if (FCaptchaBackgroundColor <> Value) then
  begin
    FCaptchaBackgroundColor := Value;
    InternalUpdate;
  end;
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.SetCaptchaBackgroundColorTo(const Value: TColor);
begin
  if (FCaptchaBackgroundColorTo <> Value) then
  begin
    FCaptchaBackgroundColorTo := Value;
    InternalUpdate;
  end;
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.SetCaptchaCode(const Value: string);
begin
  if (FCaptchaCode <> Value) then
  begin
    FCaptchaCode := Value;
    InternalUpdate;
  end;
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.SetCaptchaCodeHatchStyle(const Value: THatchStyle);
begin
  if (FCaptchaCodeHatchStyle <> Value) then
  begin
    FCaptchaCodeHatchStyle := Value;
    InternalUpdate;
  end;
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.SetCaptchaCodeStyle(const Value: TCaptchaCodeStyle);
begin
  if (FCaptchaCodeStyle <> Value) then
  begin
    FCaptchaCodeStyle := Value;
    InternalUpdate;
  end;
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.SetCaptchaCodeTexture(const Value: TCaptchaCodeTexture);
begin
  if (FCaptchaCodeTexture <> Value) then
  begin
    FCaptchaCodeTexture := Value;
    InternalUpdate;
  end;
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.SetCaptchaFont(const Value: TFont);
begin
  FCaptchaFont.Assign(Value);
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.SetCaptchaLength(const Value: Integer);
begin
  if (FCaptchaLength <> Value) then
  begin
    FCaptchaLength := Value;
    GenerateNew;
  end;
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.SetCaptchaType(const Value: TCaptchaType);
begin
  if (FCaptchaType <> Value) then
  begin
    FCaptchaType := Value;
    GenerateNew;
  end;
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.SetCaptchaBackground(const Value: TCaptchaBackground);
begin
  if (FCaptchaBackground <> Value) then
  begin
    FCaptchaBackground := Value;
    InternalUpdate;
  end;
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.SetShapeAngle(const Value: Integer);
begin
  if (FShapeAngle <> Value) then
  begin
    FShapeAngle := Value;
    InternalUpdate;
  end;
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.SetShapeColor(const Value: TColor);
begin
  if (FShapeColor <> Value) then
  begin
    FShapeColor := Value;
    InternalUpdate;
  end;
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.SetShapeDistance(const Value: Integer);
begin
  if(FShapeDistance <> Value) then
  begin
    FShapeDistance := Value;
    InternalUpdate;
  end;
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.SetShapeOpacity(const Value: TFillOpacity);
begin
  if (FShapeOpacity <> Value) then
  begin
    FShapeOpacity := Value;
    InternalUpdate;
  end;
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.SetShapePenWidth(const Value: Byte);
begin
  if (FShapePenWidth <> Value) then
  begin
    FShapePenWidth := Value;
    InternalUpdate;
  end;
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.SetShapeType(const Value: TCaptchaShapeType);
begin
  if (FShapeType <> Value) then
  begin
    FShapeType := Value;
    FArrayInit := False;
    InternalUpdate;
  end;
end;

//------------------------------------------------------------------------------

procedure TIWAdvCaptchaImage.SetUpperCaseAlpha(const Value: Boolean);
begin
  if (FUpperCaseAlpha <> Value) then
  begin
    FUpperCaseAlpha := Value;
    GenerateNew;
  end;
end;

//------------------------------------------------------------------------------

end.
