Recortar Una Imagen

[Jose Roman]

Hola a todos,

Bueno resulta que deseo cargar una foto (como la de un pasaporte), pero deseo que el usuario pueda seleccionar la parte de la foto que desea que se grabe, es decir recortar la imagen en la que se selecciona con un recuadro punteado sobre la imagen, para que no quede foto desproporcionada cuando sea cargada en el TImagen. Parece que habia algo el LatiumSoftware pero ya no se puede consultar. Alguien tiene alguna idea de como hacerlo?

[[ElKurgan]]

En este mismo foro se habló del tema

Saludos

[Neftali [Germán.Estévez]]

Aquí tienes otro hilo con ejemplo incluído.

[radenf]

Estimado Jose Roman:

Los componentes SizeComps, que son gratuitos, te permiten modificar el área seleccionada de una imagen.
Los puedes descargar desde este link
Ojalá te sirvan

Salu2

[Jose Roman]

Gracias a todos, empezare a ensayar, Neftali no veo el link que mencionas....??

[Neftali [Germán.Estévez]]

Empezado por Jose Roman

Gracias a todos, empezare a ensayar, Neftali no veo el link que mencionas....??

Porque no lo he puesto...

Este es al que me refería, aunque si buscas hay más.

[ecfisa]

Hola Jose Roman.

Te hice un ejemplo que usa sólo componentes estándar de Delphi, dos Timage, un TShape y dos TButton :

Código Delphi [-]
...

implementation

var
  P: TPoint;
  inSelect: Boolean;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Shape1.Pen.Color := clWhite;
  Shape1.Pen.Style := psDot;
  Shape1.Visible   := False;
  inSelect         := False;
  with Image1 do
  begin
    OnMouseDown:= nil;
    OnMouseMove:= nil;
    OnMouseUp  := nil;
  end;
end;

procedure TForm1.btnLoadImageClick(Sender: TObject);
begin
  if OpenPictureDialog1.Execute then
    with Image1 do
    begin
      Picture.LoadFromFile(OpenPictureDialog1.FileName);
      OnMouseDown:= Image1MouseDown;
      OnMouseMove:= Image1MouseMove;
      OnMouseUp  := Image1MouseUp;
    end;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  InSelect:= ssCtrl in Shift;
  if InSelect then
  begin
    P.X:= X;
    P.Y:= Y;
  end
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  R: TRect;
begin
  if inSelect then
  begin
    with TImage(Sender) do
      R:= Rect(Left+P.X, Top+P.Y, Left+X, Top+Y);
    Shape1.BoundsRect := R;
    Shape1.Brush.Style:= bsClear;
    Shape1.Visible    := True;
  end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  pic: TPicture;
  bmp: TBitmap;
  img: TImage;
begin
  if inSelect and ( P.X < X )and( P.Y < Y ) then
  begin
    img:= TImage(Sender);
    pic:= TPicture.Create;
    try
      pic.Assign(img.Picture);
      bmp:= TBitmap.Create;
      try
        bmp.Height:= img.Picture.Height;
        bmp.Width := img.Picture.Width;
        bmp.Canvas.Draw(0, 0, Pic.Graphic);
        bmp.Canvas.CopyRect(Rect(0, 0, X-P.X, Y-P.Y),
          bmp.Canvas, Rect(P.X, P.Y, X, Y));
        bmp.Width := Abs(X-P.X);
        bmp.Height:= Abs(Y-P.Y);
        Image2.Picture.Bitmap.Assign(bmp);
      finally
        bmp.Free;
      end;
    finally
      pic.Free;
    end;
  end;
  Shape1.Visible:= False;
  InSelect:= False;
end;

procedure TForm1.btnCleanSelectionClick(Sender: TObject);
begin
  Image2.Picture:= nil;
end;

Para comenzar a realizar la selección debes tener la tecla Ctrl presionada (una vez comenzada la podes soltar):


Cuando levantas el botón izquierda del mouse se copia la seleccion a Image2:


Saludos

[pacopenin]

Gracias, ecfisa. Algo muy parecido tengo que hacer en breve y me va a resultar muy útil tu código.

[Jose Roman]

Gracias ecfisa, no se si es mucha molestia pero de antemano me disculpas por molestar, el ejemplo me parece genial, pero te comento, en donde trabajo hay un sofware para realizar carnetizacion, en el se selecciona la ubicacion de la imagen y la muestra asi:



y si el usuario con clic sostenido izquierdo redimenciona el cuadro, este conserva la proporcion, asi:



