Here you go:
program Test;
{$MODE Delphi}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
windows,
Classes
{ you can add units after this };
function ScreenShot(const AFileName: String): Boolean;
var
bFileHeader: TBitmapFileHeader;
bHandle: HGLOBAL;
bInfoHeader: PBitmapInfoHeader;
ms: TMemoryStream;
begin
Result := False;
Keybd_Event(VK_SNAPSHOT, MapVirtualKey(VK_SNAPSHOT, 0), 0, 0);
Keybd_Event(VK_SNAPSHOT, MapVirtualKey(VK_SNAPSHOT, 0), KEYEVENTF_KEYUP, 0);
Sleep(2000);
if OpenClipboard(0) then
begin
bHandle := GetClipboardData(CF_DIB);
if bHandle <> 0 then
begin
bInfoHeader := GlobalLock(bHandle);
if bInfoHeader <> nil then
begin
FillChar(bFileHeader, SizeOf(bFileHeader), 0);
bFileHeader.bfType := $4D42;
bFileHeader.bfSize := SizeOf(bFileHeader) + GlobalSize(bHandle);
bFileHeader.bfOffBits := SizeOf(bFileHeader) + bInfoHeader.biSize;
ms := TMemoryStream.Create;
try
ms.WriteBuffer(bFileHeader, SizeOf(bFileHeader));
ms.WriteBuffer(bInfoHeader^, bFileHeader.bfSize - SizeOf(bFileHeader));
ms.Position := 0;
ms.SaveToFile(AFileName);
Result := True;
finally
ms.Free;
end;
GlobalUnlock(bHandle)
end;
end;
CloseClipboard;
end;
end;
begin
if ScreenShot('c:\test.bmp') then
Writeln('success')
else
Writeln('failed');
Readln;
end.