Making Screenshot produces computer to slow down (stuck at the moment) - delphi

Question

Please check this code:
procedure ScreenShotBMP(DestBitmap : TBitmap; AActiveWindow: Boolean = True) ;
var
DC: HDC;
begin
if AActiveWindow then
DC := GetDC(GetForegroundWindow)
else
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
if AActiveWindow then
ReleaseDC(GetForegroundWindow, DC)
else
ReleaseDC(GetDesktopWindow, DC);
end;
end;
It generates screenshot properly, of Desktop or Active screen but computer stuck a little big during that operation.
I need app to make screenshots on regular time frames (less then one sec), but running this slows down computer.
It's not CPU consuming, taskmanager doesn't show any abnormal activity, simple entire system is stuck. No matter if I run this code inside main thread or another thread.
Is there any other method to create screenshot that won't slow down machine?
Thanks.

Answer 1

I can't reproduce your problem, based on a quick test on XE5 VCL Win32 application, running on Win7 64-bit, 1280x1024 resolution, on an Intel Core i7 860 #2.80GHz (according to CPU-Z), 4GB DDR3 RAM, using the following test code:
function CaptureWindow(const WindowHandle: HWnd): TBitmap;
var
DC: HDC;
wRect: TRect;
Width, Height: Integer;
begin
DC := GetWindowDC(WindowHandle);
Result := TBitmap.Create;
try
GetWindowRect(WindowHandle, wRect);
Width := wRect.Right - wRect.Left;
Height := wRect.Bottom - wRect.Top;
Result.Width := Width;
Result.Height := Height;
Result.Modified := True;
BitBlt(Result.Canvas.Handle, 0, 0, Width, Height, DC, 0, 0, SRCCOPY);
finally
ReleaseDC(WindowHandle, DC);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Bmp: TBitmap;
SW: TStopwatch;
W, H: Integer;
begin
SW := TStopwatch.StartNew;
Bmp := CaptureWindow(GetDesktopWindow);
try
Image1.Picture.Assign(Bmp);
W := Bmp.Width;
H := Bmp.Height;
finally
Bmp.Free;
end;
SW.Stop;
Self.Caption := Format('W: %d H: %d %d:%d %d',
[W,
H,
SW.Elapsed.Minutes,
SW.Elapsed.Seconds,
SW.Elapsed.Milliseconds]);
end;
The caption displays: W: 1280 H: 1024 0:0 42, which is an elapsed time of 42 milliseconds for creating the bitmap, capturing the screen and BitBlting it, assigning it to a TImage for display, and freeing the bitmap (not to mention two calls to the high resolution timer within the stopwatch code and the calculations for the elapsed time).
Note: The CaptureWindow code is adapted from something someone posted here a while back. The Aero-aware parts of it didn't seem necessary, as testing showed it worked fine both with and without Aero enabled on Windows 7. (I'm guessing it was something needed under Vista originally.)

Answer 2

1) Which value PixelFormat property of DestBitmap has? For fast BitBlt color format of source and destination must be the same. In your case PixelFormat must has pfDevice value.
2) Why do you use GetDeviceCaps instead of GetWindowRect in case of GetForegroundWindow? You use larger dimension -> BitBlt tries copy more bytes -> BitBlt works slower.
3) Foreground window may be changed between GetForegroundWindow and ReleaseDC(GetForegroundWindow, DC) -> it is better to keep window handle in the separate variable.