【发布时间】：2020-10-26 19:42:52
【问题描述】：
我最近在截屏（用于远程桌面系统）方面做了很多工作，但在尝试实现对多显示器的支持时偶然发现了一个问题。虽然截屏是可以的，但我用来绘制光标的方法只假定 1 个屏幕。如果我将指针放在另一个屏幕上（在对该附加屏幕进行屏幕截图时），则光标不会显示。我将指针移到主屏幕，它显示（当然在错误的位置，因为它是错误的屏幕）。
我的代码完全在下面。
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.
【问题讨论】：
-
所以真正的问题是计算相对于屏幕截图的鼠标光标位置？
-
根据当前正在交互的监视器确定指针的正确 X/Y 位置。
-
那么，问那个问题。我们没有理由需要筛选您的代码并截取屏幕截图。这显然与问题无关。
-
当他在第二台显示器上时，我只需要让鼠标指针出现在屏幕截图上，
-
您必须获取光标的屏幕位置，将其映射到 BMP 的坐标空间，然后手动实际绘制光标。查看
GetCursorPos()，或者更好的GetCursorInfo()，它在一次调用中为您提供HCURSOR句柄及其屏幕位置，而不是使用GetIconInfo()。要在 BMP 上实际绘制HCURSOR，您可以使用DrawIcon/Ex()
标签： delphi winapi screenshot multiple-monitors delphi-10.3-rio