Canvas.CopyRectは機能しません

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の3番目の引数にあります。ソース矩形。あなたが期待するものではなく、大きすぎます。実際、出力ビットマップを拡大すると、左上にソースイメージの縮小版が表示されます。

クリップの矩形のゲッターは、VCLとは違ってLCLで実装されています。 VCLの実装により、必要なときに有効なキャンバスハンドルを確保できます。対照的に、以下のそれは（Windows用）LCLに実装されている方法です。

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('... 
    ...