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

【问题标题】：Capturing signature very sketchy on touch screen在触摸屏上捕捉签名非常粗略
【发布时间】：2015-08-01 23:59:29
【问题描述】：

我关注a tutorial for capturing signatures in 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.

测试表格：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.

测试表格：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

【问题讨论】：

  • 使用我的代码：fmxexpress.com/cross-platform-firemonkey-drawing-app-demo 我聘请了一位长期的 Delphi 图形开发人员，他想出了如何在触摸屏上实现这一点。
  • @FMXExpress 看起来很有趣，我确信我的特定问题的解决方案隐藏在其中。比我讨价还价的要多一点。
  • @FMXExpress 另外，只是对那篇特定文章的建议。错误很常见，可以说你有它们。只是不要专注于解释错误的文章的一半。这会阻止人们想要使用它。就在最后，提及“顺便说一句，有一个错误……”等。大部分内容应该直接列出功能，并说服读者为什么他们应该继续。
  • 我不知道。我确实知道您正在谈论的问题，因为我遇到了同样的问题并且那里的代码是修复程序。在执行 DrawLine 之前（和之后）对 IFDEF POSIX 部分中的 From 和 To 点进行的任何调整都可以使其工作。如果我的代码只是插入您的代码作为答案，我会将其作为答案而不是评论发布：P 或者，您可以插入 Delphi 多点触控支持，它不是通过 OnMouseMove 而是通过 OnTouch。
  • @JerryDodge 我没有投反对票，但我知道你的意思，那些神秘的投反对票的人应该就他们为什么投反对票或答案提供某种反馈，至少如果这是出于真正的原因你可以退后一步，寻求改进。似乎有更多的用户愿意在这里投反对票然后投赞成票，我注意到每天有很多有效的问题并不值得投反对票，这就是其中之一。然而，我看到一个问题，询问 Delphi 在 Windows 10 上是否工作，当我认为这是糟糕的研究时，它得到了支持，请自己尝试并在其他地方的评论中查看或提问。

标签： ios delphi drawing firemonkey delphi-xe8


【解决方案1】：

完美的解决方案是对签名路径应用“圆角尖角”效果，并使用抗锯齿对其进行渲染。使用 Skia4Delphi 库可以轻松做到这一点：https://github.com/skia4delphi/skia4delphi

即使在库演示本身也有这个例子。看：

【讨论】：

    猜你喜欢
    • 2015-08-12
    • 1970-01-01
    • 1970-01-01
    • 2014-09-02
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多
    热门标签
    Java Python linux javascript Mysql C# Docker 算法 前端 SpringBoot Redis Vue spring 设计模式 .net core .net kubernetes c++ 数据库 数据结构 大数据 js 机器学习 微服务 Android Go 程序员 面试 JVM ASP.net core 云原生 人工智能 后端 PHP git CSS golang k8s Nginx Django mybatis 深度学习 多线程 React 架构 devops 爬虫 云计算 Spring Boot LeetCode