Struggling with CopyRect in Delphi 11 VCL-CodePudding

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://docs.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;

CodePudding user response：

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);