在鼠标拖出边界后，控件如何接收鼠标事件？

Question

我正在创建一个自定义控件，可以识别拖动鼠标的时间，特别是使用消息WM_LBUTTONDOWN，WM_LBUTTONUP和WM_MOUSEMOVE。当鼠标宕机时，我捕捉到控件上的位置，然后当鼠标移动时，如果鼠标左键按下，我会做更多处理（在起点和终点之间计算）。

问题是，我希望鼠标不受控制，甚至超出窗体，但是当鼠标离开控件时，它不再捕获鼠标事件。有没有一种方法可以在没有鼠标控制的情况下专门处理WM_MOUSEMOVE和WM_LBUTTONUP消息？

Answer 1

当光标移出控件时，您可以使用SetCapture/ReleaseCapture Windows API继续获取鼠标事件。

Answer 2

Releasecapture适用于Wincontrols，另一种方式可能是Mousehook。那只是一个演示....

unit MouseHook;
// 2012 by Thomas Wassermann
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type

  TForm3 = class(TForm)
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form3: TForm3;

implementation

var
  HookHandle: Cardinal;

Type
  tagMSLLHOOKSTRUCT = record
    POINT: TPoint;
    mouseData: DWORD;
    flags: DWORD;
    time: DWORD;
    dwExtraInfo: DWORD;
  end;
  TMSLLHOOKSTRUCT = tagMSLLHOOKSTRUCT;
  PMSLLHOOKSTRUCT = ^TMSLLHOOKSTRUCT;

{$R *.dfm}

function LowLevelMouseProc(nCode: Integer; wParam: wParam; lParam: lParam): LRESULT; stdcall;
var
 Delta:Smallint;
begin
  if (nCode >= 0) then
  begin
    Form3.Caption := Format('X: %d  Y: %d ', [PMSLLHOOKSTRUCT(lParam)^.Point.X,  PMSLLHOOKSTRUCT(lParam)^.Point.Y]);
    if wParam = WM_LButtonDOWN then Form3.Caption := Form3.Caption + ' LD';
    if wParam = WM_LButtonUP then Form3.Caption := Form3.Caption + ' LU';
    if wParam = WM_RButtonDOWN then Form3.Caption := Form3.Caption + ' RD';
    if wParam = WM_RButtonUP then Form3.Caption := Form3.Caption + ' RU';
    if wParam =  WM_MOUSEMOVE then Form3.Caption := Form3.Caption + ' Move';
    Delta := PMSLLHOOKSTRUCT(lParam)^.mouseData shr 16;
    if wParam =  WM_MOUSEWHEEL then
          begin

            Form3.Caption := Form3.Caption + ' Wheel ' ;
            if Delta=120 then Form3.Caption := Form3.Caption + ' KLICK'
            else if Delta > 0  then Form3.Caption := Form3.Caption +' UP'
            else if Delta < 0  then Form3.Caption := Form3.Caption +' DOWN'
          end;
    if wParam =  WM_MOUSEHWHEEL then
          begin
            Form3.Caption := Form3.Caption + ' HWheel';
            if Delta=120 then Form3.Caption := Form3.Caption + ' KLICK'
            else if Delta > 0  then Form3.Caption := Form3.Caption +' UP'
            else if Delta < 0  then Form3.Caption := Form3.Caption +' DOWN'

          end;
     Form3.Caption := Form3.Caption +' >> '+ IntToStr(Delta)

  end;
  Result := CallNextHookEx(HookHandle, nCode, wParam, lParam);
end;

function InstallMouseHook: Boolean;
begin
  Result := False;
  if HookHandle = 0 then
  begin
    HookHandle := SetWindowsHookEx(WH_MOUSE_LL, @LowLevelMouseProc, hInstance, 0);
    Result := HookHandle <> 0;
  end;
end;

procedure TForm3.FormCreate(Sender: TObject);
begin
  InstallMouseHook;
end;

