Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

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

SetWindowsHookEx [D7, WinXP]


Лысеющий Самурай ©   (2007-04-29 11:42:00) 

Уважаемые Мастера подскажите пожалуйста почему прграмма неработает если кликаешь по заголовкам окон или например на 'ToolbarWindow32'

var
 Form1: TForm1;
 GWWM_MBUTTONDOWN: Cardinal;
 GWWM_MBUTTONUP: Cardinal;
 GWWM_LBUTTONDOWN: Cardinal;
 GWWM_LBUTTONUP: Cardinal;
 GWWM_RBUTTONDOWN: Cardinal;
 GWWM_RBUTTONUP: Cardinal;
 GWWM_MOUSEMOVE: Cardinal;

 procedure RunStopHook(State: Boolean) stdcall; external 'MouseHook.dll';

implementation

{$R *.dfm}

procedure TForm1.WndProc(var Msg: TMessage);
begin
inherited ;
 if Msg.Msg = GWWM_LBUTTONDOWN then
 begin
   Memo1.Lines.Add('Left Mouse Down');
 end;
 if Msg.Msg = GWWM_LBUTTONUP then
 begin
   Memo1.Lines.Add('Left Mouse Up');
 end;
 if Msg.Msg = GWWM_MBUTTONDOWN then
 begin
   Memo1.Lines.Add('Middle Mouse Down');
 end;
 if Msg.Msg = GWWM_MBUTTONUP then
 begin
   Memo1.Lines.Add('Middle Mouse Up');
 end;
 if Msg.Msg = GWWM_RBUTTONDOWN then
 begin
   Memo1.Lines.Add('Right Mouse Down');
 end;
 if Msg.Msg = GWWM_RBUTTONUP then
 begin
   Memo1.Lines.Add('Right Mouse Up');
 end;
 if Msg.Msg = GWWM_MOUSEMOVE then
 begin
   Caption:= IntToStr(Mouse.CursorPos.X) + ' / ' + IntToStr(Mouse.CursorPos.Y);
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 RunStopHook(True);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 RunStopHook(False);
end;

initialization
 GWWM_MBUTTONDOWN:= RegisterWindowMessage('GWWM_MBUTTONDOWN');
 GWWM_MBUTTONUP:= RegisterWindowMessage('GWWM_MBUTTONUP');
 GWWM_LBUTTONDOWN:= RegisterWindowMessage('GWWM_LBUTTONDOWN');
 GWWM_LBUTTONUP:= RegisterWindowMessage('GWWM_LBUTTONUP');
 GWWM_RBUTTONDOWN:= RegisterWindowMessage('GWWM_RBUTTONDOWN');
 GWWM_RBUTTONUP:= RegisterWindowMessage('GWWM_RBUTTONUP');
 GWWM_RBUTTONUP:= RegisterWindowMessage('GWWM_MOUSEMOVE');

end.


DLL

library MouseHook;

uses
 Windows, Messages, Controls;
var
 SysHook: HHook = 0;
 Wnd: Hwnd = 0;
 GWWM_MBUTTONDOWN: Cardinal;
 GWWM_MBUTTONUP: Cardinal;
 GWWM_LBUTTONDOWN: Cardinal;
 GWWM_LBUTTONUP: Cardinal;
 GWWM_RBUTTONDOWN: Cardinal;
 GWWM_RBUTTONUP: Cardinal;
 GWWM_MOUSEMOVE: Cardinal;

function SysMsgProc(code: integer; wParam: word; lParam: longint): longint; stdcall;
begin
CallNextHookEx(SysHook, Code, wParam, lParam);
if code = HC_ACTION then
begin
  Wnd:= TMsg(Pointer(lParam)^).hwnd;
  if TMsg(Pointer(lParam)^).message = WM_LBUTTONDOWN then
    SendMessage(HWND_BROADCAST, GWWM_LBUTTONDOWN, 0, 0);
  if TMsg(Pointer(lParam)^).message = WM_LBUTTONUP then
    SendMessage(HWND_BROADCAST, GWWM_LBUTTONUP, 0, 0);
  if TMsg(Pointer(lParam)^).message = WM_MBUTTONDOWN then
    SendMessage(HWND_BROADCAST, GWWM_MBUTTONDOWN, 0, 0);
  if TMsg(Pointer(lParam)^).message = WM_MBUTTONUP then
    SendMessage(HWND_BROADCAST, GWWM_MBUTTONUP, 0, 0);
  if TMsg(Pointer(lParam)^).message = WM_RBUTTONDOWN then
    SendMessage(HWND_BROADCAST, GWWM_RBUTTONDOWN, 0, 0);
  if TMsg(Pointer(lParam)^).message = WM_RBUTTONUP then
    SendMessage(HWND_BROADCAST, GWWM_RBUTTONUP, 0, 0);
  if TMsg(Pointer(lParam)^).message = WM_MOUSEMOVE then
    SendMessage(HWND_BROADCAST, GWWM_MOUSEMOVE, 0, 0);
 end;
