jsvalidcode.pas

销售软件

unit JSValidCode;

interface

uses
  SysUtils,
  Messages,
  Classes,
  Graphics,
  Controls,
  Math;

type
  TJSValidCode = class(TCustomControl)
  private
    m_bmpValidCode: TBitmap;
    m_clBackColor: TColor;
    m_clForeColor: TColor;
    m_sValidCode: string;
    m_nValidCodeLength: Integer;
    m_nTextOutLeft: Integer;
    m_nTextOutTop: Integer;
    m_bParentFont: Boolean;
    procedure pDrawValidCode(cvsValidCode: TCanvas);
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure SetBackColor(const Value: TColor);
    procedure SetForeColor(const Value: TColor);
    procedure SetValidCodeLength(const Value: Integer);
    procedure SetValidCode(const Value: string);
    procedure SetParentFont(const Value: Boolean);
    function GetFont: TFont;
    procedure SetFont(const Value: TFont);
    procedure SetTextOutLeft(const Value: Integer);
    procedure SetTextOutTop(const Value: Integer);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Action;
    property Align;
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property ParentBiDiMode;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop default True;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseActivate;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;

    property ValidCodeLength: Integer
      read m_nValidCodeLength
      write SetValidCodeLength
      default 4;
    property BackColor: TColor
      read m_clBackColor
      write SetBackColor
      default clWhite;
    property ForeColor: TColor
      read m_clForeColor
      write SetForeColor
      default clBlack;
    property ValidCode: string
      read m_sValidCode
      write SetValidCode;
    property Font: TFont
      read GetFont
      write SetFont;
    property ParentFont
      read m_bParentFont
      write SetParentFont
      default False;
    property TextOutLeft: Integer
      read m_nTextOutLeft
      write SetTextOutLeft
      default 4;
    property TextOutTop: Integer
      read m_nTextOutTop
      write SetTextOutTop
      default 4;
    property ValidCodeBitmap: TBitmap
      read m_bmpValidCode;

    procedure Repaint; override;
    function MakeValidCode: string;
    procedure DrawValidCode(cvsValidCode: TCanvas; const sValidCode: string);
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Jerk System', [TJSValidCode]);
end;

{ TJSValidCode }

constructor TJSValidCode.Create(AOwner: TComponent);
begin
  inherited;

  m_sValidCode := EmptyStr;
  m_nValidCodeLength := 4;
  m_nTextOutLeft := 4;
  m_nTextOutTop := 4;
  m_clBackColor := clWhite;
  m_clForeColor := clBlack;
  m_bParentFont := False;
  m_bmpValidCode := TBitmap.Create;

  MakeValidCode;
end;

destructor TJSValidCode.Destroy;
begin
  if m_bmpValidCode <> nil then
    FreeAndNil(m_bmpValidCode);

  inherited;
end;

procedure TJSValidCode.DrawValidCode(cvsValidCode: TCanvas; const sValidCode:
  string);
var
  ch: Char;
  n, nFontSize, nOutLeft, nOutTop: Integer;
begin
  { 画出验证码 }

  // TODO: 填充背景色
  if (Parent <> nil) and (not (csDesigning in ComponentState)) and
    (not (csLoading in ComponentState)) then
    with m_bmpValidCode.Canvas do
    begin
      // TODO: 画背景
      m_bmpValidCode.Width := Self.ClientWidth;
      m_bmpValidCode.Height := Self.ClientHeight;
      Width := Self.ClientWidth;
      Height := Self.ClientHeight;
      Brush.Style := bsSolid;
      Brush.Color := BackColor;
      Pen.Style := psClear;
      Rectangle(0, 0, ClientWidth, ClientHeight);

      // TODO: 设置字体
      Font := Self.Font;

      nOutLeft := m_nTextOutLeft;
      nOutTop := m_nTextOutTop;
      nFontSize := Font.Size;
      for n := 0 to Length(ValidCode) - 1 do
      begin
        ch := ValidCode[n + 1];
        Font.Size := nFontSize + Round(Power(-1, Round(Random(100) + 1)));
        if (Random(100) > 50) and (ch <> 'M') and (ch <> 'W') then
          Font.Style := Font.Style + [fsBold]
        else
          Font.Style := Font.Style - [fsBold];
        if Random(100) > 50 then
          Font.Style := Font.Style + [fsItalic]
        else
          Font.Style := Font.Style - [fsItalic];

        // TODO: 输出文字
        TextOut(nOutLeft, nOutTop, ch);
        Inc(nOutLeft, TextWidth(ch) + Round(TextWidth(ch) / (Random(4) + 2)));
      end;
      Font.Size := nFontSize;

      pDrawValidCode(Canvas);
    end;
