Cut a piece of the image using mouse

5

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

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

link

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

Thanks for any help!

    
asked by anonymous 07.11.2015 / 14:19

2 answers

4

Here is an example of how to do it.

Add a component TImage , set an image in the Picture property, of course, you can use a loading system for the image as you like, in the example case we will start the component already with a defined image! p>

Global Variable Declaration (I always prefer to do this):

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

In event MouseDown of component TImage we will get the X and Y coordinates of the 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 in the MouseMove event of the TImage component we will 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;

Ready, we come to the final part, let's release the mouse button and save the image.

In event MouseUp of 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'm saving the image Automatically when I release the mouse button, you can easily customize this, test:

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

2 - Remove from section finally o Bmp1.Free;

3 - Add in the Click event of a TButton component:

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

Of course, you can use SavePictureDialog to become more professional!

Ready!

    
07.11.2015 / 19:01
1

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

Much like 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 its Click event:

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

Add 2 components TImage , in the events MouseDown and MouseUp of 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 portion 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! p>

Please note that I have not added the methods for creating the Selection Rectangle! You already have them in the first answer! This way, study is better, hands on!

    
10.11.2015 / 00:55