I am trying to make a signature pad with Delphi 10.3 FMX. My understanding is that I should handle the OnMouseMove event, first setting coordinate in the OnMouseDown event, and then use the DrawLine() method.
So far I managed this:
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.
When I run it on my mobile (Android) and press on its screen, the whole screen becomes black. Why is that? How can I make simple freehand drawing app?
I've listened to Xylem's advice and switched to TImage control like this:
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.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With