在触摸屏上捕捉签名非常粗略

我遵循一个教程来捕获在Firemonkey中的签名 ，并做了一些重大的修改（本质上是重写）封装在自定义控件中。 我在VCL写了很多控件，但是这是我第一次使用FMX。

当使用鼠标（Windows或OS X）时，它完美的工作。 但是，使用触摸屏（iOS）时，变得非常粗略。 具体来说，它会持续捕获鼠标事件（或在此情况下，“笔”）。 所以一条直线变成了一条虚线。 这是MouseUp在触摸屏上滑动手指时反复发射的直接结果。

视窗：

iOS版：

当手指没有从触摸屏上抬起时，我怎样才能防止它“捕捉”事件？

控制单元： VectorSignature.pas

 unit VectorSignature; interface uses System.Classes, System.SysUtils, System.Types, System.UITypes, System.Generics.Collections, FMX.Controls, FMX.Objects, FMX.Graphics, FMX.Types; type TSignatureControl = class; TVectorState = (vsPenDown, vsPenMove, vsPenUp); TVectorPoint = record CurPos: TPointF; State: TVectorState; end; TVectorEvent = procedure(Sender: TObject; Point: TVectorPoint) of object; TSignatureControl = class(TShape) private FText: TText; FPoints: TList<TVectorPoint>; FPenDown: Boolean; FCorners: TCorners; FSensitivity: Single; FOnPenDown: TVectorEvent; FOnPenUp: TVectorEvent; FOnPenMove: TVectorEvent; FOnClear: TNotifyEvent; FOnChange: TNotifyEvent; function GetPoint(Index: Integer): TVectorPoint; function IsCornersStored: Boolean; procedure SetSensitivity(const Value: Single); procedure SetPromptText(const Value: String); function GetPromptText: String; protected procedure SetCorners(const Value: TCorners); virtual; procedure Paint; override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; procedure MouseMove(Shift: TShiftState; X, Y: Single); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Clear; function Count: Integer; procedure AddPoint(const X, Y: Single; State: TVectorState); function LastPoint: TVectorPoint; function State: TVectorState; procedure PaintTo(ACanvas: TCanvas; const Scale: Single = 1.0); function MaxDims(const Scale: Single = 1.0): TPointF; property Points[Index: Integer]: TVectorPoint read GetPoint; default; published property Align; property Anchors; property ClipChildren default False; property ClipParent default False; property Corners: TCorners read FCorners write SetCorners stored IsCornersStored; property Cursor default crDefault; property DragMode default TDragMode.dmManual; property EnableDragHighlight default True; property Enabled default True; property Fill; property Locked default False; property Height; property HitTest default True; property Padding; property Opacity; property Margins; property PopupMenu; property Position; property PromptText: String read GetPromptText write SetPromptText; property RotationAngle; property RotationCenter; property Scale; property Sensitivity: Single read FSensitivity write SetSensitivity; property Size; property Stroke; property Visible default True; property Width; {Drag and Drop events} property OnDragEnter; property OnDragLeave; property OnDragOver; property OnDragDrop; property OnDragEnd; {Mouse events} property OnPenDown: TVectorEvent read FOnPenDown write FOnPenDown; property OnPenUp: TVectorEvent read FOnPenUp write FOnPenUp; property OnPenMove: TVectorEvent read FOnPenMove write FOnPenMove; property OnClear: TNotifyEvent read FOnClear write FOnClear; property OnChange: TNotifyEvent read FOnChange write FOnChange; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnMouseWheel; property OnMouseEnter; property OnMouseLeave; property OnPainting; property OnPaint; property OnResize; end; implementation uses Math; function GetDrawingShapeRectAndSetThickness(const AShape: TShape; const Fit: Boolean; var FillShape, DrawShape: Boolean; var StrokeThicknessRestoreValue: Single): TRectF; const MinRectAreaSize = 0.01; begin FillShape := (AShape.Fill <> nil) and (AShape.Fill.Kind <> TBrushKind.None); DrawShape := (AShape.Stroke <> nil) and (AShape.Stroke.Kind <> TBrushKind.None); if Fit then Result := TRectF.Create(0, 0, 1, 1).FitInto(AShape.LocalRect) else Result := AShape.LocalRect; if DrawShape then begin if Result.Width < AShape.Stroke.Thickness then begin StrokeThicknessRestoreValue := AShape.Stroke.Thickness; FillShape := False; AShape.Stroke.Thickness := Min(Result.Width, Result.Height); Result.Left := (Result.Right + Result.Left) * 0.5; Result.Right := Result.Left + MinRectAreaSize; end else Result.Inflate(-AShape.Stroke.Thickness * 0.5, 0); if Result.Height < AShape.Stroke.Thickness then begin if StrokeThicknessRestoreValue < 0.0 then StrokeThicknessRestoreValue := AShape.Stroke.Thickness; FillShape := False; AShape.Stroke.Thickness := Min(Result.Width, Result.Height); Result.Top := (Result.Bottom + Result.Top) * 0.5; Result.Bottom := Result.Top + MinRectAreaSize; end else Result.Inflate(0, -AShape.Stroke.Thickness * 0.5); end; end; { TSignatureControl } constructor TSignatureControl.Create(AOwner: TComponent); begin inherited; FPoints:= TList<TVectorPoint>.Create; FCorners := [TCorner.TopRight]; FSensitivity:= 12.0; Fill.Kind:= TBrushKind.None; Margins.Left:= 8; Margins.Top:= 8; Margins.Right:= 8; Margins.Bottom:= 8; Stroke.Thickness:= 2; Stroke.Dash:= TStrokeDash.Dash; Stroke.Color:= TAlphaColorRec.Gray; FText:= TText.Create(Self); FText.Parent:= Self; FText.Align:= TAlignLayout.Bottom; FText.Height:= 40; FText.Visible:= True; FText.HitTest:= False; FText.TextSettings.HorzAlign:= TTextAlign.Center; FText.TextSettings.VertAlign:= TTextAlign.Center; FText.TextSettings.FontColor:= TAlphaColorRec.Navy; FText.TextSettings.Font.Size:= 14; FText.TextSettings.Font.Style:= [TFontStyle.fsBold]; PromptText:= 'Please sign above'; end; destructor TSignatureControl.Destroy; begin FreeAndNil(FText); FreeAndNil(FPoints); inherited; end; procedure TSignatureControl.Clear; begin FPoints.Clear; Repaint; if Assigned(FOnClear) then FOnClear(Self); if Assigned(FOnChange) then FOnChange(Self); end; function TSignatureControl.Count: Integer; begin Result:= FPoints.Count; end; function TSignatureControl.GetPoint(Index: Integer): TVectorPoint; begin Result:= FPoints[Index]; end; function TSignatureControl.GetPromptText: String; begin Result:= FText.Text; end; procedure TSignatureControl.SetPromptText(const Value: String); begin FText.Text:= Value; Repaint; end; procedure TSignatureControl.SetSensitivity(const Value: Single); begin FSensitivity := Value; Repaint; end; function TSignatureControl.State: TVectorState; begin Result:= LastPoint.State; end; function TSignatureControl.IsCornersStored: Boolean; begin Result := FCorners <> AllCorners; end; function TSignatureControl.LastPoint: TVectorPoint; begin Result:= FPoints.Last; end; procedure TSignatureControl.AddPoint(const X, Y: Single; State: TVectorState); var P: TVectorPoint; D: Single; begin P.CurPos:= PointF(X, Y); //Be sure to start with pen down event if Count = 0 then P.State:= vsPenDown else P.State:= State; case State of vsPenDown: begin //Always add pen down FPoints.Add(P); if Assigned(FOnPenDown) then FOnPenDown(Self, P); end; vsPenMove: begin D:= P.CurPos.Distance(FPoints.Last.CurPos); if D >= FSensitivity then begin //Only add new point if it is at least sensitivity distance from last point FPoints.Add(P); if Assigned(FOnPenMove) then FOnPenMove(Self, P); end; end; vsPenUp: begin //Always add pen up FPoints.Add(P); if Assigned(FOnPenUp) then FOnPenUp(Self, P); end; end; if Assigned(FOnChange) then FOnChange(Self); Repaint; end; function TSignatureControl.MaxDims(const Scale: Single = 1.0): TPointF; const SIGN_PADDING = 10; var P: TVectorPoint; begin Result.X:= SIGN_PADDING; Result.Y:= SIGN_PADDING; for P in FPoints do begin if (P.CurPos.X ) > (Result.X ) then Result.X:= P.CurPos.X ; if (P.CurPos.Y ) > (Result.Y ) then Result.Y:= P.CurPos.Y ; end; Result.X:= (Result.X + SIGN_PADDING) * Scale; Result.Y:= (Result.Y + SIGN_PADDING) * Scale; end; procedure TSignatureControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin FPenDown:= True; AddPoint(X, Y, vsPenDown); inherited; end; procedure TSignatureControl.MouseMove(Shift: TShiftState; X, Y: Single); begin if ssLeft in Shift then begin if FPenDown then begin AddPoint(X, Y, vsPenMove); end; end; inherited; end; procedure TSignatureControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin FPenDown:= False; AddPoint(X, Y, vsPenUp); inherited; end; procedure TSignatureControl.PaintTo(ACanvas: TCanvas; const Scale: Single = 1.0); var P: TVectorPoint; P1, P2: TPointF; procedure SetP1(P: TPointF); begin P1:= P; P1.X:= P1.X * Scale; P1.Y:= P1.Y * Scale; end; procedure SetP2(P: TPointF); begin P2:= P; P2.X:= P2.X * Scale; P2.Y:= P2.Y * Scale; end; begin if not (Count-1 > 0) then Exit; ACanvas.BeginScene; try ACanvas.Stroke.Kind:= TBrushKind.Solid; ACanvas.Stroke.Dash:= TStrokeDash.Solid; ACanvas.Stroke.Thickness:= (4 * Scale); ACanvas.Stroke.Cap:= TStrokeCap.Round; ACanvas.Stroke.Color:= TAlphaColorRec.Darkblue; for P in FPoints do begin case P.State of vsPenDown: begin SetP1(P.CurPos); end; vsPenMove: begin SetP2(P.CurPos); ACanvas.DrawLine(P1, P2, 1, ACanvas.Stroke); SetP1(P.CurPos); end; vsPenUp: begin SetP2(P.CurPos); ACanvas.DrawLine(P1, P2, 1, ACanvas.Stroke); end; end; end; finally ACanvas.EndScene; end; end; procedure TSignatureControl.SetCorners(const Value: TCorners); begin if FCorners <> Value then begin FCorners := Value; Repaint; end; end; procedure TSignatureControl.Paint; var Radius: Single; R: TRectF; StrokeThicknessRestoreValue: Single; FillShape, DrawShape: Boolean; P1, P2: TPointF; begin StrokeThicknessRestoreValue := Stroke.Thickness; try R := GetDrawingShapeRectAndSetThickness(Self, False, FillShape, DrawShape, StrokeThicknessRestoreValue); if Height < Width then Radius := R.Height / 2 else Radius := R.Width / 2; if FillShape then Canvas.FillRect(R, Radius, Radius, FCorners, AbsoluteOpacity, Fill); if DrawShape then Canvas.DrawRect(R, Radius, Radius, FCorners, AbsoluteOpacity, Stroke); //Signature Underline P1:= PointF(Margins.Left, Height - 40); P2:= PointF(Width - Margins.Right, Height - 40); Canvas.DrawLine(P1, P2, 1.0); finally if StrokeThicknessRestoreValue <> Stroke.Thickness then Stroke.Thickness := StrokeThicknessRestoreValue; end; PaintTo(Canvas); end; end. 

