uses
Vcl.OleAuto;
implementation
uses
dwmapi;
function CaptureDesktop: TGraphic;
const
CAPTUREBLT = $40000000;
SM_XVIRTUALSCREEN = 76;
SM_YVIRTUALSCREEN = 77;
SM_CXVIRTUALSCREEN = 78;
SM_CYVIRTUALSCREEN = 79;
var
nDesktopWidth, nDesktopHeight: Integer;
tmpBmp: TBitmap;
hwndDesktop: HWND;
dcDesktop: HDC;
begin
Result := nil;
{
GetWindowRect(GetDesktopWindow)
is completely wrong. It will intentionally return only the rectangle of the primary monotor. See MSDN.
}
{ Cannot handle dpi virtualization
//Get the rect of the entire desktop; not just the primary monitor
ZeroMemory(@desktopRect, SizeOf(desktopRect));
for i := 0 to Screen.MonitorCount-1 do
begin
desktopRect.Top := Min(desktopRect.Top, Screen.Monitors[i].Top);
desktopRect.Bottom := Max(desktopRect.Bottom, Screen.Monitors[i].Top + Screen.Monitors[i].Height);
desktopRect.Left := Min(desktopRect.Left, Screen.Monitors[i].Left);
desktopRect.Right := Max(desktopRect.Right, Screen.Monitors[i].Left + Screen.Monitors[i].Width);
end;
//Get the size of the entire desktop
nDesktopWidth := (desktopRect.Right - desktopRect.Left);
nDesktopHeight := (desktopRect.Bottom - desktopRect.Top);
}
//Also doesn't handle dpi virtualization; but is shorter and unioning rects
nDesktopWidth := GetSystemMetrics(SM_CXVIRTUALSCREEN);
nDesktopHeight := GetSystemMetrics(SM_CYVIRTUALSCREEN);
tmpBmp:= TBitmap.Create;
try
tmpBmp.Width := nDesktopWidth;
tmpBmp.Height := nDesktopHeight;
//dcDesktop := GetDC(0); //
hwndDesktop := GetDesktopWindow;
dcDesktop := GetDC(hwndDesktop); //GetWindowDC(0) returns the DC of the primary monitor (not what we want)
if dcDesktop = 0 then
Exit;
try
if not BitBlt(tmpBmp.Canvas.Handle, 0, 0, nDesktopWidth, nDesktopHeight, dcDesktop, 0, 0, SRCCOPY or CAPTUREBLT) then
Exit;
finally
ReleaseDC(0, dcDesktop);
end;
except
tmpBmp.Free;
raise;
end;
// CaptureScreenShot(GetDesktopWindow, Image, false);
Result := tmpBmp;
end;
procedure ScreenShot(DestBitmap: TBitmap);
var
DC: HDC;
begin
DC:=GetDC(GetDesktopWindow);
try
DestBitmap.Width:=GetDeviceCaps(DC, HORZRES);
DestBitmap.Height:=GetDeviceCaps(DC, VERTRES);
BitBlt(DestBitmap.Canvas.Handle,0,0,DestBitmap.Width,DestBitmap.Height,DC,0,0,SRCCOPY);
finally
ReleaseDC(GetDesktopWindow, DC);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
desktop: TGraphic;
fDisable: BOOL;
begin
{
Capture a screenshot without this window showing
}
//Disable DWM transactions so the window hides immediately
if DwmApi.DwmCompositionEnabled then
begin
fDisable := True;
OleCheck(DwmSetWindowAttribute(Self.Handle, DWMWA_TRANSITIONS_FORCEDISABLED, @fDisable, sizeof(fDisable)));
end;
try
//Hide the window
Self.Hide;
try
//Capture the desktop
desktop := CaptureDesktop;
finally
//Re-show our window
Self.Show;
end;
finally
//Restore animation transitions
if DwmApi.DwmCompositionEnabled then
begin
fDisable := False;
DwmSetWindowAttribute(Self.Handle, DWMWA_TRANSITIONS_FORCEDISABLED, @fDisable, sizeof(fDisable));
end;
end;
//Save the screenshot somewhere
desktop.SaveToFile('c:\Test.bmp');
end;
I only managed to get to that part, but the form flashes, and it cannot.