Crop a piece of the image using mouse

Question

Hello, I have the following situation, in a FORM I have any image, I need to select a part of the image through the MOUSE click, and as soon as I release the mouse button, that part I selected is SAVED!

I found an issue similar to mine, but I could not adapt it to use in image, only in FORM, follow the link:

https://stackoverflow.com/questions/32427396/create-a-rectangle-hole-on-form-with-my-mouse

In the case of this topic above, it uses the mouse to make a "hole" in the FORM, what I need is to crop and save a piece of the image.

I appreciate any help!

Answer 1

Here is an example of how to do.

Add a component TImage, define an image in the property Picture, of course, you can use a charging system for the image as you prefer, in the case of example let’s start the component already with a picture defined!

Declaration of Global Variables (I prefer to always do so):

num,
StartX,
StartY,
OldStartX,
OldStartY,
OldEndX,
OldEndY : Integer;
IsDown : Boolean;
JPG: TJpegImage;
Bmp,
Bmp1,
Bmp2 : TBitmap;

At the event MouseDown of the component TImage Let’s get the coordinates X and Y from Mouse:

procedure TForm5.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  IsDown := True;
  StartX := X;
  StartY := Y;
  OldStartX := X;
  OldStartY := Y;
  OldEndX := X;
  OldEndY := Y;
end;

Now at the event MouseMove of the component TImage Let’s draw the selection area:

procedure TForm5.Image1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  if IsDown then
  begin
    Canvas.Pen.Style := psDot;
    Canvas.Pen.Mode := pmNotXor;
    Canvas.Rectangle(OldStartX, OldStartY, OldEndX, OldEndY);
    OldEndX := X;
    OldEndY := Y;
    Canvas.Rectangle(StartX, StartY, X, Y);
  end;
end;

Okay, we come to the final part, let’s drop the mouse button and save the image.

At the event MouseUp of the component TImage:

procedure TForm5.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  IsDown := False;
  Canvas.Pen.Style := psDot;
  Canvas.Pen.Mode  := pmNotXor;
  Canvas.Rectangle(OldStartX, OldStartY, OldEndX, OldEndY);

  Bmp := TBitmap.Create;
  JPG := TJpegImage.Create;
  JPG.Assign(Bmp);
  num := 90;

  Image1.Picture.LoadFromFile('D:\imagem_original.bmp');
  image1.Picture.Bitmap.Canvas.Brush.Style := bsClear;

  if not (Image1.Picture.Graphic is TBitmap) then
    raise Exception.Create('A imagem não é um Bitmap');

  Bmp2 := TBitmap(Image1.Picture.Graphic);

  Bmp1 := TBitmap.Create;
  try
    Bmp1.Width := Abs(OldEndX - OldStartX);
    Bmp1.Height := Abs(OldEndY - OldStartY);

    Bmp1.Canvas.CopyRect(Rect(0, 0, Bmp1.Width, Bmp1.Height), Bmp2.Canvas, Rect(OldStartX, OldStartY, OldEndX, OldEndY));
    Bmp1.SaveToFile('D:\imagem_recortada.bmp');
  finally
    Bmp1.Free;
  end;
end;

Note that on this line I am saving the image Automatically when you release the mouse button, you can customize this easily, do the test:

1 - Comment the line that contains, Bmp1.SaveToFile('D:\imagem_recortada.bmp');

2 - Remove from the section finally the Bmp1.Free;

3 - Add a Tbutton component to the Click event:

procedure TForm5.Button1Click(Sender: TObject);
begin
  Bmp1.SaveToFile('D:\imagem_recortada.bmp');
  Bmp1.Free;
end;

And of course, you can use one SavePictureDialog to become more professional!

Ready!

Answer 2

For JPEG it is necessary conversion, not to get a very extensive answer I decided to post a new Reply!

Similar to the previous method,

Declare the following global variables:

PosicaoX,
PosicaoY : Integer;
Bmp1, Bmp2: TBitmap;
Jpg: TJPEGImage;

Create a Procedure with this block of code:

procedure TfrmPrincipal.CopyJPGArea(JPimag: TJPEGImage; Top, Left, Width, Height: Integer; NewImage: TImage);
begin
  //Primeiro convertemos a JPEG em BMP
  JPimag.DIBNeeded;
  Bmp1 := TBitmap.Create;
  Bmp1.Assign(JPimag);
  //Copiamos a parte que queremos
  Bmp2 := TBitmap.Create;
  Bmp2.Width := Width;
  Bmp2.Height := Height;
  Bmp2.Canvas.CopyRect(Rect(0, 0, Width, Height), Bmp1.Canvas, Rect(Top, Left, Top + Width, Left + Height));
  //Transferindo a parte copiada para um TImage na memória
  NewImage.Picture.assign(Bmp2);
  //Liberando as temporarias
  Bmp2.free;
  Bmp1.free;
end;

Add a Tbutton component, name it btnAbrir and in your event Click:

procedure TfrmPrincipal.btnAbrirClick(Sender: TObject);
begin
  if (OpenPictureDialog1.Execute) then
  begin
    Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
  end;
end;

Add 2 components TImage, at the events MouseDown and Mouseup from Image1:

procedure TfrmPrincipal.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  PosicaoX := X;
  PosicaoY := Y;
end;

procedure TfrmPrincipal.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Jpg := TJPEGImage.Create;
  Jpg.Assign(Image1.Picture);
  CopyJPGArea(Jpg, PosicaoX, PosicaoY, X - PosicaoX, Y - PosicaoY, Image2);
  Jpg.Free;
end;

This is the procedure to copy a part of the JPEG from Image1 to Image2, now use my other answer and you can already save the image, with imagination you can merge the two Codes into 1 and you can read both formats!

Note that I didn’t add the Selection Rectangle creation methods! You already have them in the first answer! So it’s better to study, get to work!