testingforms： uMain.pas

 unit uMain; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, System.Generics.Collections, VectorSignature, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects, FMX.Layouts, FMX.StdCtrls, FMX.Controls.Presentation, FMX.Memo, FMX.ScrollBox; type TForm1 = class(TForm) Layout1: TLayout; imgPreview: TRectangle; Panel1: TPanel; Memo1: TMemo; cmdClear: TButton; procedure imgPreviewClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure cmdClearClick(Sender: TObject); procedure imgPreviewPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF); private FSignature: TSignatureControl; procedure PenDown(Sender: TObject; Point: TVectorPoint); procedure PenMove(Sender: TObject; Point: TVectorPoint); procedure PenUp(Sender: TObject; Point: TVectorPoint); procedure SignatureClear(Sender: TObject); procedure SignatureChange(Sender: TObject); public end; var Form1: TForm1; implementation {$R *.fmx} uses System.IOUtils; { TForm1 } procedure TForm1.FormCreate(Sender: TObject); begin ReportMemoryLeaksOnShutdown:= True; FSignature:= TSignatureControl.Create(nil); FSignature.Parent:= Self; FSignature.Align:= TAlignLayout.Bottom; FSignature.Height:= 200; FSignature.OnPenDown:= PenDown; FSignature.OnPenMove:= PenMove; FSignature.OnPenUp:= PenUp; FSignature.OnClear:= SignatureClear; FSignature.OnChange:= SignatureChange; end; procedure TForm1.FormDestroy(Sender: TObject); begin FreeAndNil(FSignature); end; procedure TForm1.cmdClearClick(Sender: TObject); begin FSignature.Clear; end; procedure TForm1.imgPreviewClick(Sender: TObject); const SAVE_SCALE = 8.0; var B: TBitmap; FN: String; Dims: TPointF; begin FN:= TPath.Combine(TPath.GetPicturesPath, 'Test.png'); Dims:= FSignature.MaxDims(SAVE_SCALE); B:= TBitmap.Create(Trunc(Dims.X), Trunc(Dims.Y)); try FSignature.PaintTo(B.Canvas, SAVE_SCALE); B.SaveToFile(FN); finally FreeAndNil(B); end; end; procedure TForm1.imgPreviewPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF); begin FSignature.PaintTo(Canvas, 0.4); end; procedure TForm1.SignatureChange(Sender: TObject); begin imgPreview.Repaint; end; procedure TForm1.PenDown(Sender: TObject; Point: TVectorPoint); begin {$IFNDEF MACOS} Memo1.Lines.Add('Pen Down: '+FormatFloat('0', Point.CurPos.X)+' x '+ FormatFloat('0', Point.CurPos.Y)); {$ENDIF} end; procedure TForm1.PenMove(Sender: TObject; Point: TVectorPoint); begin {$IFNDEF MACOS} Memo1.Lines.Add('Pen Move: '+FormatFloat('0', Point.CurPos.X)+' x '+ FormatFloat('0', Point.CurPos.Y)); {$ENDIF} end; procedure TForm1.PenUp(Sender: TObject; Point: TVectorPoint); begin {$IFNDEF MACOS} Memo1.Lines.Add('Pen Up: '+FormatFloat('0', Point.CurPos.X)+' x '+ FormatFloat('0', Point.CurPos.Y)); {$ENDIF} end; procedure TForm1.SignatureClear(Sender: TObject); begin {$IFNDEF MACOS} Memo1.Lines.Clear; {$ENDIF} end; end. 

