Delphi - how do I crop a bitmap “in place”?

Question

If I have a TBitmap and I want to obtain a cropped image from this bitmap, can I perform the cropping operation "in place"? e.g. if I have a bitmap that is 800x600, how can I reduce (crop) it so that it contains the 600x400 image at the centre, i.e. the resulting TBitmap is 600x400, and consists of the rectangle bounded by (100, 100) and (700, 500) in the original image?

Do I need to go via another bitmap or can this operation be done within the original bitmap?

Answer 1

You can use the BitBlt function

try this code.

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;

and you can use in this way

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;

If you want use the same bitmap, try this version of the function

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;

And use in this way

Var
 Bmp : TBitmap;
begin
    Bmp:=Image1.Picture.Bitmap;
    CropBitmap(Bmp, 10,0, 150, 150);
    //do somehting with the Bmp
    Image1.Picture.Assign(Bmp);
end;

Answer 2

I know you have your accepted answer already, but since i wrote my version (which uses VCL wrapper instead of GDI call), i'll post it here instead of just throwing it away.

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;