Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Вопрос про установку глобального хука [D6, WinXP]

Страницы: 1 2 >
leonidus © (2006-07-03 21:30:00)
Уважаемые мастера подскажите пожалуйста как мне поставить такой глобальный хук: хук ставится на щелчок правой клавиши мыши, после этого если пользователь нажимает скажем Ctrl и щелкает правой клавишей мыши, то хук срабатывает отсылая моему окну некое сообщение и при этом не дает отобразиться контекстному меню которое как правило во всех приложениях отображается по щелчку правой клавиши мыши. В остальных случаях (когда щелчок правой клавишей мыши произведен но Ctrl не нажат) все работает в обычном режиме, т.е. щелчки правой клавишей в любом приложении вызывают появление контекстного меню данного приложения.

Я делаю так, создаю dll`ку в которой есть функция получающая управления при перехвати действий мыши:

function Mouse_SysMsgProc(code : integer; wParam : word; lParam : longint) : longint; stdcall;
var H: HWND;
begin
if (Code=HC_ACTION) then
begin
H := FindWindow('TForm1', 'XXX');

//тут проверяю факт нажатия правой клавиши мыши и Ctrl`а
if (wParam = WM_RBUTTONDOWN) AND (HiWord(GetAsyncKeyState(VK_LCONTROL))<>0) then
SendMessage(H, wm_RightMouse_Event, 0, 0);
end;

Result:= CallNextHookEx(Mouse_SysHook, Code, wParam, lParam);
end;

Этот код позволяет мне узнать что нажата правая клавиша мыши и Ctrl, но не позволяет предотвратить появление контекстного меню. Как мне это сделать?

leonidus (2006-07-06 07:58:00) [1]
В общем вот последняя редакция кода:

const
WH_Mouse_LL = 14;

var
Form1: TForm1;
Mouse_SysHook: HHOOK;

implementation

{$R *.dfm}

function Mouse_SysMsgProc(code: integer;
wParam: longint; lParam : longint):longint; stdcall;
begin
if (Code=HC_ACTION) then
if (wParam = WM_RBUTTONUP) and (HiWord(GetAsyncKeyState(VK_LCONTROL))<>0) then
begin
form1.Label1.Caption:='wm_RightMouse_Event';
result:=-1;
end
else
begin
form1.Label1.Caption:='';
Result := CallNextHookEx(Mouse_SysHook, Code, wParam, LParam);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Mouse_SysHook := SetWindowsHookEx(WH_Mouse_LL, @Mouse_SysMsgProc, HInstance, 0);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if UnhookWindowsHookEx(Mouse_SysHook) then MessageBox(0, 'Хук на мышь снят', '', 0)
end;

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

leonidus (2006-07-05 22:12:00) [2]
блин точно, сейчас попробую WM_RBUTTONUP

guav (2006-07-05 18:15:00) [3]
к. меню появляется при отпускании мыни

leonidus (2006-07-05 15:47:00) [4]
Господа подскажите пожалуйста

leonidus (2006-07-04 20:07:00) [5]
Игорь, большое спасибо. Теперь вроде разобрался и вернулся к первому вопросу, как в случае если нажата "горячая клавиша" - скажем Ctrl, и произведен клик правой клавишей мыши не допустить появления контекстного меню в каком-либо приложении?

Пишу такой код:

const
WH_Mouse_LL = 14;

var
Form1: TForm1;
Mouse_SysHook: HHOOK;

implementation

{$R *.dfm}

function Mouse_SysMsgProc(code: integer;
wParam: longint; lParam : longint):longint; stdcall;
begin
if (Code=HC_ACTION) then
if (wParam = WM_RBUTTONDOWN) and (HiWord(GetAsyncKeyState(VK_LCONTROL))<>0) then
begin
form1.Label1.Caption:='wm_RightMouse_Event';
result:=1;
end
else
begin
form1.Label1.Caption:='';
Result := CallNextHookEx(Mouse_SysHook, Code, wParam, LParam);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Mouse_SysHook := SetWindowsHookEx(WH_Mouse_LL, @Mouse_SysMsgProc, HInstance, 0);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
UnhookWindowsHookEx(Mouse_SysHook);
end;

но после определения того что нажат Ctrl и правая клавиша мыши, контекстное меню всеравно благополучно появляется. Что я делаю не так?

Leonid Troyanovsky (2006-07-04 18:30:00) [6]

> второе явление Чапаева народу (04.07.06 09:57) [7]

> Дядя пошутил.

Не, просто, описАлся, чисто машинально.

Sorry.

--
Regards, LVT.

Gero (2006-07-04 18:04:00) [7]
Только стоит принять во внимание, что WH_MOUSE_LL отсутствует в Windows 9x/Me.

Игорь Шевченко (2006-07-04 17:28:00) [8]
unit Unit1;

interface

