在另一个问题中,我问过:Drawing on a paintbox - How to keep up with mouse movements without delay?。
Sebastian Z引起了GetMouseMovePointsEx
函数的注意,但是在拉撒路我无法找到这个函数。
他提到在Delphi XE6中它位于Winapi.Windows.pas
,在Lazarus中虽然它不在Windows.pas
中。
我理解Lazarus绝不是Delphi的精确副本,但这个功能听起来像是我在其他问题中寻找的答案。我只是很难找到它的位置,甚至得到任何Delphi文档。我有Delphi XE,但现在它没有安装,我的项目是用Lazarus编写的。
我在Lazarus IDE中搜索了一个 Find in Files ... 搜索目标安装文件夹,唯一的结果是来自其中一个fpc来源:
拉扎勒斯\ FPC \ 2.6.4 \源\包\ winunits-绝\ SRC \ jwawinuser.pas
我不确定是否应该使用上述单位,或者Lazarus是否有与GetMouseMovePointsEx?
不同的变体
使用Lazarus的人是否有使用GetMouseMovePointsEx
的经验,若有,我在哪里可以找到它?
感谢。
答案 0 :(得分:1)
此函数作为Win32库的一部分实现。它不再是Delphi或FPC函数,而是C ++或VB函数。您从Win32导入它。
在Delphi中,这种导入是通过在Windows
单元中声明函数来实现的。如果你检查这个单元的来源,你会发现很多类型和常量声明,以及函数。这些函数通常使用external
关键字实现,该关键字指示实现在此代码外部。 Windows
单位就是所谓的标题翻译。这是它是Win32 SDK中C / C ++头文件的翻译。
因此您需要使用此功能进行标题翻译。 JEDI标题翻译是最常用的选择。似乎你已经找到了它们。如果随FPC提供的版本满足您的需求,请使用它们。
有时您可能会发现自己处于进步的最前沿,需要使用未包含在任何标准标题翻译中的函数。在那种情况下,它通常很简单,可以自己进行翻译。
答案 1 :(得分:1)
这是使用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;