delphi - 当鼠标被钩住时，窗口接收无限量的消息

标签 delphi hook message

我正在编写一个应用程序，它应该在用户单击鼠标的地方画一个圆圈。为了实现这一点，我使用 SetWindowHookEx(WH_MOUSE,...)

全局挂接鼠标

Hook 和处理鼠标 Action 的程序位于DLL中。当该过程发现单击鼠标按钮时，使用 PostMessage(FindWindow('TMyWindow',nil), MyMessage, 0,0);

发布一条注册消息

我的 TMyWindow 表单应用程序处理 WndProc 过程中的消息。我检查收到的消息是否与我注册的消息相同，然后才画圆圈。绘制圆圈后，我创建一个计时器，它应该在 500 毫秒后释放图像。

所以一切似乎都工作得很好，直到我实际单击申请表的任何部分(例如单击不久前绘制的仍然存在的圆圈)。当我这样做时，表单开始无限地接收我的注册消息，当然每次都会调用圆圈绘制程序。

我不明白为什么要这样做。为什么当我单击申请表上的某个位置时它工作正常，但当我单击表单内部时它会挂起？

如果您需要更多详细信息，请告诉我。

谢谢

编辑 1:

主要装置。 $202 消息是 WM_LBUTTONUP。

unit main;

interface

uses
    HookCommon,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Menus, AppEvnts;


type
    TTimer2 = class(TTimer)
    private
        FShape: TShape;
    public
        destructor Destroy; override;
        property Shape: TShape read FShape write FShape;
    end;

type
  TShowMouseClick = class(TForm)
    timerCountTimer: TTimer;
    tray: TTrayIcon;
    popMenu: TPopupMenu;
    mnuExit: TMenuItem;
    mnuActive: TMenuItem;
    N1: TMenuItem;
    mnuSettings: TMenuItem;
    timersStx: TStaticText;
    procedure timerCountTimerTimer(Sender: TObject);
    procedure mnuExitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    timerList: TList;
    procedure shape();
    procedure freeInactive(var Msg: TMessage); message WM_USER + 1545;
  public
    shapeColor: Tcolor;                    
    procedure TimerExecute(Sender: TObject);
  protected
    procedure WndProc(var Message: TMessage); override;
    { Public declarations }
  end;

var
  ShowMouseClick: TShowMouseClick;



implementation
{$R *.dfm}

uses settings;

{$REGION 'Hide from TaskBar'}
procedure TShowMouseClick.FormActivate(Sender: TObject);
begin
  ShowWindow(Application.Handle, SW_HIDE);  
end;
procedure TShowMouseClick.FormShow(Sender: TObject);
begin
  ShowWindow(Application.Handle, SW_HIDE);
end;
{$ENDREGION}

procedure TShowMouseClick.WndProc(var Message: TMessage);
begin
    inherited WndProc(Message);
    if (Message.Msg = HookCommon.MouseHookMessage) and
        (Message.WParam = $202) then
        shape;
end;

procedure TShowMouseClick.FormCreate(Sender: TObject);
begin
  BorderStyle := bsNone;
  FormStyle := fsStayOnTop;
  WindowState := wsMaximized;

  mnuActive.Checked := true;
  HookCommon.HookMouse;
  timerList := TList.Create;
  timerList.Clear;
  shapeColor := clGreen;
end;

procedure TShowMouseClick.FormDestroy(Sender: TObject);
begin
    HookCommon.UnHookMouse;
end;

procedure TShowMouseClick.mnuExitClick(Sender: TObject);
begin
  Close;
end;

procedure TShowMouseClick.timerCountTimerTimer(Sender: TObject);
begin
  timersStx.Caption := 'Active timers: ' + IntToStr(timerList.Count);
end;

procedure TShowMouseClick.shape;  
var
  tm: TTimer2;
begin
  tm := TTimer2.Create(nil);

  tm.Tag := 0 ;
  tm.Interval := 1;
  tm.OnTimer := TimerExecute;
  tm.Shape := nil;
  timerList.Add(tm);
  timersStx.Caption := 'Active timers: ' + IntToStr(timerList.Count);
  tm.Enabled := true;
end;

procedure TShowMouseClick.TimerExecute(Sender: TObject);
var
    img: TShape;
    snd: TTimer2;
begin
    snd := nil;
    if Sender is TTimer2 then
        snd := TTimer2(Sender);

    if snd = nil then Exit;

    if snd.Tag = 0 then
    begin
        snd.Interval := 500;
        img := TShape.Create(nil);
        img.Parent := ShowMouseClick;
        img.Brush.Color := clGreen;
        img.Shape := stCircle;
        img.Width := 9;
        img.Height := 9;
        img.Left := Mouse.CursorPos.X-4;
        img.Top := Mouse.CursorPos.Y-3;
        snd.Tag := 1;
        snd.Shape := img;
    end else begin
        snd.Enabled := false;
        PostMessage(ShowMouseClick.Handle,WM_USER + 1545 , 0,0);
        Application.ProcessMessages;
    end;

end;

procedure TShowMouseClick.freeInactive(var Msg: TMessage);
var
    i: integer;
begin
    for i := timerList.Count - 1 downto 0 do
        if TTimer2(timerList[i]).Enabled = false then
        begin
            TTimer2(timerList[i]).Free;
            timerList.Delete(i);
        end;
end;

destructor TTimer2.Destroy;
begin
    FreeAndNil(FShape);
    inherited;
end;

end.

通用单位。

unit HookCommon;

interface

uses Windows;

var
  MouseHookMessage: Cardinal;

procedure HookMouse;
procedure UnHookMouse;

implementation

procedure HookMouse; external 'MouseHook.DLL';
procedure UnHookMouse; external 'MouseHook.DLL';

