Johansy 2 Posted June 25, 2023 Greetings to all here! Could you help me find a component for Delphi that works as an image cropper for Android, something like this: ArthurHub/Android-Image-Cropper: Image Cropping Library for Android, optimized for Camera / Gallery. (github.com) Thank you very much in advance. Share this post Link to post
programmerdelphi2k 237 Posted June 26, 2023 (edited) @Johansy in fact, you dont needs any 3rd components, you can use native controls in FMX RAD.. RAD 11.3 1 TImage to load original image / 1 to preview / 1 to cropping (for my tests) 1 TSelection to "select your area" on screen (in case, in my TImage Original image) a little code to work! if needs more actions, just do it... for example: rotations, Image1.RotationAngle := 90; ... when cropping you needs rotate the values in Rect( L,T, R, B) etc... nothing complicated at all. for "Position" on Preview or Cropping TImage, just use the coordenates X,Y... not "0,0" ... to Mobiles, use (in Selection control) a TGestureManager + events as Mouse events! type TForm1 = class(TForm) imgOriginal: TImage; Selection1: TSelection; Rectangle1: TRectangle; imgPreview: TImage; Label1: TLabel; Rectangle2: TRectangle; imgCropping: TImage; Label2: TLabel; Btn_Cropping: TButton; procedure Btn_CroppingClick(Sender: TObject); procedure Selection1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single); procedure FormCreate(Sender: TObject); procedure Selection1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); procedure Selection1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); private public end; var Form1: TForm1; implementation uses FMX.MultiResBitmap; {$R *.fmx} var LRect : TRect; LMovingMouse: boolean = false; procedure MyCroppingBitmap(ASelX, ASelY, ASelW, ASelH: Single; AImgSrc, AImgTrg: TImage); var LCBItem: TCustomBitmapItem; begin LRect := Rect(Trunc(ASelX), Trunc(ASelY), Trunc(ASelW), Trunc(ASelH)); // if AImgTrg.MultiResBitmap.Count > 1 then AImgTrg.MultiResBitmap.Clear; // always you'll have 1 Item!!! // LCBItem := AImgTrg.MultiResBitmap.Items[0]; // note: Always exists 1 item!!! LCBItem.Bitmap.Width := Trunc(ASelX + ASelW); LCBItem.Bitmap.Height := Trunc(ASelY + ASelH); LCBItem.Bitmap.CopyFromBitmap(AImgSrc.Bitmap, LRect, 0, 0); end; procedure TForm1.FormCreate(Sender: TObject); begin imgOriginal.WrapMode := TImageWrapMode.Original; // ? imgPreview.WrapMode := TImageWrapMode.Original; // ? imgCropping.WrapMode := TImageWrapMode.Original; // ? end; procedure TForm1.Selection1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin LMovingMouse := true; end; procedure TForm1.Selection1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin LMovingMouse := false; end; procedure TForm1.Selection1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single); begin if LMovingMouse then MyCroppingBitmap( { } Selection1.Position.X, { } Selection1.Position.Y, { } Selection1.Position.X + Selection1.Width, { } Selection1.Position.Y + Selection1.Height, { } imgOriginal, { } imgPreview { } ); end; procedure TForm1.Btn_CroppingClick(Sender: TObject); begin MyCroppingBitmap( { } Selection1.Position.X, { } Selection1.Position.Y, { } Selection1.Position.X + Selection1.Width, { } Selection1.Position.Y + Selection1.Height, { } imgOriginal, { } imgCropping { } ); end; initialization ReportMemoryLeaksOnShutdown := true; end. Edited June 26, 2023 by programmerdelphi2k 2 2 Share this post Link to post
Johansy 2 Posted June 26, 2023 Thank you very much programmerdelphi2k for your help, just what I needed!!!! 🤩👌 Share this post Link to post