我想从整个屏幕到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;
Run Code Online (Sandbox Code Playgroud)
现在,我想先将屏幕快照复制到另一个画布。有没有办法做到这一点而不会出现此错误?
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;
Run Code Online (Sandbox Code Playgroud)
如果您需要使用额外的画布,则必须分配 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;
Run Code Online (Sandbox Code Playgroud)