Lazarus中有GetMouseMovePointsEx函数吗?

时间:2014-08-28 09:59:36

标签: delphi lazarus

在另一个问题中,我问过: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的经验,若有,我在哪里可以找到它?

感谢。

2 个答案:

答案 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;