Delphi制作手机签名app(windows同样适用)


本文整理自网络,侵删。

 

unit Unit2;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes,
  System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.Layouts,
  System.Generics.Collections;

type
  TSignature = Record
    PositionCursor: TPointF;
    PosState: Byte;
  End;

  TForm2 = class(TForm)
    rect_Signature: TRectangle;
    btn_ok: TSpeedButton;
    Layout1: TLayout;
    btn_voltar: TSpeedButton;
    Label1: TLabel;
    img_temp: TImage;
    btn_clear: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btn_clearClick(Sender: TObject);
    procedure btn_voltarClick(Sender: TObject);
    procedure btn_okClick(Sender: TObject);
    procedure rect_SignatureMouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Single);
    procedure rect_SignatureMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure rect_SignaturePaint(Sender: TObject; Canvas: TCanvas;
      const ARect: TRectF);
  private
    { Private declarations }
  public
    { Public declarations }
    Sign: TList<TSignature>;
    botao: boolean;
    procedure AddPoint(const X, Y: Single; const state: Byte);
  end;

var
  Form2: TForm2;

implementation

{$R *.fmx}

uses Unit1;

{ TForm2 }

procedure TForm2.AddPoint(const X, Y: Single; const state: Byte);
var
  p: TSignature;
begin
  p.PositionCursor := PointF(X, Y);
  p.PosState := state;

  if Sign.Count - 1 < 0 then
    p.PosState := 0;

  if p.PosState <> 1 then
    Sign.Add(p)
  else if p.PositionCursor.Distance(Sign.Last.PositionCursor) > 0.8 then
    Sign.Add(p);

  rect_Signature.Repaint;
end;

procedure TForm2.btn_clearClick(Sender: TObject);
begin
  Sign.Clear;
  rect_Signature.Repaint;
end;

procedure TForm2.btn_okClick(Sender: TObject);
begin
  // 旋转签名...
  img_temp.RotationAngle := 0;
  img_temp.Bitmap := rect_Signature.MakeScreenshot;
  img_temp.Bitmap.Rotate(90);

  // 发送签名到Form1...
  form1.img_assinatura.Bitmap.Assign(img_temp.MakeScreenshot);
  close;
end;

procedure TForm2.btn_voltarClick(Sender: TObject);
begin
  Sign.Clear;
  close;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  Sign := TList<TSignature>.Create;
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
  FreeAndNil(Sign);
end;

procedure TForm2.FormShow(Sender: TObject);
begin
  Sign.Clear;
end;

procedure TForm2.rect_SignatureMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Single);
begin
  // 如果按下...
  if ssLeft in Shift then
  begin
    if NOT botao then
    begin
      // 拖动开始画...
      AddPoint(X, Y, 0);
      botao := true;
    end
    else
      AddPoint(X, Y, 1);
  end;
end;

procedure TForm2.rect_SignatureMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  botao := false;
  AddPoint(X, Y, 2);
end;

procedure TForm2.rect_SignaturePaint(Sender: TObject; Canvas: TCanvas;
  const ARect: TRectF);
var
  p: TSignature;
  p1, p2: TPointF;
begin
  if NOT(Sign.Count - 1 > 0) then
    exit;

  Canvas.Stroke.Kind := TBrushKind.Solid;
  Canvas.Stroke.Dash := TStrokeDash.Solid;
  Canvas.Stroke.Thickness := 4;
  Canvas.Stroke.Color := TAlphaColorRec.Darkblue;

  for p in Sign do
  begin
    case p.PosState of
      0:
        p1 := p.PositionCursor;
      1:
        begin
          p2 := p.PositionCursor;
          Canvas.DrawLine(p1, p2, 1, Canvas.Stroke);
          p1 := p.PositionCursor;
        end;
      2:
        begin
          p2 := p.PositionCursor;
          Canvas.DrawLine(p1, p2, 1, Canvas.Stroke);
        end;
    end;
  end;
end;

end.

相关阅读 >>

Delphi之memo组件

Delphi char string

Delphi 延迟时间函数

Delphi unigrid记录check遍历

Delphi 在vcl中显示一个非激活状态的窗口

Delphi rs232c串行通讯接口的应用

Delphi console程序中一种定时方法

Delphi xe6 android拨号函数

Delphi 百度输入提示 Delphi 实现

Delphi 判断网站文件是否存在

更多相关阅读请进入《Delphi》频道 >>



打赏

取消

感谢您的支持,我会继续努力的!

扫码支持
扫码打赏,您说多少就多少

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

评论

管理员已关闭评论功能...