program Test;
{$APPTYPE CONSOLE}
{$R *.res}
uses
Windows,
vcl.Graphics,
SysUtils;
function GetCursorInfo2: TCursorInfo;
var
hWindow: HWND;
pt: TPoint;
dwThreadID, dwCurrentThreadID: DWORD;
begin
Result.hCursor := 0;
ZeroMemory(@Result, SizeOf(Result));
if GetCursorPos(pt)
then
begin
Result.ptScreenPos := pt;
hWindow := WindowFromPoint(pt);
if IsWindow(hWindow)
then
begin
dwThreadID := GetWindowThreadProcessId(hWindow,
nil);
dwCurrentThreadID := GetCurrentThreadId;
if (dwCurrentThreadID <> dwThreadID)
then
begin
if AttachThreadInput(dwCurrentThreadID, dwThreadID, True)
then
begin
Result.hCursor := GetCursor;
AttachThreadInput(dwCurrentThreadID, dwThreadID, False);
end;
end
else
Result.hCursor := GetCursor;
end;
end;
end;
procedure TakeScreenshot(
var Bmp: TBitmap; WndHdc: HDC; Width, Height, Left, Top: Integer);
const
CAPTUREBLT = $40000000;
var
DesktopCanvas: TCanvas;
MyCursor: TIcon;
CursorInfo: TCursorInfo;
IconInfo: TIconInfo;
DC: HDC;
begin
DC := GetDC(WndHdc);
try
if (
DC = 0)
then
Exit;
Bmp.Width := Width;
Bmp.Height := Height;
DesktopCanvas := TCanvas.Create;
try
DesktopCanvas.Handle :=
DC;
BitBlt(Bmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, DesktopCanvas.Handle, Left, Top, SRCCOPY
or CAPTUREBLT);
MyCursor := TIcon.Create;
try
CursorInfo := GetCursorInfo2;
if CursorInfo.hCursor <> 0
then
begin
MyCursor.Handle := CursorInfo.hCursor;
GetIconInfo(CursorInfo.hCursor, IconInfo);
Bmp.Canvas.Draw(CursorInfo.ptScreenPos.X - IconInfo.xHotspot, CursorInfo.ptScreenPos.Y - IconInfo.yHotspot, MyCursor);
end;
finally
MyCursor.ReleaseHandle;
MyCursor.Free;
end;
finally
DesktopCanvas.Free;
end;
finally
if (
DC <> 0)
then
ReleaseDC(0,
DC);
end;
end;
function EnumDisplayMonitors(
dc: HDC; rect: PRect; EnumProc: pointer; lData: Integer): Boolean;
stdcall;
external user32
name '
EnumDisplayMonitors';
type
TMonInfo =
record
h: THandle;
DC: HDC;
R: TRect;
end;
var
MonList:
array of TMonInfo;
function MonitorEnumProc(hMonitor: THandle; hdcMonitor: HDC; lprcMonitor: DWORD; dwData: Integer): Boolean;
stdcall;
var
I, Width, Height, Left, Top: Integer;
Bmp: TBitmap;
begin
I := High(MonList) + 1;
SetLength(MonList, I + 1);
MonList[I].h := hMonitor;
MonList[I].DC := hdcMonitor;
MonList[I].R := PRect(lprcMonitor)^;
Left := PRect(lprcMonitor)^.Left;
Top := PRect(lprcMonitor)^.Top;
Width := PRect(lprcMonitor)^.Width;
Height := PRect(lprcMonitor)^.Height;
Bmp := TBitmap.Create;
try
TakeScreenshot(Bmp, hdcMonitor, Width, Height, Left, Top);
Bmp.SaveToFile('
C:\Screen' + IntToStr(I + 1) + '
.bmp');
finally
Bmp.Free;
end;
Result := True;
end;
procedure Main;
var
S:
string;
I: Integer;
begin
Writeln('
Number of monitors: ' + IntToStr(High(MonList) + 1) + #13#10);
Writeln('
-----------------');
for I := 0
to High(MonList)
do
with MonList[I]
do
begin
S := #13#10 + '
Handle: ' + IntToStr(h) + #13#10 + '
Dc: ' + IntToStr(
DC) + #13#10 + '
Size: ' + IntToStr(R.Right) + '
x' + IntToStr(R.Bottom) + #13#10;
Writeln(S);
Writeln('
-----------------');
end;
end;
begin
try
EnumDisplayMonitors(0,
nil, Addr(MonitorEnumProc), 0);
Main;
Writeln(#13#10 + '
Connected: ' + IntToStr(GetSystemMetrics(SM_CMONITORS)) + #13#10);
except
on E:
Exception do
Writeln(E.ClassName, '
: ', E.
Message);
end;
Readln;
end.