4

WM_LBUTTONDOWN特にメッセージ、、、WM_LBUTTONUPおよびを使用して、マウスがドラッグされていることを認識するカスタムコントロールを作成していますWM_MOUSEMOVE。マウスが下がったときにコントロール上の位置をキャプチャし、マウスが移動したときにマウスの左ボタンが下がった場合は、より多くの処理（開始点と終了点の間の計算）を行います。

問題は、マウスがコントロールから外れ、フォームから外れることを期待しているのですが、マウスがコントロールから外れると、マウスイベントをキャプチャしなくなります。マウスを制御せずに、メッセージをWM_MOUSEMOVE具体的に処理する方法はありますか？WM_LBUTTONUP

4

4 に答える 4

9

Windows APIを使用するSetCapture/ReleaseCaptureと、カーソルがコントロールの外に移動したときに、引き続きマウスイベントを取得できます。

于 2012-11-12T14:44:55.767 に答える
7

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.
于 2012-11-12T15:02:27.943 に答える
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.
于 2012-11-12T21:40:14.347 に答える