Já precisou cortar ou copiar apenas parte de uma imagem?
Esta função simplifica bastante este trabalho:
Lembre o uses
Vcl.Graphics, Winapi.Windows.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | function CortarImagem(Imagem: TGraphic; Valores: TRect): TBitmap; var bmp, tbmp: TBitmap; drect: TRect; begin bmp := TBitmap.Create; bmp.Height := Valores.Bottom - Valores.Top; bmp.Width := Valores.Right - Valores.Left; drect := Bounds(0, 0, bmp.Width, bmp.Height); tbmp := TBitmap.Create; try tbmp.Height := Imagem.Height; tbmp.Width := Imagem.Width; tbmp.Canvas.Draw(0, 0, Imagem); bmp.Canvas.CopyRect(drect, tbmp.Canvas, Valores); Result := bmp; finally tbmp.Free; end; end; |
Exemplo de uso
1 2 3 4 5 | procedure TForm1.Button1Click(Sender: TObject); begin Image1.Picture.bitmap := CortarImagem(Image1.Picture.Graphic, Bounds(62, 0, Image1.Picture.Width - 70, Image1.Picture.Height - 46)); end; |
Veja que foi passado por parâmetro a imagem original,
a posição iniciar a esquerda para começar a cópia,
a posição iniciar superior,
quantidade em pixels da largura,
quantidade de pixels de altura.
A função resulta em um TBitmap, que no exemplo por
exibido em um TImage.
Dúvidas ou sugestões, deixe nos comentários do post.
Está gostando do conteúdo? Considere pagar um cafezinho para nossa equipe!
Você precisa fazer o login para publicar um comentário.
Bom dia, fucionou beleza, porem ela deixa objeto (tbmp := TBitmap.Create) na memoria que vai pesando a aplicação. Não consegui resolver pois se der free nesse objeto a imagem fica null. Sabe como resolver ?