initialization
  MouseHookMessage := RegisterWindowMessage('MouseHookMessage');
end.

DLL代码。

library MouseHook;

uses
  Forms,
  Windows,
  Messages,
  HookCommon in 'HookCommon.pas';

{$J+}
const
  Hook: HHook = 0;
{$J-}


{$R *.res}

function HookProc(nCode: Integer; MsgID: WParam; Data: LParam): LResult; stdcall;
var
  notifyTestForm : boolean;
begin

  notifyTestForm := false;

  if msgID = $202 then
    notifyTestForm := true;
  if notifyTestForm then
  begin
       PostMessage(FindWindow('TShowMouseClick', nil), MouseHookMessage, MsgID, 0);
  end;

  Result := CallNextHookEx(Hook,nCode,MsgID,Data);
end;

procedure HookMouse; stdcall;
begin
  if Hook = 0 then Hook:=SetWindowsHookEx(WH_MOUSE,@HookProc,HInstance,0);
end;

procedure UnHookMouse; stdcall;
begin
  UnhookWindowsHookEx(Hook);
  Hook:=0;
end;

exports
  HookMouse, UnHookMouse;

begin
end.

鼠标钩子(Hook)的来源是 this

最佳答案

Why is it working fine when i click somewhere off my application form but hangs when i click inside my form?

当您单击其他窗口时，您不会将消息发布到其他窗口。首先，您应该问自己，“如果我在钩子(Hook)回调中向所有发布了 WM_LBUTTONUP 的窗口发布一条消息，会发生什么？”。

替换此行

PostMessage(FindWindow('TShowMouseClick', nil), MouseHookMessage, MsgID, 0);

在您的 dll 代码中，使用以下内容:

PostMessage(PMouseHookStruct(Data).hwnd, MouseHookMessage, MsgID, 0);

其他应用程序是否知道 MouseHookMes​​sage 是什么并不重要，它们都会忽略该消息。启动您的应用程序并疯狂地单击鼠标到其他窗口。一般不会有什么事情发生。除非您单击任何 Delphi 应用程序的客户区。你会立即卡住它。


这个问题的答案在于 VCL 消息循环如何运行以及 WH_MOUSE 钩子(Hook)如何工作。引用自 MouseProc 回调函数的 documentation .

[..] The system calls this function whenever an application calls the GetMessage or PeekMessage function and there is a mouse message to be processed.

假设您启动应用程序并且鼠标被钩住，然后将鼠标悬停在表单上并等待应用程序调用“WaitMessage”，即它处于空闲状态。现在单击客户区以生成鼠标消息。发生的情况是操作系统将消息放置到应用程序主线程的消息队列中。您的应用程序所做的就是使用 PeekMessage 删除并分派(dispatch)这些消息。这就是应用程序不同的地方。 VCL 首先使用传入“wRemoveMsg”参数的“PM_NOREMOVE”调用“PeekMessage”，而大多数其他应用程序要么通过调用“PeekMessage”来删除消息，要么使用“GetMessage”执行相同操作。

现在假设轮到“WM_LBUTTONUP”了。请参阅上面的引用。一旦调用 PeekMessage，操作系统就会调用 MouseProc 回调。该调用发生在“user32.dll”中，也就是说，当调用钩子(Hook)回调时，“PeekMessage”后面的语句尚未执行。另外，请记住 VCL 循环，消息仍在队列中，尚未被删除。现在，您的回调函数将一条消息发送到同一消息队列并返回。执行返回到 VCL 消息循环，VCL 再次调用“PeekMessage”，这一次是为了删除并分派(dispatch)消息，但它不会删除“WM_LBUTTONUP”，而是删除您发布的自定义消息。 “WM_LBUTTONUP”保留在队列中。发送自定义消息后，由于“WM_LBUTTONUP”仍在队列中，因此再次调用“PeekMessage”，操作系统再次调用回调，以便回调可以发布另一条要删除的自定义消息，而不是鼠标消息。该循环有效地卡住了应用程序。


要解决此问题，请将消息发布到具有自己的消息循环的不同线程，该循环会以某种方式与主线程同步，或者，我不会特别建议它，但不要发布消息，发送。作为一种替代方法，您可以自己从队列中删除“WM_LBUTTONUP”消息(如果存在):

procedure TShowMouseClick.WndProc(var Message: TMessage);
begin
    inherited WndProc(Message);
    if (Message.Msg = HookCommon.MouseHookMessage) and
        (Message.WParam = $202) then begin
      if PeekMessage(Msg, Handle, WM_LBUTTONUP, WM_LBUTTONUP, PM_REMOVE) then
        DispatchMessage(Msg);  // or eat if you don't need it.

     ..

end;

这种方法的缺点是，如上所述，PeekMessage 本身将导致发布另一条自定义消息，因此您将成对接收这些消息。

关于delphi - 当鼠标被钩住时，窗口接收无限量的消息，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/8648314/

上一篇：delphi - 捕获击键以导航自定义控件内手动绘制的项目？

下一篇：delphi - 如何在delphi 7中的TMemo中将选定的文本属性更改为粗体？

相关文章：

c - Windows(或 Linux)中的不间断进程？

c++ - Hook WH_CALLWNDPROC 后未获取窗口过程消息

c++ - 控件的 MFC 消息流？

mysql - 用于向多个用户发送消息的数据库架构

delphi - 如何以编程方式获取 chromium 加载文档的屏幕截图？

delphi - 如何从TVirtualStringTree中删除所有节点？

Android RIL套接字和电话加密？

java - android中的聊天应用程序，以便发送者和接收者消息应该在不同的一边

delphi - 在 Delphi 中使用指针

delphi - FDQuery 导致内存不足异常

©2024 IT工具网  联系我们