Delphi制作手机签名app(windows同样适用)
功能
Delphi开发手机签名app
主要代码
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.