VPF::отловить нажатие lmb - Форум программистов

Guest

Дата 23.9.2005, 17:32 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

Вопрос простейший, но ответа нигде нет smile

Как отловить нажатие lmb в любой части (возможно за пределами формы)

_hunter

Дата 23.9.2005, 17:50 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 8564
Регистрация: 24.6.2003
Где: Europe::Ukraine:: Kiev

Репутация: 9
Всего: 98

что такое lmb?

--------------------

Tempora mutantur, et nos mutamur in illis...

Guest

Дата 23.9.2005, 19:24 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

left mouse button

Voyager

Дата 23.9.2005, 20:56 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 532
Регистрация: 8.2.2005

Репутация: 4
Всего: 18

Поставить глобальный hook smile

FRAGNATIC

Дата 23.9.2005, 20:59 (ссылка)

(нет голосов)

Загрузка ...

..::Свирепый Кодер::..

Профиль
Группа: Участник
Сообщений: 901
Регистрация: 17.10.2004
Где: ICQ

Репутация: нет
Всего: 11

хук
мя достало уже просто этот код выкладывать ) разве так трудно дркб скачать ))))

Код


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; 
End; 

exports Hook; 

{$R *.res} 

begin 
end.

тут тока что поменять это не правую кнопку ловить а левую и всё! и убрать обнуление сообщения (тобишь не было блокировки мышки) а там уже делай что хош ну или блоч и потом делай чё те надо)

использование:

Код


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; 
End; 

procedure TForm1.FormDestroy(Sender: TObject); 
begin 
 Button2.Click; 
end; 

end.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: WinAPI и системное программирование \| Следующая тема »