Пример блокировки правой кнопки мыши -> Форум на Исходниках.Ру

	Наши проекты: Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту

Здравствуйте, Гость ! [3.145.74.54]

Модераторы: jack128, Rouse_, Krid

Пример блокировки правой кнопки мыши , Использование ловушек в Windows

Song

Сообщ. #1 , 01.12.03, 18:28

Unregistered

Блокировка нажатия правой кнопки мыши:

DLL:

library Project2;

Uses Windows,Messages;

Var SysHook:HHook=0;

Function SysMsgProc(Code:Integer; WParam:LongInt; LParam:LongInt):LongInt; stdcall;

Var Msg:TMessage;

Begin

IF Code=HC_ACTION then

Case TMsg(Pointer(LParam)^).Message OF

WM_RBUTTONDOWN,WM_RBUTTONUP,WM_RBUTTONDBLCLK: TMsg(Pointer(LParam)^).Message:=WM_NULL

else Result:=CallNextHookEx(SysHook,Code,WParam,LParam);

End;

end;

procedure Hook(Flag:Boolean); export; stdcall;

Begin

IF Flag then SysHook:=SetWindowsHookEx(WH_GETMESSAGE,@SysMsgProc,HInstance,0) Else

Begin

UnhookWindowsHookEx(SysHook);

SysHook:=0;

End;

exports Hook;

{$R *.res}

begin

end.

Project:

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Menus, StdCtrls;

type

MyProcType = procedure (Flag: Boolean); stdcall;

type

TForm1 = class(TForm)

Button1: TButton;

Button2: TButton;

procedure FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

HDLL:HWND;

implementation

{$R *.dfm}

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

IF Button=mbRight then ShowMessage('Right mouse key pressed');

end;

procedure TForm1.Button1Click(Sender: TObject);

Var Hook: MyProcType;

Begin

@Hook:=nil;

HDLL:=LoadLibrary(PChar('project2.dll'));

IF HDLL>HINSTANCE_ERROR then

Begin

@Hook:=GetProcAddress(HDLL,'Hook');

Hook(True);

End else MessageDlg('Ошибка загрузки DLL.',mtError,[mbIgnore],0);

end;

procedure TForm1.Button2Click(Sender: TObject);

Var Hook: MyProcType;

Begin

@Hook:=nil;

IF HDLL>HINSTANCE_ERROR then

Begin

@Hook:=GetProcAddress(HDLL,'Hook');

Hook(False);

End;

procedure TForm1.FormDestroy(Sender: TObject);

begin

Button2.Click;

end;

end.

Файлы для демонстрации можно взять здесь: http://coolsong.narod.ru/hook.rar
Работает так: при неустановленном хуке правая кнопка работает (о чём свидетельствует нажатие правой кнопки мыши - событие TForm.onMouseDown и сообщение). После установки хука кнопкой "Install", события от мыши перестают обрабатываться (сообщение "Right mouse key pressed" не выдаётся). после снятия хука (кнопка "Remove") - всё возвращается к первоначальному состоянию.

0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)

0 пользователей:

[ Script execution time: 0,0236 ] [ 16 queries used ] [ Generated: 27.04.24, 22:58 GMT ]