program DoScreenshots;
uses
Windows,
SysUtils,
Graphics,
JPEG;
{$R *.res}
// делает скриншот экрана с заданным качеством и сохраняет в папку
// имя файла соответствует Prefix-YYYY-MM-DD-HH-NN-SS.jpg
function GetScreenShot(ADirectory, APrefix: string; ACompressionQuality: Integer): string;
var
Bmp: TBitmap;
Jpg: TJpegImage;
DC: HDC;
begin
Bmp := TBitmap.Create;
Jpg := TJpegImage.Create;
try
Bmp.Height := GetSystemMetrics(SM_CYSCREEN);
Bmp.Width := GetSystemMetrics(SM_CXSCREEN);
DC := GetDC(0);
try
bitblt(Bmp.Canvas.Handle, 0, 0, GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN), DC, 0,
0, SRCCOPY);
finally
ReleaseDC(0, DC);
end;
Jpg.CompressionQuality := ACompressionQuality;
Jpg.Assign(Bmp);
ADirectory := IncludeTrailingPathDelimiter(ADirectory);
ForceDirectories(ADirectory);
Result := ADirectory + APrefix + '-' + FormatDateTime('YYYY-MM-DD-HH-NN-SS', Now) + '.jpg';
Jpg.SaveToFile(Result);
// 1. Сделано 200 скриншотов, среднее время 228,6 ms
// 2. Скомпилированный под Delphi7 выполняется в 1.5-2 раза быстрее, чем под XE2
finally
Jpg.Free;
Bmp.Free;
end;
end;
var
LInput: TLastInputInfo;
Screenshots: cardinal; // сколько сделано скриншотов в данном процессе
Ticks, delta: cardinal; // время, потраченное на создание скриншотов
IdleTime: cardinal; // время бездействия в мсек
UserIsActive: Boolean;
Seconds: cardinal;
begin
Screenshots := 0;
Ticks := 0;
Seconds := 0;
try
repeat
// определяем время бездействия
LInput.cbSize := SizeOf(TLastInputInfo);
GetLastInputInfo(LInput);
IdleTime := (GetTickCount - LInput.dwTime);
UserIsActive := IdleTime <= FSettings.MaxIdleTime * 1000;
// делаем скриншот 1 раз в 10 сек
if Seconds mod 10 = 0 then begin
if UserIsActive then begin
try
delta := GetTickCount;
GetScreenShot(FSettings.ScreenshotsPath, FSettings.Prefix, FSettings.JpegQuality);
Inc(Screenshots);
Inc(Ticks, GetTickCount - delta);
// сбросим в лог статистику
if Screenshots mod 100 = 0 then begin
LogLine(Format('%d screenshots, aver. time %0.1f ms', [Screenshots, Ticks / Screenshots]));
end;
except
on E: Exception do
LogLine('Error: ' + E.Message, True);
end;
end;
end;
Sleep(1000);
Inc(Seconds);
until False;
except
on E: Exception do
LogLine('Error: ' + E.Message, True);
end;
end.
|