Asi se carga la imagen dependiendo de la seleccion del usuario pero en proporcion al cuadro punteado (si la aumento o la disminuyo) y lo puede posicionar en cualquier lugar, no se que tan dificil sea realizar esto, gracias de antemano por la ayuda que me puedas brindar.

[radenf]

Estimado Jose Roman:

El componente que te sugerí en el post anterior hace exactamente eso y trae todo el código.
Salu2

[Jose Roman]

Hola radenf,

De casualidad tienes un ejemplo de este componente con un TImage. He tratao de implementarlo pero no logro que sea transparente el TSizeRect, unido a que no se como cortar esa parte seleccionada. Gracias.

[radenf]

Estimado Jose Roman:

Para que el componente TSizeRect sea transparente debes colocar su propiedad NormalBrush>Style=bsClear.
Para dibujar el cuadradito de selección debes poner su propiedad NormalPen>Style=psDot.

Para realizar la acción de cortar la parte seleccionada el siguiente código:

Código Delphi [-]
procedure TFormPrincipal.ButtonCropClick(Sender: TObject);
Var New, Old : TRect;
Wic1:TWicImage;
ImageM: TImage;
Begin
ImageM:= TImage.Create(Self);
Wic1:= TWicImage.Create;
Wic1.LoadFromFile(ImageList[TImage(Sender).Tag]);
New.Left:=SizeRect1.ClientRect.Left;
New.Top:=SizeRect1.ClientRect.Top;
New.Right:=SizeRect1.ClientRect.Right;
New.Bottom:=SizeRect1.ClientRect.Bottom;
Old := New;
try
ImageM.Left:=SizeRect1.Left;
ImageM.Top:=SizeRect1.Top;
ImageM.Height:=SizeRect1.Height;
ImageM.Width:=SizeRect1.Width;
ImageM.Canvas.CopyRect(Old,SizeRect1.Canvas,New);
ImageM.Picture.SaveToFile(ExtractFilePath(Application.ExeName) + 'Foto.bmp');
Wic1.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Foto.bmp');
Image1.Picture.Bitmap.Assign(Wic1);
finally
Wic1.Free;
ImageM.Free;
end;
end;

En este ejemplo utilizo TWicImage que lo soporta Delphi XE3 para cargar no sólo .bmp y .jpg, sino también .png y .tiff, pero lo puedes reemplazar por un TBitmap o utilizar el código que te envié por mensaje privado.

Ojalá te sirva
Saludos

PD: Te sugiero que también revises el demo que traen los componentes TSizeComps, ya que ahí están los ejemplos para hacerlo funcionar.

[Jose Roman]

Gracias por tu ayuda radenf, hasta ahora me logro parte del cometido, solo tengo el inconveniente de que me copia los bordes punteados:


Al igual que si abro el archivo guardado (foto.bmp) tambien se nota el borde punteado que se ve en la imagen derecha, te adjunto el código para ver si me ayudas donde esta el error:

Código Delphi [-]
procedure TwLoadImg.btReloadClick(Sender: TObject);
Var
  New : TRect;
  Wic:TWicImage;
  ImageM: TImage;
begin
  // Oculto bordes de TSizeRect
  srImg.NormalPen.Mode  := pmXor;
  srImg.NormalPen.Style := psClear;
  ImageM     := TImage.Create(Self);
  Wic        := TWICImage.Create;
  New.Left   := srImg.ClientRect.Left;
  New.Top    := srImg.ClientRect.Top;
  New.Right  := srImg.ClientRect.Right;
  New.Bottom := srImg.ClientRect.Bottom;
  try
    ImageM.Visible        := False;
    ImageM.Left           := srImg.Left;
    ImageM.Top            := srImg.Top;
    ImageM.Height         := srImg.Height;
    ImageM.Width          := srImg.Width;
    ImageM.Canvas.CopyRect(New,srImg.Canvas,New);
    ImageM.Picture.SaveToFile(ExtractFilePath(Application.ExeName)+'Foto.bmp');
    Wic.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Foto.bmp');
    imPrel.Picture.Bitmap.Assign(Wic);
  finally
    Wic.Free;
    ImageM.Free;
    // Enseño bordes del TSizeRect
    srImg.NormalPen.Mode  := pmCopy;
    srImg.NormalPen.Style := psDot;
  end;
end;

[Jose Roman]

Problema solucionado, coloque un Repaint. Gracias por tu ayuda.

[radenf]

Me alegra que te haya funcionado.
Salu2