uses
Windows, Classes, Controls, Forms,
StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
end;

var
Form1: TForm1;

const
WH_Mouse_LL = 14;

implementation

{$R *.DFM}

var
Mouse_SysHook: HHOOK;

function Mouse_SysMsgProc(code: integer;
wParam: longint; lParam : longint):longint; stdcall;
begin
Result := CallNextHookEx(Mouse_SysHook, Code, wParam, LParam);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Mouse_SysHook := SetWindowsHookEx(WH_Mouse_LL, @Mouse_SysMsgProc, HInstance, 0);
end;

end.

Не ругается

Игорь Шевченко (2006-07-04 17:26:00) [9]

> function tform1.Mouse_SysMsgProc(code : integer; wParam
> : word; lParam : longint) : longint;

Убрать TForm1 из объявления

leonidus (2006-07-04 14:40:00) [10]
Я всеже не пойму почему на HInstance компилятор ругается, и в тоже время туже строчку в dll`ке компилирует нормально.

Ketmar (2006-07-04 14:22:00) [11]
странно. %-)

leonidus (2006-07-04 14:07:00) [12]
я пробовал делать так:

if (wParam = WM_RBUTTONDOWN) and (HiWord(GetAsyncKeyState(VK_LCONTROL))<>0) then
begin
form1.Label1.Caption:='wm_RightMouse_Event';
end
else
Result:= CallNextHookEx(Mouse_SysHook, Code, wParam, lParam);

т.е. следующему хуку упраление передавалось только если нет одновременного нажатия на Ctrl и правую клавишу мыши, а если они нажаты одновременно то CallNextHookEx управление не передается, но после такого трюка система вообще перестает реагировать на клики мыши, поэтому пришлось от этого отказаться.

Ketmar (2006-07-04 13:51:00) [13]
кстати, я тут заметил: а может, просто надо "съёдать" событие, когда оно не должно происходить? т.е. возвращать "не ноль" и не вызывать следующий хук при помощи CallNextHookEx()? а то мы тут уже полезли в LL-хуки... %-)

leonidus (2006-07-04 13:48:00) [14]
Компилятор выделяет строчку
Mouse_SysHook := SetWindowsHookEx(WH_Mouse_LL, @Mouse_SysMsgProc, HInstance, 0);
ставит курсор на HInstance и пишет: "Variable required"

Игорь Шевченко (2006-07-04 13:37:00) [15]

> ругается на HInstance

Дорогой друг, кроме фразы "ругается" желательно еще приаттачить скриншот экрана твоего монитора в момент ругани, а так же до ругани и после ругани.

leonidus (2006-07-04 13:07:00) [16]
Ни чего не понимаю, теперь в
Mouse_SysHook := SetWindowsHookEx(WH_Mouse_LL, @Mouse_SysMsgProc, HInstance, 0);

ругается на HInstance... может я уже туплю, но код скопировал прямо из dll`ки в которой все работало прекрасно

Игорь Шевченко (2006-07-04 12:06:00) [17]

> WH_Mouse_LL

const
WH_Mouse_LL = 14;

leonidus (2006-07-04 11:58:00) [18]
но на строчку: Mouse_SysHook := SetWindowsHookEx(WH_Mouse_LL, @Mouse_SysMsgProc, HInstance, 0);
компилятор ругается на WH_Mouse_LL, что делать?

leonidus (2006-07-04 11:56:00) [19]
Ок, делаю в самой программе без использования dll так:

var
Mouse_SysHook:HHook = 0;

implementation
{$R *.dfm}

function tform1.Mouse_SysMsgProc(code : integer; wParam : word; lParam : longint) : longint;
var H: HWND;
begin
if (Code=HC_ACTION) then
begin
if wParam = WM_RBUTTONDOWN then form1.Label1.Caption:='wm_RightMouse_Event';
end;
Result:= CallNextHookEx(Mouse_SysHook, Code, wParam, lParam);
end;

procedure tform1.hook(switch : Boolean);
begin
if switch=true then
begin
Mouse_SysHook := SetWindowsHookEx(WH_Mouse_LL, @Mouse_SysMsgProc, HInstance, 0);
if Mouse_SysHook <> 0 then MessageBox(0, 'Хук на мышь установлен', '', 0)
else MessageBox(0, 'Хук на мышь установить не удалось', '', 0);
end
else
begin
if UnhookWindowsHookEx(Mouse_SysHook) then MessageBox(0, 'Хук на мышь снят', '', 0)
else MessageBox(0, 'Хук на мышь снят не удалось', '', 0);

Mouse_SysHook := 0;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
//установить хук
hook(true);
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
//снять хук при выходе из программы
hook(false);
end;

Ketmar (2006-07-04 11:56:00) [20]
более того, LL-констант нет в заголовочных файлах Delphi. %-)

Страницы: 1 2 >

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »