我正在努力讓 CopyRect 在 VCL 中與 Delphi 11 一起使用以裁剪影像的一部分。我的測驗應用程式是一個簡單的表單，其中包含一個 TImage 組件中的影像、一個按鈕和兩個標簽以及一個用于顯示結果的 TImage。我已經嘗試過 BitBlt 和 CopyRect 但得到相同的結果 - 0 大小的裁剪影像。
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;
uj5u.com熱心網友回復：
OPBMP 沒有大小，您必須使用 TBitmap.Create(W, H); 設定它。或 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;
你也可以寫iRect := Rect(X,Y,W,H);
轉載請註明出處，本文鏈接：https://www.uj5u.com/qukuanlian/504711.html