Крючок для мыши - программа заморозки - PullRequest
0 голосов
/ 13 января 2012

Я скачал образец крючка мыши, который не работал. Поэтому я удалил все ненужные вещи и хотел бы знать, что в этом плохого. Когда я запускаю программу, она и Delphi останавливаются, и я должен закрыть ее через taskmgr.

App:

type
...
    procedure ms(var message: tmessage); message WM_USER+1234;

  end;

var
  MainHookTestForm: TMainHookTestForm;

implementation
procedure HookMouse; stdcall; external 'MouseHook.DLL'; // Added stdcalls;
procedure UnHookMouse; stdcall; external 'MouseHook.DLL';

{$R *.dfm}    

procedure TMainHookTestForm.FormCreate(Sender: TObject);
begin
  HookMouse;
end;

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

procedure TMainHookTestForm.ms(var message: tmessage);
begin
  Label1.Caption:=format('%d - %d',[message.LParam, message.WParam]); // Edited
end;

Lib:

library MouseHook;
uses
  Forms,
  Windows,
  Messages;

var Hook: HHOOK;
{$R *.res}

function HookProc(nCode: Integer; MsgID: WParam; Data: LParam): LResult; stdcall;
var
  mousePoint: TPoint;
begin
  mousePoint := PMouseHookStruct(Data)^.pt;
  PostMessage(FindWindow('TMainHookTestForm', 'Main'), WM_USER+1234, mousePoint.X, mousePoint.Y); // Edited class name
  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.

Я думаю, что это так просто, как может. Заморозка происходит при вызове HookMouse, когда эта строка выполняется, вся IDE зависает, и я не могу отлаживать дальше. Но я не вижу ничего плохого в этой процедуре.

Я использую XE2, если это поможет. Спасибо за устранение неисправности


Редактировать : я отредактировал вызовы HookMouse и UnhookMouse с помощью stdcall; и имя класса окна для поиска. Кажется, что теперь он работает хорошо, он показывает правильные значения, НО только если курсор мыши не находится в окне приложения - когда я перемещаю мышь в окно, он меняется на HourGlass и заголовок надписи перестает обновляться. Что может вызвать это?

1 Ответ

3 голосов
/ 13 января 2012

У вас есть несколько проблем с вашим кодом.

1.Вы пропускаете stdcall соглашение о вызовах:

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

2.Вы изменяете заголовок в основной форме.поэтому FindWindow (в DLL) найдет окно только один раз.Вы можете использовать TMemo для отладки:

procedure TMainHookTestForm.ms(var message: tmessage);
begin
  Memo1.Lines.Add(format('%d - %d',[message.LParam, message.WParam]));
end;

2.1. Имя класса MainHookTestForm неверно.должно быть:

FindWindow('TMainHookTestForm', 'Main')

Обратите внимание на T MainHookTestForm

3. в HookProc вы должны использовать:

if nCode = HC_ACTION then
begin
  mousePoint := PMouseHookStruct(Data)^.pt;      
  PostMessage(FindWindow('TMainHookTestForm', 'Main'), WM_USER+1234, mousePoint.X, mousePoint.Y);
end;  

Result := CallNextHookEx(Hook,nCode,MsgID,Data);
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...