在另一个问题中,我问:在绘画盒上绘画-如何跟上鼠标的移动而没有延迟?。
该功能GetMouseMovePointsEx
由Sebastian Z引起了我的注意,但是在拉撒路,我找不到此功能。
他提到在Delphi XE6中它在Winapi.Windows.pas
,而在Lazarus中它不在Windows.pas
。
我知道Lazarus绝不是Delphi的精确副本,但此功能听起来可能是我在其他问题中正在寻找的答案。我只是很难找到它的位置,甚至无法获得任何Delphi文档。我确实有Delphi XE,但目前尚未安装,我的项目是用Lazarus编写的。
我在Lazarus IDE中针对安装文件夹进行了“文件中查找...”搜索,唯一返回的结果是来自以下fpc来源之一:
lazarus \ fpc \ 2.6.4 \ source \ packages \ winunits-jedi \ src \ jwawinuser.pas
我不确定是否应该使用上述装置,或者Lazarus是否具有其他变体 GetMouseMovePointsEx?
使用Lazarus的人有经验GetMouseMovePointsEx
吗?如果可以,我在哪里可以找到它?
谢谢。
这是一个使用Delphi的简单示例。您仍然需要做的是过滤掉已经收到的积分。
type
TMouseMovePoints = array of TMouseMovePoint;
const
GMMP_USE_HIGH_RESOLUTION_POINTS = 2;
function GetMouseMovePointsEx(cbSize: UINT; var lppt: TMouseMovePoint; var lpptBuf: TMouseMovePoint; nBufPoints: Integer; resolution: DWORD): Integer; stdcall; external 'user32.dll';
function GetMessagePosAsTPoint: TPoint;
type
TMakePoints = packed record
case Integer of
1: (C : Cardinal);
2: (X : SmallInt; Y : SmallInt);
end;
var
Tmp : TMakePoints;
begin
Tmp.C := GetMessagePos;
Result.X := Tmp.X;
Result.Y := Tmp.Y;
end;
function GetMousePoints: TMouseMovePoints;
var
nVirtualWidth: Integer;
nVirtualHeight: Integer;
nVirtualLeft: Integer;
nVirtualTop: Integer;
cpt: Integer;
mp_in: MOUSEMOVEPOINT;
mp_out: array[0..63] of MOUSEMOVEPOINT;
mode: Integer;
Pt: TPoint;
I: Integer;
begin
Pt := GetMessagePosAsTPoint;
nVirtualWidth := GetSystemMetrics(SM_CXVIRTUALSCREEN) ;
nVirtualHeight := GetSystemMetrics(SM_CYVIRTUALSCREEN) ;
nVirtualLeft := GetSystemMetrics(SM_XVIRTUALSCREEN) ;
nVirtualTop := GetSystemMetrics(SM_YVIRTUALSCREEN) ;
cpt := 0 ;
mode := GMMP_USE_DISPLAY_POINTS ;
FillChar(mp_in, sizeof(mp_in), 0) ;
mp_in.x := pt.x and $0000FFFF ;//Ensure that this number will pass through.
mp_in.y := pt.y and $0000FFFF ;
mp_in.time := GetMessageTime;
cpt := GetMouseMovePointsEx(SizeOf(MOUSEMOVEPOINT), mp_in, mp_out[0], 64, mode) ;
for I := 0 to cpt - 1 do
begin
case mode of
GMMP_USE_DISPLAY_POINTS:
begin
if (mp_out[i].x > 32767) then
mp_out[i].x := mp_out[i].x - 65536;
if (mp_out[i].y > 32767) then
mp_out[i].y := mp_out[i].y - 65536;
end;
GMMP_USE_HIGH_RESOLUTION_POINTS:
begin
mp_out[i].x := ((mp_out[i].x * (nVirtualWidth - 1)) - (nVirtualLeft * 65536)) div nVirtualWidth;
mp_out[i].y := ((mp_out[i].y * (nVirtualHeight - 1)) - (nVirtualTop * 65536)) div nVirtualHeight;
end;
end;
end;
if cpt > 0 then
begin
SetLength(Result, cpt);
for I := 0 to cpt - 1 do
begin
Result[I] := mp_out[I];
end;
end
else
SetLength(Result, 0);
end;
// the following is for demonstration purposes only, it still needs some improvements like filtering out points that were already processed. But it's good enough for painting a blue line on a TImage
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
MMPoints: TMouseMovePoints;
Pt: TPoint;
I: Integer;
begin
Image1.Canvas.Pen.Color := clBlue;
MMPoints := GetMousePoints;
for I := 0 to Length(MMPoints) - 1 do
begin
Pt.x := MMPoints[I].x;
Pt.y := MMPoints[I].y;
Pt := Image1.ScreenToClient(Pt);
if I = 0 then
Image1.Canvas.MoveTo(PT.X, pt.y)
else
Image1.Canvas.LineTo(PT.X, pt.y);
end;
end;
本文收集自互联网,转载请注明来源。
如有侵权,请联系[email protected] 删除。
我来说两句