delphi - 如何在 TPaintBox(或任何其他控件)上徒手绘制？

Question

我正在尝试使用 Delphi 10.3 FMX 制作签名板。我的理解是，我应该处理 OnMouseMove 事件，首先在 OnMouseDown 事件中设置坐标，然后使用 DrawLine() 方法。

到目前为止我做到了:

unit HeaderFooterFormwithNavigation;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Graphics, FMX.Forms, FMX.Dialogs, FMX.TabControl,
  System.Actions, FMX.ActnList, FMX.Objects, FMX.StdCtrls,
  FMX.Controls.Presentation, FMX.Edit;

type
  THeaderFooterwithNavigation = class(TForm)
    ActionList1: TActionList;
    PreviousTabAction1: TPreviousTabAction;
    TitleAction: TControlAction;
    NextTabAction1: TNextTabAction;
    TopToolBar: TToolBar;
    btnBack: TSpeedButton;
    ToolBarLabel: TLabel;
    btnNext: TSpeedButton;
    TabControl1: TTabControl;
    TabItem1: TTabItem;
    TabItem2: TTabItem;
    BottomToolBar: TToolBar;
    pb1: TPaintBox;
    edt1: TEdit;
    edt2: TEdit;
    edt3: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure TitleActionUpdate(Sender: TObject);
    procedure FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);
    procedure pb1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
    procedure pb1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  HeaderFooterwithNavigation: THeaderFooterwithNavigation;
  _lastPoint: TPointF;

implementation

{$R *.fmx}
{$R *.LgXhdpiPh.fmx ANDROID}
{$R *.iPhone4in.fmx IOS}

procedure THeaderFooterwithNavigation.TitleActionUpdate(Sender: TObject);
begin
  if Sender is TCustomAction then
  begin
    if TabControl1.ActiveTab <> nil then
      TCustomAction(Sender).Text := TabControl1.ActiveTab.Text
    else
      TCustomAction(Sender).Text := '';
  end;
end;

procedure THeaderFooterwithNavigation.FormCreate(Sender: TObject);
begin
  { This defines the default active tab at runtime }
  TabControl1.First(TTabTransition.None);
end;

procedure THeaderFooterwithNavigation.FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);
begin
  if (Key = vkHardwareBack) and (TabControl1.TabIndex <> 0) then
  begin
    TabControl1.First;
    Key := 0;
  end;
end;

procedure THeaderFooterwithNavigation.pb1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  _lastPoint.X := X;
  _lastPoint.Y := Y;
end;

procedure THeaderFooterwithNavigation.pb1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
var
  thisPoint: TPointF;
  brush: TStrokeBrush;
begin
  if pb1.Canvas.BeginScene then
  try
    pb1.Canvas.Stroke.Thickness := 2;
    pb1.Canvas.Stroke.Kind := TBrushKind.Solid;
    pb1.Canvas.Stroke.Color := TAlphaColors.Black;

    thisPoint.X := X;
    thisPoint.Y := Y;
    pb1.Canvas.DrawLine(_lastPoint, thisPoint, 1);
    _lastPoint := thisPoint;
  finally
    pb1.Canvas.EndScene;
  end;

end;

end.

当我在手机(Android)上运行它并按其屏幕时，整个屏幕变黑。这是为什么？如何制作简单的徒手画应用程序？

Answer 1

我听取了 Xylem 的建议并切换到 TImage 控件，如下所示:

unit HeaderFooterFormwithNavigation;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Graphics, FMX.Forms, FMX.Dialogs, FMX.TabControl,
  System.Actions, FMX.ActnList, FMX.Objects, FMX.StdCtrls,
  FMX.Controls.Presentation, FMX.Edit;

type
  THeaderFooterwithNavigation = class(TForm)
    ActionList1: TActionList;
    PreviousTabAction1: TPreviousTabAction;
    TitleAction: TControlAction;
    NextTabAction1: TNextTabAction;
    TopToolBar: TToolBar;
    btnBack: TSpeedButton;
    ToolBarLabel: TLabel;
    btnNext: TSpeedButton;
    TabControl1: TTabControl;
    TabItem1: TTabItem;
    TabItem2: TTabItem;
    BottomToolBar: TToolBar;
    img1: TImage;
    btnClear: TButton;
    procedure FormCreate(Sender: TObject);
    procedure TitleActionUpdate(Sender: TObject);
    procedure FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);
    procedure img1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
    procedure img1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure img1Tap(Sender: TObject; const Point: TPointF);
    procedure img1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure btnClearClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  HeaderFooterwithNavigation: THeaderFooterwithNavigation;
  _lastPoint: TPointF;
  _down: Boolean;

implementation

{$R *.fmx}
{$R *.LgXhdpiPh.fmx ANDROID}
{$R *.iPhone4in.fmx IOS}

procedure THeaderFooterwithNavigation.TitleActionUpdate(Sender: TObject);
begin
  if Sender is TCustomAction then
  begin
    if TabControl1.ActiveTab <> nil then
      TCustomAction(Sender).Text := TabControl1.ActiveTab.Text
    else
      TCustomAction(Sender).Text := '';
  end;
end;

procedure THeaderFooterwithNavigation.btnClearClick(Sender: TObject);
begin
  img1.Bitmap.Clear(TAlphaColorRec.White);
end;

procedure THeaderFooterwithNavigation.FormCreate(Sender: TObject);
begin
  { This defines the default active tab at runtime }
  img1.Bitmap := TBitmap.Create(round(img1.Width), round(img1.Height));
  img1.Bitmap.Clear(TAlphaColorRec.White);
  TabControl1.First(TTabTransition.None);
end;

procedure THeaderFooterwithNavigation.FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);
begin
  if (Key = vkHardwareBack) and (TabControl1.TabIndex <> 0) then
  begin
    TabControl1.First;
    Key := 0;
  end;
end;

procedure THeaderFooterwithNavigation.img1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  _lastPoint.X := X;
  _lastPoint.Y := Y;
  _down:=True;
end;

procedure THeaderFooterwithNavigation.img1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Single);
  var
  thisPoint: TPointF;
begin
  if _down then
  begin
  thisPoint.X := X;
  thisPoint.Y := Y;
  with img1.Bitmap.Canvas do
  begin
    BeginScene;
    Stroke.Thickness := 5;
    Stroke.Kind := TBrushKind.Solid;
    Stroke.Color := TAlphaColors.Black;
    DrawLine(_lastPoint, thisPoint, 1);
    EndScene;
  end;

  _lastPoint := thisPoint;
  end;

end;

procedure THeaderFooterwithNavigation.img1MouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  _down:=false;
end;

procedure THeaderFooterwithNavigation.img1Tap(Sender: TObject;
  const Point: TPointF);
begin
  _down:=True;
  _lastPoint := Point;
end;

end.