procedure TForm3.FormDestroy(Sender: TObject);
begin
  if HookHandle <> 0 then
    UnhookWindowsHookEx(HookHandle);
end;

end.

Answer 3

我接受了上面的答案，但我对此实现的最终版本却截然不同。我想我会分享我想出的东西，因为多次实现一个独特的鼠标钩子有点棘手。

现在提供的演示bummi已修复并内置于表单的单元中。我创建了一个新单元并将所有内容包装在那里。棘手的部分是函数LowLevelMouseProc不能成为类的一部分。然而，在这个函数中，它调用特定于钩子句柄（Result := CallNextHookEx(HookHandle, nCode, wParam, lParam);）的调用。所以我所做的是创建了一个存储桶（TList），我在其中转储了鼠标对象的每个实例。调用此函数时，它会遍历此存储桶并触发每个实例的相应事件。该型号还包括内置的线程安全保护（未经测试）。

这是完整的单位：

<强> JD.Mouse.pas

unit JD.Mouse;

interface

uses
  Windows, Classes, SysUtils, Messages, Controls;

type
  TJDMouseButtonPoints = Array[TMouseButton] of TPoint;
  TJDMouseButtonStates = Array[TMouseButton] of Boolean;

  TJDMouse = class(TComponent)
  private
    FOnButtonUp: TMouseEvent;
    FOnMove: TMouseMoveEvent;
    FOnButtonDown: TMouseEvent;
    FButtonPoints: TJDMouseButtonPoints;
    FButtonStates: TJDMouseButtonStates;
    procedure SetCursorPos(const Value: TPoint);
    function GetCursorPos: TPoint;
    procedure DoButtonDown(const IsDown: Boolean; const Button: TMouseButton;
      const Shift: TShiftState; const X, Y: Integer);
    procedure DoMove(const Shift: TShiftState; const X, Y: Integer);
  public
    constructor Create(AOwner: TComponent);
    destructor Destroy; override;
  published
    property CursorPos: TPoint read GetCursorPos write SetCursorPos;
    property OnButtonDown: TMouseEvent read FOnButtonDown write FOnButtonDown;
    property OnButtonUp: TMouseEvent read FOnButtonUp write FOnButtonUp;
    property OnMove: TMouseMoveEvent read FOnMove write FOnMove;
  end;

implementation

var
  _Hook: Cardinal;
  _Bucket: TList;
  _Lock: TRTLCriticalSection;

procedure LockMouse;
begin
  EnterCriticalSection(_Lock);
end;

procedure UnlockMouse;
begin
  LeaveCriticalSection(_Lock);
end;

type
  tagMSLLHOOKSTRUCT = record
    POINT: TPoint;
    mouseData: DWORD;
    flags: DWORD;
    time: DWORD;
    dwExtraInfo: DWORD;
  end;
  TMSLLHOOKSTRUCT = tagMSLLHOOKSTRUCT;
  PMSLLHOOKSTRUCT = ^TMSLLHOOKSTRUCT;

function LowLevelMouseProc(nCode: Integer; wParam: wParam; lParam: lParam): LRESULT; stdcall;
var
  X: Integer;
  Delta: Smallint;
  M: TJDMouse;
  P: TPoint;
  Shift: TShiftState;
