[Delphi] Globalny hook na LPM

Dla specjalistów Programowanie
#1

Witam,

W jaki sposób mogę założyć globalnego hooka na lewy przycisk myszki w Delphi?

Szukałem i znalazłem coś takiego:

unit Unit1;


interface


uses

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

  Dialogs, ShellApi;


type

  TForm1 = class(TForm)

  function HookPRC(Code: Integer; wParam:WPARAM; lParam: LPARAM): Longint; stdcall;

  procedure FormCreate(Sender: TObject);

  procedure FormClose(Sender: TObject; var Action: TCloseAction);


  private

    { Private declarations }

  public

    { Public declarations }

  end;


var

  Form1: TForm1;

  Hook: HHOOK;

  MessageBuffer:TEventMsg;


implementation


{$R *.dfm}


procedure TForm1.FormCreate(Sender: TObject);

begin

  Hook:=SetWindowsHookEx(WH_JOURNALRECORD, @Form1.HookPRC, hInstance, 0);

end;


function Form1.HookPRC(Code: Integer; wParam:WPARAM; lParam: LPARAM): Longint; stdcall;

var

 MSg: TEventMsg;

 p: TPoint;

begin

 Msg:=PEventMsg(lParam)^;

 if Msg.message=WM_LBUTTONDOWN then

  ShowMessage('lpm')

end;


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  UnHookWindowsHookEx(Hook);

end;


end.

Ale nie działa ;s

Z góry dzięki :slight_smile:

#2

obczaj kod mojego programu, kiedyś działał :smiley:

unit main;


interface


uses

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

  Dialogs, StdCtrls,ShellAPI;


type

  TForm1 = class(TForm)

    procedure FormCreate(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;


var

  Form1: TForm1;

  Hook:Integer;

  MessageBuffer:TEventMsg;


implementation


{$R *.dfm}


function Play(Code: integer; wParam, lParam: Longint): Longint; stdcall;

begin

case Code of

HC_ACTION: begin

MessageBuffer := PEventMsg(lParam)^;

if MessageBuffer.message = WM_LBUTTONDOWN then

begin

//showmessage('Współrzędne myszy: ' + IntToStr(MessageBuffer.ParamL) + ' i ' + IntToStr(MessageBuffer.ParamH));


if (inttostr(MessageBuffer.ParamL) >= '1020') and (inttostr(MessageBuffer.ParamH) >= '599') then

begin

  ShellExecute(0, 'open','showdesktop.scf',NIL,'.',SW_SHOW);

end;

Result := 0;

end;

end;


else begin

Result := CallNextHookEx(Hook, Code, wParam, lParam);

end;

end;

end;


procedure TForm1.FormCreate(Sender: TObject);

begin

Hook:=SetWindowsHookEx(wh_journalrecord, play, HInstance, 0);

end;


end.

Program emuluje pokaż pulpit w prawym dolnym rogu ekranu.

#3

Teraz coś wyszło, a da się uzyskać taki efekt ze ta czynność będzie dodatkową? tzn np kliknę sobie w notatniku w 2 lini to przeniesie tam kursor i dopiero po tym wykona dodatkową czynność która będzie właśnie przypisana w tym hooku a nie jak teraz zastępuje mi lpm/ppm?

Teraz mam coś takiego:

unit Unit1;


interface


uses

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

  Dialogs, ShellApi;


type

  TForm1 = class(TForm)

    procedure FormCreate(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);


  private

    { Private declarations }

  public

    { Public declarations }

  end;


var

  Form1: TForm1;

  Hook:HHOOK;


implementation


{$R *.dfm}


function HookPRC(Code: Integer; wParam:WPARAM; lParam: LPARAM): Longint; stdcall;

var

Msg: TEventMsg;

begin

Msg:=PEventMsg(lParam)^;

if Msg.message = WM_RBUTTONDOWN then

  ShowMessage('lpm');

end;


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  UnHookWindowsHookEx(Hook);

end;


procedure TForm1.FormCreate(Sender: TObject);

begin

    Hook:=SetWindowsHookEx(WH_JOURNALRECORD, HookPRC, hInstance, 0);

end;


end.
#4

Eee nie powinno Ci go zastępować (chyba :wink: ). Po testuj dokładniej. Jeżeli jesteś pewny że zastępuje to wyślij komunikat systemowy o kliknięciu o tych samych współrzędnych co odebrałeś właśnie komunikat :slight_smile:

#5

Ogólnie to teraz mi się wszystko wiesza, dostaje serie komunikatów, niekiedy w ogóle go nie dostane, nie raz cały system zawiśnie.

Dodam ze pracuje na Win7 i Delphi 2010.