Struggling with CopyRect in Delphi 11 VCL

Question

I am struggling to get CopyRect to work with Delphi 11 in VCL to crop a portion of an image out. My test app is a simple form with a image in a TImage component, a button and two labels and a TImage to display the result. I have tried both BitBlt and CopyRect but get the same result - a cropped image of 0 size.

procedure TForm2.Button1Click(Sender: TObject);
var
  TxferBMP, OPBMP : TBitmap;
begin
  TxferBMP := TBitmap.Create;
  OPBMP := TBitmap.Create;
  try
    TxferBMP.Assign(imgSource.Picture.Graphic);
    CropBitmapVCL(TxferBMP, OPBMP, 300, 200, 100, 80);
    imgCropped.Picture.Assign(OPBMP);
  finally
    TxferBMP.Free;
    OPBMP.Free;
  end;
end;

procedure TForm2.CropBitmapVCL(InBitmap : TBitmap; var OutBitmap : TBitmap; X, Y, W, H :integer);
var
  iRect, oRect: TRect;
  TmpFileName: string;
begin
  iRect.left := X;
  iRect.top := Y;
  iRect.width := W;
  iRect.height := H;
  oRect.left := 0;
  oRect.top := 0;
  oRect.width :=iRect.width;
  oRect.height := iRect.height;
//  OutBitmap := TBitmap.Create;    // Already created outside func
  OutBitMap.PixelFormat := InBitmap.PixelFormat;

  TmpFileName := includetrailingpathdelimiter(applicationpath) + 'InBitmap.jpg';
  InBitmap.SaveToFile(TmpFileName) ;
  lblSrcImgSize.Caption := ('Src: ' + inttostr(InBitmap.Width) + ' : ' + inttostr(InBitmap.Height));

// https://idqna.madreview.net/
// Windows
// https://learn.microsoft.com/en-us/windows/win32/api/wingdi/nf-wingdi-bitblt
//  BitBlt(OutBitMap.Canvas.Handle, oRect.left, oRect.top, oRect.width, oRect.height,
//         InBitmap.Canvas.Handle, iRect.left, iRect.top, SRCCOPY);

// ALTERNATIVE OPTION
// http://www.delphigroups.info/2/9/633692.html
  inBitmap.Canvas.CopyMode := cmSrcCopy;
  OutBitmap.Canvas.CopyRect(oRect, InBitmap.Canvas, iRect);


  TmpFileName := includetrailingpathdelimiter(applicationpath) + 'OutBitmap.jpg';
  OutBitmap.SaveToFile(TmpFileName) ;
  lblDstImgSize.Caption := ('Cropped: ' + inttostr(OutBitmap.Width) + ' : ' + inttostr(OutBitmap.Height));

end;

Answer 1

The OPBMP have no size you have to set it with TBitmap.Create(W, H); or OPBMP.Height / OPBMP.Width

procedure TForm2.Button1Click(Sender: TObject);
var
  OPBMP: TBitMap;
begin
  try
    CropBitmapVCL(imgSource.Picture.Bitmap, OPBMP, 300, 200, 100, 80);
    imgCropped.Picture.Assign(OPBMP);
  finally
    OPBMP.Free;
  end;
end;

procedure TForm2.CropBitmapVCL(InBitmap: TBitmap; var OutBitmap: TBitmap; X, Y, W, H: integer);
var
  TmpFileName: string;
begin
  OutBitmap := TBitmap.Create(W, H); // <--- Set the bmp size
  OutBitMap.PixelFormat := InBitmap.PixelFormat;
  BitBlt(OutBitMap.Canvas.Handle, 0, 0, W, H, InBitmap.Canvas.Handle, X, Y, SRCCOPY);
end;

Also you can just write iRect := Rect(X,Y,W,H);