TPaintBox ile Fotoğrafta Çizim Yapma

FireMonkey ve Mobil uygulama (iOS, Android, Windows Phone) ile ilgili sorularınızı bu foruma sorabilirsiniz.
Cevapla
kajmerantime
Üye
Mesajlar: 2
Kayıt: 02 Eki 2023 03:47

TPaintBox ile Fotoğrafta Çizim Yapma

Mesaj gönderen kajmerantime »

Delphi 11 Fmx'te bir proje geliştiriyoruz. Dosya yükleme ve Editleme kısmına ben bakıyorum.

TakePhotoFromAction ile çektiğim fotoğrafı Image içine atıyorum. Daha sonra TPaintbox toolsunun MouseDown, MouseUp, MouseMove özelliklerini kullanarak çizim işlemini yaptırıyorum. Android için ise PaintBox'un OnGesture olayının "Pan" özelliğini kullanıyorum.

Windowsta çizim işlemi tam istediğim gibi oluyor fakat Androide geçtiğimde önce çiziyorum sonradan çizgiler görünüyor. Başı ve sonu belli olduğunda çizgiyi çiziyor. Ben dokunduğum gibi senkronize olarak çizim yapmıyor. Ayrıca Android cihazda çizim yaparken Image direk siliniyor.

Kodum şu şekilde:

unit Unit1;

interface

uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls, FMX.Objects,
FMX.Gestures;

type
TForm1 = class(TForm)

imgDrawing: TImage;
PaintBox1: TPaintBox;
GestureManager1: TGestureManager;
// procedure imgDrawingGesture(Sender: TObject; const EventInfo: TGestureEventInfo; var Handled: Boolean);
procedure FormCreate(Sender: TObject);
procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Single);
procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Single);
procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Single);
procedure PaintBox1Gesture(Sender: TObject;
const EventInfo: TGestureEventInfo; var Handled: Boolean);

private
{ Private declarations }
IsDrawing: Boolean;
LastX, LastY: Single;
Bitmap: TBitmap;
Canvas: TCanvas;
Drawing: Boolean;
FStartPoint: TPointF;
DrawingBitmap: TBitmap;
public
{ Public declarations }
end;

var
Form1: TForm1;
Drawing : Boolean;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
begin
Drawing := False;
LastX := 0;
LastY := 0;

Bitmap := TBitmap.Create;
Bitmap.SetSize(Round(imgDrawing.Width), Round(imgDrawing.Height));
Bitmap.Clear(TAlphaColorRec.Null);
end;

procedure TForm1.PaintBox1Gesture(Sender: TObject;
const EventInfo: TGestureEventInfo; var Handled: Boolean);
begin
if EventInfo.GestureID = igiPan then
begin
imgDrawing.Visible := True;
if EventInfo.Flags = [TInteractiveGestureFlag.gfBegin] then
begin
imgDrawing.Visible := True;
// Pan hareketi başladığında çizim işlemini başlatın
PaintBox1.Canvas.BeginScene;
PaintBox1.Canvas.Stroke.Color := TAlphaColorRec.Yellow;
PaintBox1.Canvas.Stroke.Thickness := 10;
end
else if EventInfo.Flags = [TInteractiveGestureFlag.gfEnd] then
begin
imgDrawing.Visible := True;
// Pan hareketi bittiğinde çizim işlemini sonlandırın
PaintBox1.Canvas.EndScene;
end
else
begin
imgDrawing.Visible := True;
// Pan hareketi devam ederken çizim yapın
PaintBox1.Canvas.DrawLine(EventInfo.Location, EventInfo.Location, 1);
end;
Handled := True;
end;
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Single);
begin
Drawing := True;
LastX := X;
LastY := Y;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Single);
begin
if Drawing then
begin
imgDrawing.Canvas.BeginScene;
try
PaintBox1.Canvas.Stroke.Color := TAlphaColorRec.Yellow;
PaintBox1.Canvas.Stroke.Thickness := 10;
PaintBox1.Canvas.DrawLine(TPointF.Create(LastX, LastY), TPointF.Create(X, Y), 1);
finally
imgDrawing.Canvas.EndScene;
end;
LastX := X;
LastY := Y;
end;
end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Single);
begin
Drawing := False;
end;

end.
Cevapla