begin
  if (nCode >= 0) then begin
    LockMouse;
    try
      Delta := PMSLLHOOKSTRUCT(lParam)^.mouseData shr 16;
      try
        for X := 0 to _Bucket.Count - 1 do begin
          try
            M:= TJDMouse(_Bucket[X]);
            P:= Controls.Mouse.CursorPos;
            //Shift:= .....;   //TODO
            case wParam of
              WM_LBUTTONDOWN: begin
                M.DoButtonDown(True, mbLeft, Shift, P.X, P.Y);
              end;
              WM_LBUTTONUP: begin
                M.DoButtonDown(False, mbLeft, Shift, P.X, P.Y);
              end;
              WM_RBUTTONDOWN: begin
                M.DoButtonDown(True, mbRight, Shift, P.X, P.Y);
              end;
              WM_RBUTTONUP: begin
                M.DoButtonDown(False, mbRight, Shift, P.X, P.Y);
              end;
              WM_MBUTTONDOWN: begin
                M.DoButtonDown(True, mbMiddle, Shift, P.X, P.Y);
              end;
              WM_MBUTTONUP: begin
                M.DoButtonDown(False, mbMiddle, Shift, P.X, P.Y);
              end;
              WM_MOUSEMOVE: begin
                M.DoMove(Shift, P.X, P.Y);
              end;
              WM_MOUSEWHEEL: begin
                //TODO
              end;
              WM_MOUSEHWHEEL: begin
                //TODO
              end;
            end;
          except
            on e: exception do begin
              //TODO
            end;
          end;
        end;
      except
        on e: exception do begin
          //TODO
        end;
      end;
    finally
      UnlockMouse;
    end;
  end;
  Result:= CallNextHookEx(_Hook, nCode, wParam, lParam);
end;

{ TJDMouse }

constructor TJDMouse.Create(AOwner: TComponent);
begin
  LockMouse;
  try
    _Bucket.Add(Self); //Add self to bucket, registering to get events
  finally
    UnlockMouse;
  end;
end;

destructor TJDMouse.Destroy;
begin
  LockMouse;
  try
    _Bucket.Delete(_Bucket.IndexOf(Self)); //Remove self from bucket
  finally
    UnlockMouse;
  end;
  inherited;
end;

procedure TJDMouse.DoButtonDown(const IsDown: Boolean;
  const Button: TMouseButton; const Shift: TShiftState; const X, Y: Integer);
begin
  //Do not use lock, this is called from the lock already
  if IsDown then begin
    if assigned(FOnButtonDown) then
      FOnButtonDown(Self, Button, Shift, X, Y);
  end else begin
    if assigned(FOnButtonUp) then
      FOnButtonUp(Self, Button, Shift, X, Y);
  end;
end;

procedure TJDMouse.DoMove(const Shift: TShiftState; const X, Y: Integer);
begin
  //Do not use lock, this is called from the lock already
  if assigned(FOnMove) then
    FOnMove(Self, Shift, X, Y);
end;

function TJDMouse.GetCursorPos: TPoint;
begin
  LockMouse;
  try
    Result:= Controls.Mouse.CursorPos;
  finally
    UnlockMouse;
  end;
end;

procedure TJDMouse.SetCursorPos(const Value: TPoint);
begin
  LockMouse;
  try
    Controls.Mouse.CursorPos:= Value;
  finally
    UnlockMouse;
  end;
end;

initialization
  InitializeCriticalSection(_Lock);
  _Bucket:= TList.Create;
  _Hook:= SetWindowsHookEx(WH_MOUSE_LL, @LowLevelMouseProc, hInstance, 0);
finalization
  UnhookWindowsHookEx(_Hook);
  _Bucket.Free;
  DeleteCriticalSection(_Lock);
end.

以下是它的实施方式：

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FMouse: TJDMouse;
    procedure MouseButtonDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure MouseButtonUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure MouseMoved(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  end;

implementation

procedure TForm1.FormCreate(Sender: TObject);
begin
  FMouse:= TJDMouse.Create(nil);
  FMouse.OnButtonDown:= MouseButtonDown;
  FMouse.OnButtonUp:= MouseButtonUp;
  FMouse.OnMove:= MouseMoved;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FMouse.Free;
end;

procedure TForm1.MouseButtonDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin

end;

procedure TForm1.MouseButtonUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin

end;

procedure TForm1.MouseMoved(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin

end;

end.

Answer 4

如果您正在使用VCL控件，则可以使用TControlStyle.csCaptureMouse标志。我不确定是否有FMX对应物。 Relevant docs here

我在许多自定义控件中使用csCaptureMouse，效果很好。