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?

Baptistery

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;

Rutabaga

Thanks for that. Is there any simple way of accomplishing this without needing a second bitmap? In the same way as the Move routine in Delphi handles overlapping source and destination, is there a two-dimensional equivalent? – Baptistery

You could use Move with the ScanLine property of TBitmap but you'll have to calculate byte-size of the pixels depending on BitsPerPixel – Compete

check the second option this uses only one bitmap. – Rutabaga

First variant is unrelated to what OP wants (and simply wastes a memory, since BitBlt preserves raster data during operation) – Immorality

The first version was written before the OP edited his question. – Rutabaga

@RRUZ, “in place” clause always been there. – Immorality

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;

Immorality