end;

function TJSValidCode.GetFont: TFont;
begin
  Result := Canvas.Font;
end;

function TJSValidCode.MakeValidCode: string;
var
  ch: Char;
  n: Integer;
begin
  { 生成验证码 }

  Randomize;
  m_sValidCode := EmptyStr;
  // TODO: 随机生成验证码
  for n := 0 to m_nValidCodeLength - 1 do
  begin
    repeat
      ch := Chr((48) + Round(Random(75)));
    until ((ch >= '1') and (ch <= '9') or (ch >= 'a') and (ch <= 'z') and (ch <>
      'o'));
    m_sValidCode := m_sValidCode + ch;
  end;
  m_sValidCode := UpperCase(m_sValidCode);

  // 画出验证码
  DrawValidCode(Canvas, m_sValidCode);

  Result := m_sValidCode;
end;

procedure TJSValidCode.pDrawValidCode(cvsValidCode: TCanvas);
begin
  cvsValidCode.CopyRect(Rect(0, 0, m_bmpValidCode.Width, m_bmpValidCode.Height),
    m_bmpValidCode.Canvas, Rect(0, 0, m_bmpValidCode.Width,
    m_bmpValidCode.Height));
end;

procedure TJSValidCode.Repaint;
begin
  inherited;

  pDrawValidCode(Canvas);
end;

procedure TJSValidCode.SetBackColor(const Value: TColor);
begin
  m_clBackColor := Value;
  if m_sValidCode <> EmptyStr then
    DrawValidCode(Canvas, m_sValidCode);
end;

procedure TJSValidCode.SetFont(const Value: TFont);
begin
  Canvas.Font := Value;
  ForeColor := Value.Color;
  if m_sValidCode <> EmptyStr then
    DrawValidCode(Canvas, m_sValidCode);
end;

procedure TJSValidCode.SetForeColor(const Value: TColor);
begin
  m_clForeColor := Value;
  Font.Color := Value;
  if m_sValidCode <> EmptyStr then
    DrawValidCode(Canvas, m_sValidCode);
end;

procedure TJSValidCode.SetParentFont(const Value: Boolean);
begin
  m_bParentFont := Value;
  //if Value then
  //  Canvas.Font:=inhertied Font;
end;

procedure TJSValidCode.SetTextOutLeft(const Value: Integer);
begin
  m_nTextOutLeft := Value;
end;

procedure TJSValidCode.SetTextOutTop(const Value: Integer);
begin
  m_nTextOutTop := Value;
end;

procedure TJSValidCode.SetValidCode(const Value: string);
begin
  m_sValidCode := Value;
  if m_sValidCode <> EmptyStr then
    DrawValidCode(Canvas, m_sValidCode);
end;

procedure TJSValidCode.SetValidCodeLength(const Value: Integer);
begin
  m_nValidCodeLength := Value;
  MakeValidCode;
end;

procedure TJSValidCode.WMPaint(var Message: TWMPaint);
begin
  inherited;

  if (Parent <> nil) and (not (csDesigning in ComponentState)) and
    (not (csLoading in ComponentState)) then
    if m_bmpValidCode <> nil then
      pDrawValidCode(Canvas);
end;

procedure TJSValidCode.WMSize(var Message: TWMSize);
begin
  if m_sValidCode <> EmptyStr then
    DrawValidCode(Canvas, m_sValidCode);
end;

end.