gpt4 book ai didi

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

转载 作者:行者123 更新时间:2023-12-04 07:58:55 28 4
gpt4 key购买 nike

我正在尝试使用 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)上运行它并按下它的屏幕时,整个屏幕变黑。这是为什么?如何制作简单的手绘应用程序?

最佳答案

我听了 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.

关于delphi - 如何在 TPaintBox(或任何其他控件)上徒手绘制?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/66567007/

28 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com