Question

拜托，有人帮帮我!!!我需要画一些东西并将其保存为bmp文件。我是这样做的：

    procedure TForm1.PaintBox1Paint(Sender: TObject);

begin
   with PaintBox1, canvas do
    begin
    Pen.Style := psDash;
    pen.Width:=4;
    pen.Color:=clBlack;
    moveto(2,2);
    lineto(100, 2);
    end;
end;

procedure TForm1.BtnSaveClick(Sender: TObject);
var bmp : TBitmap;
begin
   bmp := TBitmap.Create;
   try
     bmp.width := paintbox1.Width;
     bmp.height:= paintbox1.Height;
     bmp.Canvas.CopyRect(Rect(0, 0, -bmp.Width,  bmp.Height),PaintBox1.Canvas, PaintBox1.Canvas.ClipRect);//Here creates a black rectangle 
    bmp.savetofile('/Users/stad/Desktop/bit4.bmp');

   finally
   end;
end;

最后，创建一个黑色背景的位图。有一天可能会知道吗？

Answer 1

问题在于CopyRect的第三个参数;源矩形。这不是你所期望的，而是太大了。实际上，如果放大输出位图，您会在左上角找到源图像的压缩版本。

画布'剪辑矩形的getter在LCL中的实现方式与在VCL中的实现方式不同。 VCL的实现可确保您在需要时拥有有效的画布句柄。相反，下面是它在LCL（对于Windows）中的实现方式：

function TCanvas.GetClipRect: TRect;
begin
  // return actual clipping rectangle
  if GetClipBox(FHandle, @Result) = ERROR then
    Result := Rect(0, 0, 2000, 2000);{Just in Case}
end;

正如您所看到的那样，当画布句柄无效时，会返回以及的任意矩形 - 这是在绘制框的绘制处理程序之外的情况。

您可以自己指定矩形来解决：

var bmp : TBitmap; R: TRect; begin ... R := Rect(0, 0, bmp.Width, bmp.Height); bmp.Canvas.CopyRect(R, PaintBox1.Canvas, R); bmp.savetofile('... ...

Canvas.CopyRect不起作用

1 个答案: