Jump to content
Johansy

Delphi Image Cropper Component?

Recommended Posts

@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.

image.png.9ec789ec086b74bb1c4e874d3618c53d.png         image.png.251558665dca32b24d335facf42f4cd5.png

 

bds_4CK1tgo89c.gif

Edited by programmerdelphi2k
  • Like 2
  • Thanks 2

Share this post


Link to post

Thank you very much programmerdelphi2k for your help, just what I needed!!!! 🤩👌

Share this post


Link to post

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×