Холст не позволяет рисовать

Question

Я хочу нарисовать снимок экрана со всего экрана на холст TForm1.

Этот код хорошо работает в Delphi XE3

procedure TForm1.Button1Click(Sender: TObject); 
var 
    c,scr: TCanvas; 
    r,r2: TRect; 
begin 

    c := TCanvas.Create; 
    scr := TCanvas.Create; 
    c.Handle := GetWindowDC(GetDesktopWindow); 
    try 

    r := Rect(0, 0, 200, 200); 
    form1.Canvas.CopyRect(r, c, r); 

    finally 
    ReleaseDC(0, c.Handle); 
    c.Free; 
    end; 

Теперь я хочу, чтобы скопировать снимок экрана на другой холст первым. Есть ли способ сделать это, не получив эту ошибку?

procedure TForm1.Button1Click(Sender: TObject); 
var 
    c,scr: TCanvas; 
    r,r2: TRect; 
begin 

    c := TCanvas.Create; 
    scr := TCanvas.Create; 
    c.Handle := GetWindowDC(GetDesktopWindow); 
    try 

    r := Rect(0, 0, 200, 200); 

    scr.CopyRect(r,c,r); <-- Error, canvas does not allow drawing 
    form1.Canvas.CopyRect(r, scr, r); <-- Error, canvas does not allow drawing 

    finally 
    ReleaseDC(0, c.Handle); 
    c.Free; 
    end; 

Answer 1

Если вам нужно работать с дополнительным холстом, вам придется назначить HDC, например.

var 
    WindowHandle:HWND; 
    ScreenCanvas,BufferCanvas: TCanvas; 
    r,r2: TRect; 
    ScreenDC,BufferDC :HDC; 
    BufferBitmap : HBITMAP; 
begin 
    WindowHandle := 0; 
    ScreenCanvas := TCanvas.Create; 
    BufferCanvas := TCanvas.Create; 

    ScreenDC:=GetWindowDC(WindowHandle); 
    ScreenCanvas.Handle := ScreenDC; 

    BufferDC := CreateCompatibleDC(ScreenDC); 
    BufferCanvas.Handle := BufferDC; 
    BufferBitmap := CreateCompatibleBitmap(ScreenDC, 
        GetDeviceCaps(ScreenDC, HORZRES), 
        GetDeviceCaps(ScreenDC, VERTRES)); 
    SelectObject(BufferDC, BufferBitmap); 

    try 
    r := Rect(0, 0, 200, 200); 
    BufferCanvas.CopyRect(r,ScreenCanvas,r); 
    form1.Canvas.CopyRect(r, BufferCanvas, r); 
    finally 
    ReleaseDC(WindowHandle, ScreenCanvas.Handle); 
    DeleteDC(BufferDC); 
    DeleteObject(BufferBitmap); 
    BufferCanvas.Free; 
    ScreenCanvas.Free; 
    end; 
end; 

Answer 2

Пришло время бросить мое решение в горшок!

procedure TForm1.FormClick(Sender: TObject); 
var 
    ScreenCanvas: TCanvas; 
begin 
    ScreenCanvas := TCanvas.Create; 
    try 
    ScreenCanvas.Handle := GetWindowDC(GetDesktopWindow); 
    Win32Check(ScreenCanvas.HandleAllocated); 
    Canvas.CopyRect(Canvas.ClipRect, ScreenCanvas, ScreenCanvas.ClipRect); 
    finally 
    ReleaseDC(GetDesktopWindow, ScreenCanvas.Handle); 
    ScreenCanvas.Free; 
    end; 
end;