• 0
Sign in to follow this  
JPMADEIRA

(Resolvido) Trabalhando com Timagem

Question

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

Share this post


Link to post
Share on other sites

5 answers to this question

Recommended Posts

  • 0

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

Share this post


Link to post
Share on other sites
  • 0
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...

Edited by JPMADEIRA

Share this post


Link to post
Share on other sites
  • 0

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

 

Share this post


Link to post
Share on other sites
  • 0

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

Share this post


Link to post
Share on other sites
  • 0

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Sign in to follow this