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 (http://www.clubdelphi.com/foros/showthread.php?t=25483)se habló del tema

Saludos

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

Aquí tienes otro hilo (http://www.clubdelphi.com/foros/showthread.php?t=30970) 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 (http://mxs.bergsoft.net/index.php?p=2)
Ojalá te sirvan

Salu2

[Jose Roman]

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

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

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

Porque no lo he puesto... :o:o

Este es al que me refería (http://www.clubdelphi.com/foros/showthread.php?t=30970), 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 :

...

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):
http://sia1.subirimagenes.net/img/2014/09/10/140910100822823553.jpg

Cuando levantas el botón izquierda del mouse se copia la seleccion a Image2:
http://sia1.subirimagenes.net/img/2014/09/10/140910100932989746.jpg

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:

http://3.bp.blogspot.com/-nFVpw9TuUPw/VBGyghirHFI/AAAAAAAABEE/WJPDA_QhDzQ/s1600/ANT.bmp

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

http://3.bp.blogspot.com/-OoOy_SjgnvU/VBGzWVGeuXI/AAAAAAAABEM/k-lsL9KsXv0/s1600/DES.JPG

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:

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:
http://i61.tinypic.com/14luft3.jpg

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:


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