(Resolvido) Trabalhando com Timagem

[JPMADEIRA]

Boa Tarde pessoal, estou com uma duvida mas não estou conseguindo resolver, preciso recortar uma imagem mas o tamanho padrão é 160x160 mas tinha que ser estilo o Facebook, ele tem uma forma no centro do timagem, que se a parte da imagem tiver dentro dessa forma ela vai ser recortada, tentei adaptar com um código que o Jhonas postou aqui no fórum, mais não consegui adaptar, o código que tem no fórum ele recorta com o mouse, mas eu precisava que ele recortava no tamanho especificado e dentro da forma certa. obrigado

[Jhonas]

tentei adaptar com um código que o Jhonas postou aqui no fórum,

Não me lembro mais desse link ...  me passe novamente o link e vejo se dá pra modificar para o seu uso.

abraço

[JPMADEIRA]

16 minutos atrás, Jhonas disse:

tentei adaptar com um código que o Jhonas postou aqui no fórum,

Não me lembro mais desse link ...  me passe novamente o link e vejo se dá pra modificar para o seu uso.

abraço

O Código é este:

unit UNovo;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;

    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
    Retangulo : TRect;
  end;

var
  Form1: TForm1;
  old, new : TPoint;
  Press:boolean;
implementation

{$R *.DFM}

procedure Desenhar;
begin
  Form1.Image1.Canvas.moveto(new.x, new.y);
  Form1.Image1.Canvas.lineto(new.x, old.y);
  Form1.Image1.Canvas.lineto(old.x, old.y);
  Form1.Image1.Canvas.lineto(old.x, new.y);
  Form1.Image1.Canvas.lineto(new.x, new.y);
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   if not press then
      begin
        old.X := X;
        old.Y := Y;
      end;

    Retangulo.Left:=old.x;
    Retangulo.Top:=old.Y;
    Retangulo.Right:=x;
    Retangulo.Bottom:=y;

    form1.Canvas.CopyRect(Retangulo, form1.Image1.Canvas, Retangulo);
    form1.Image1.Canvas.Pen.Style := psDash;

end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin

   if not press then
      press:=true;

   old.x:= x;
   old.y:= y;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   press:= false; 
   //form1.Canvas.CopyRect(Retangulo, form1.Image1.Canvas, Retangulo);
   new.x:= x;
   new.y:= y;

   desenhar;
end;

end.

Obrigado...

Editado Junho 28, 2018 por JPMADEIRA

[Jhonas]

Exemplo:
 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

Function CropImage(Imagem: TGraphic; Val: TRect): TBitmap;
var
  bmp, cbmp: TBitmap;
  rect: TRect;
begin
  bmp := TBitmap.Create;
  bmp.Height := Val.Bottom - Val.Top;
  bmp.Width := Val.Right - Val.Left;
  rect := Bounds(0, 0, bmp.Width, bmp.Height);
  try
    cbmp := TBitmap.Create;
    cbmp.Height := Imagem.Height;
    cbmp.Width := Imagem.Width;
    cbmp.Canvas.Draw(0,0,Imagem);
    bmp.Canvas.CopyRect(rect, cbmp.Canvas, Val);
    Result :=bmp;
  finally
    cbmp.Free;
  end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  Image2.Picture.Bitmap := CropImage(Image1.Picture.Graphic, Bounds(x, y, 160, 160));
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Image2.Picture.Bitmap.SaveToFile('C:\ImagemCortada.bmp');
  showmessage('Imagem Cortada Salva');
end;

end.

Coloque em um Form 2 componentes TImage:

No primeiro ( Image1 )voce coloca a imagem que voce quer

No Image2 coloque na propriedade Height = 160 e no Width = 160 ( Será o Resultado )

Ao passear com o mouse pelo Image1, vai aparecer no Image2 ( tamanho 160 x 160 ) a parte da figura que voce está  selecionando

Se a figura é o que voce esta querendo, então voce clika com o mouse nesse ponto da figura e ela será salva no drive local:   'C:\ImagemCortada.bmp'

OBS: modifique o código para o seu uso

abraço

 

[JPMADEIRA]

Obrigado Jhonas era isso mesmo que eu precisava, só mais uma coisa tem como eu mover o image2 junto com o mouse sem que ele fica com lag? tipo fiz assim:

Image2.Top:= y;
Image2.Left:= x;

só que ele fica com muito lag, tipo fica dando umas travadinhas quando ele arrasta..

mais de resto, funcionou beleza

abraços, obrigado..

[Jhonas]

experimente usar esse comando no TImage

doublebufered:=true;

ou tente esses links

https://www.google.com.br/search?source=hp&ei=Na42W8LaEoeIwgT9mI_oCA&q=Double+buffering+with+a+back+buffer+in+delphi&o que=Double+buffering+with+a+back+buffer+in+delphi&gs_l=psy-ab.3...1565.4131.0.4793.8.8.0.0.0.0.352.1243.0j7j0j1.8.0....0...1c.1.64.psy-ab..0.4.461...33i22i29i30k1j33i160k1.0.pIqk3DecPbM

abraço