testingforms： uMain.fmx

 object Form1: TForm1 Left = 0 Top = 0 Caption = 'Signature Capture Test' ClientHeight = 600 ClientWidth = 456 Position = ScreenCenter FormFactor.Width = 320 FormFactor.Height = 480 FormFactor.Orientations = [Portrait] FormFactor.Devices = [Desktop] OnCreate = FormCreate OnDestroy = FormDestroy DesignerMasterStyle = 0 object Layout1: TLayout Align = Client Size.Width = 456.000000000000000000 Size.Height = 600.000000000000000000 Size.PlatformDefault = False TabOrder = 0 object imgPreview: TRectangle Align = Top Margins.Left = 5.000000000000000000 Margins.Top = 5.000000000000000000 Margins.Right = 5.000000000000000000 Margins.Bottom = 5.000000000000000000 Position.X = 5.000000000000000000 Position.Y = 5.000000000000000000 Size.Width = 446.000000000000000000 Size.Height = 84.000000000000000000 Size.PlatformDefault = False OnClick = imgPreviewClick OnPaint = imgPreviewPaint end object Panel1: TPanel Align = Client Size.Width = 456.000000000000000000 Size.Height = 506.000000000000000000 Size.PlatformDefault = False TabOrder = 2 object Memo1: TMemo Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] DataDetectorTypes = [] ReadOnly = True StyledSettings = [Size, Style, FontColor] TextSettings.Font.Family = 'Consolas' Align = Top Anchors = [akLeft, akTop, akRight, akBottom] Margins.Left = 8.000000000000000000 Margins.Right = 8.000000000000000000 Margins.Bottom = 8.000000000000000000 Position.X = 8.000000000000000000 Size.Width = 440.000000000000000000 Size.Height = 466.000000000000000000 Size.PlatformDefault = False TabOrder = 2 Viewport.Width = 436.000000000000000000 Viewport.Height = 462.000000000000000000 end object cmdClear: TButton Anchors = [akLeft, akBottom] Position.X = 8.000000000000000000 Position.Y = 470.000000000000000000 Size.Width = 97.000000000000000000 Size.Height = 33.000000000000000000 Size.PlatformDefault = False TabOrder = 1 Text = 'Clear' OnClick = cmdClearClick end end end end