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?

RRUZ · Accepted Answer · 2012-02-07T21:03:03.753

24

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;

edited Feb 07 '12 at 21:03

answered Feb 07 '12 at 20:52

RRUZ

134,889
20
356
483

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? – rossmcm Feb 07 '12 at 21:12
You could use Move with the ScanLine property of TBitmap but you'll have to calculate byte-size of the pixels depending on BitsPerPixel – Stijn Sanders Feb 07 '12 at 21:15
check the second option this uses only one bitmap. – RRUZ Feb 07 '12 at 21:16
First variant is unrelated to what OP wants (and simply wastes a memory, since BitBlt preserves raster data during operation) – OnTheFly Feb 07 '12 at 21:48
1

The first version was written before the OP edited his question. – RRUZ Feb 07 '12 at 21:57
@RRUZ, “in place” clause always been there. – OnTheFly Feb 07 '12 at 22:08

OnTheFly · Answer 2 · 2012-02-07T22:05:25.940

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;

Delphi - how do I crop a bitmap "in place"?

2 Answers2

Linked