Is there a GetMouseMovePointsEx function in Lazarus?

问题

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

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

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

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.

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\fpc\2.6.4\source\packages\winunits-jedi\src\jwawinuser.pas

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

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

Thanks.

回答1:

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;

回答2:

This function is implemented as part of the Win32 library. It is no more a Delphi or FPC function than it is a C++ or VB function. You import it from Win32.

In Delphi, this importing is achieved by way of the declaration of the function in the Windows unit. If you examine the source of this unit you'll find lots of type and constant declarations, as well as functions. The functions are typically implemented using the external keyword which indicates that the implementation is external to this code. The Windows unit is what is known as a header translation. That is it is a translation of the C/C++ header files from the Win32 SDK.

So you need a header translation with this function. The JEDI header translations are the most usual choice. And it seems that you've already found them. If the versions supplied with FPC serve your needs, use them.

Sometimes you might find yourself on the bleeding edge of progress and need to use a function that has not been included in any of the standard header translations. In that scenario it's usually simple enough to perform the translation yourself.

来源：https://stackoverflow.com/questions/25545979/is-there-a-getmousemovepointsex-function-in-lazarus

标签

Delphi

lazarus