end;

procedure RunStopHook(State : Boolean) export; stdcall;
begin
if State = true then
begin
  SysHook := SetWindowsHookEx(WH_GETMESSAGE, @SysMsgProc, HInstance, 0);
end
else
begin
  UnhookWindowsHookEx(SysHook);
  SysHook:= 0;
end;
end;

exports RunStopHook;

begin
 GWWM_MBUTTONDOWN:= RegisterWindowMessage('GWWM_MBUTTONDOWN');
 GWWM_MBUTTONUP:= RegisterWindowMessage('GWWM_MBUTTONUP');
 GWWM_LBUTTONDOWN:= RegisterWindowMessage('GWWM_LBUTTONDOWN');
 GWWM_LBUTTONUP:= RegisterWindowMessage('GWWM_LBUTTONUP');
 GWWM_RBUTTONDOWN:= RegisterWindowMessage('GWWM_RBUTTONDOWN');
 GWWM_RBUTTONUP:= RegisterWindowMessage('GWWM_RBUTTONUP');
 GWWM_RBUTTONUP:= RegisterWindowMessage('GWWM_MOUSEMOVE');
end.


Лысеющий Самурай   (2007-05-01 15:28:00) [1]


> begin...end
> Ketmar
> Leonid Troyanovsky


Спасибо


Leonid Troyanovsky   (2007-04-29 22:23:00) [2]


> Ketmar ©   (29.04.07 22:17) [6]

> > Думать надо всегда, до дней последних донца.
> я же не садист! а вдруг автору тяжело "всегда"?

Тяжело в ученье - легко в бою.
"Всегда" же звучит упадочнечески.
С утра - это более по-нашему.

--
Regards, LVT.


Ketmar   (2007-04-29 22:17:00) [3]

> Leonid Troyanovsky © (29.04.07 22:12) [5]
> Неверная модальность, IMHO.
> Думать надо всегда, до дней последних донца.

я же не садист! а вдруг автору тяжело "всегда"?


Leonid Troyanovsky   (2007-04-29 22:12:00) [4]


> Ketmar ©   (29.04.07 22:09) [4]

> сообщений. или подумать и переписать код.

Неверная модальность, IMHO.
Думать надо всегда, до дней последних донца.

--
Regards, LVT.


Ketmar   (2007-04-29 22:09:00) [5]

broadcast -- это круто. очень.

к автору есть предложение: почитать о других функциях отсылки сообщений. или подумать и переписать код.


Leonid Troyanovsky   (2007-04-29 21:55:00) [6]


> Лысеющий Самурай   (29.04.07 11:46) [1]

> Я так понимаю сообщения надо передавать как то по другому,
>  не SendMessage(HWND_BROADCAST...

Правильно понимаешь.
Хотя бы, путем SendMessageTimeout.

--
Regards, LVT.


begin...end   (2007-04-29 21:23:00) [7]

> Лысеющий Самурай   (29.04.07 11:42)

> почему прграмма неработает если кликаешь по заголовкам окон

Потому что в этом случае генерируются сообщения вида WM_ NC...BUTTON... (NC -- non-client, неклиентская область окна). Например, WM_NCLBUTTONDOWN.

Ну, а зачем передавать сообщения всем окнам верхнего уровня (HWND_BROADCAST), действительно, непонятно.

P.S. Вы про конструкцию case не слышали? ;-)


Лысеющий Самурай   (2007-04-29 11:46:00) [8]

Я так понимаю сообщения надо передавать как то по другому, не SendMessage(HWND_BROADCAST...


Наверх

Титульная страница Поиск, карта сайта Написать письмо