Recortar Una Imagen

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