拉撒路(Lazarus)中有GetMouseMovePointsEx函数吗?

问题描述

在另一个问题中，我问:.

In this other question I asked: Drawing on a paintbox - How to keep up with mouse movements without delay?.

函数GetMouseMovePointsEx由 Sebastian Z 引起了我的注意，但是在拉撒路，我无法找到此功能.

The function GetMouseMovePointsEx was brought to my attention by Sebastian Z, however in Lazarus I am unable to find this function.

他提到在Delphi XE6中它在Winapi.Windows.pas中，在Lazarus中，尽管不在Windows.pas中.

He mentioned that in Delphi XE6 it is in Winapi.Windows.pas, in Lazarus though it is not in Windows.pas.

我知道Lazarus绝不是Delphi的精确副本，但此功能听起来可能是我在其他问题中正在寻找的答案.我只是很难找到它的位置，甚至在上面找到任何Delphi文档.我确实有Delphi XE，但目前尚未安装，并且我的项目是用Lazarus编写的.

I understand Lazarus is by no means an exact copy of Delphi but this function sounds like it could be the answer I am looking for in that other question. Im just having a hard time finding where it is and even getting any Delphi documentation on it. I do have Delphi XE but right now it is not installed and my project is been written in Lazarus.

我在Lazarus IDE中针对安装文件夹进行了查找文件... 搜索，唯一返回的结果是来自以下fpc来源之一:

I did a Find in Files... search from the Lazarus IDE targeting the install folder and the only result that came back was from one of the fpc sources in:

我不确定是否应该使用上述单位，或者Lazarus是否与GetMouseMovePointsEx?有不同的变体

I am not sure if I should use the above unit or not, or whether Lazarus has a different variant to GetMouseMovePointsEx?

使用Lazarus的任何人都对GetMouseMovePointsEx有任何经验吗?如果可以，我在哪里可以找到它?

Does anyone using Lazarus have any experience with GetMouseMovePointsEx and if so where can I find it?

谢谢.

推荐答案

下面是一个使用Delphi的简单示例.您仍然需要做的就是过滤掉您已经收到的积分.

Here's a quick example using Delphi. What you still need to do is filter out the points you've already received.

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;

这篇关于拉撒路(Lazarus)中有GetMouseMovePointsEx函数吗?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！