Delphi - как мне обрезать растровое изображение "на месте"? - PullRequest
Новая
       90

Delphi - как мне обрезать растровое изображение "на месте"?

8 голосов
/ 08 февраля 2012

Если у меня есть TBitmap и я хочу получить обрезанное изображение из этого растрового изображения, могу ли я выполнить обрезку «на месте»? например если у меня есть растровое изображение 800x600, как я могу уменьшить (обрезать) его, чтобы оно содержало изображение 600x400 в центре, то есть результирующее TBitmap имеет размер 600x400 и состоит из прямоугольника, ограниченного (100, 100) и (700 , 500) в исходном изображении?

Нужно ли переходить через другое растровое изображение или эту операцию можно выполнить в исходном растровом изображении?

Ответы [ 2 ]

21 голосов
/ 08 февраля 2012

Вы можете использовать функцию BitBlt

, попробуйте этот код. 

procedure CropBitmap(InBitmap, OutBitMap : TBitmap; X, Y, W, H :Integer);
begin
  OutBitMap.PixelFormat := InBitmap.PixelFormat;
  OutBitMap.Width  := W;
  OutBitMap.Height := H;
  BitBlt(OutBitMap.Canvas.Handle, 0, 0, W, H, InBitmap.Canvas.Handle, X, Y, SRCCOPY);
end;

, и вы можете использовать таким образом 

Var
  Bmp : TBitmap;
begin
  Bmp:=TBitmap.Create;
  try
    CropBitmap(Image1.Picture.Bitmap, Bmp, 10,0, 150, 150);
    //do something with the cropped image
    //Bmp.SaveToFile('Foo.bmp');
  finally
   Bmp.Free;
  end;
end;

Если вы хотите использовать одно и то же растровое изображение, попробуйте эту версию функции 

procedure CropBitmap(InBitmap : TBitmap; X, Y, W, H :Integer);
begin
  BitBlt(InBitmap.Canvas.Handle, 0, 0, W, H, InBitmap.Canvas.Handle, X, Y, SRCCOPY);
  InBitmap.Width :=W;
  InBitmap.Height:=H;
end;

И используйте таким образом 

Var
 Bmp : TBitmap;
begin
    Bmp:=Image1.Picture.Bitmap;
    CropBitmap(Bmp, 10,0, 150, 150);
    //do somehting with the Bmp
    Image1.Picture.Assign(Bmp);
end;
4 голосов
/ 08 февраля 2012

Я знаю, что у вас уже есть ваш принятый ответ, но, поскольку я написал свою версию (в которой вместо вызова GDI используется оболочка VCL), я опубликую ее здесь, а не просто выкидываю.

procedure TForm1.FormClick(Sender: TObject);
var
  Source, Dest: TRect;
begin
  Source := Image1.Picture.Bitmap.Canvas.ClipRect;
  { desired rectangle obtained by collapsing the original one by 2*2 times }
  InflateRect(Source, -(Image1.Picture.Bitmap.Width div 4), -(Image1.Picture.Bitmap.Height div 4));
  Dest := Source;
  OffsetRect(Dest, -Dest.Left, -Dest.Top);
  { NB: raster data is preserved during the operation, so there is not need to have 2 bitmaps }
  Image1.Picture.Bitmap.Canvas.CopyRect(Dest, Image1.Picture.Bitmap.Canvas, Source);
  { and finally "truncate" the canvas }
  Image1.Picture.Bitmap.Width := Dest.Right;
  Image1.Picture.Bitmap.Height := Dest.Bottom;
end;
...