Accueil > Codes Sources > Système > Hook de Souris

Hook de Souris

  Télécharger

 

 

Cette source montre comment mettre en application un HOOK de souris capable de suivre le mouvement de la souris dans l'écran et de savoir dans quel coté est le curseur.

MouseHook.dpr

program MouseHook;

uses
Forms,
Main in 'Main.pas' {FHook},
HkUnit in 'HkUnit.pas';

{$R *.res}

begin
Application.Initialize;
Application.CreateForm(TFHook, FHook);
Application.Run;
end.

Haut de Page ^

Main.pas

Unit
Main;

Interface

Uses
Windows, ShellApi, HkUnit, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;

Type
TFHook=Class(TForm)
LBD:TLabel;
LBL:TLabel;
BTE:TButton;
Label1:TLabel;


Procedure FormDestroy(Sender:TObject);
Procedure FormCreate(Sender:TObject);
Procedure BTEClick(Sender:TObject);
Procedure LBLClick(Sender:TObject);

Private
Procedure Sign(MD:TMD);

Protected
Procedure WndProc(Var Message:TMessage);Override;

Public
End;

Var
FHook:TFHook;

Implementation


{$R *.dfm}

Procedure TFHook.FormCreate(Sender:TObject);
Begin
HkUnit.RHKM;
End;

Procedure TFHook.FormDestroy(Sender:TObject);
Begin
HkUnit.UHKM;
End;

Procedure TFHook.Sign(MD:TMD);
Begin
Case MD Of
ML:LBD.Caption:='<';
MT:LBD.Caption:='^';
MR:LBD.Caption:='>';
MB:LBD.Caption:='V';
End;
End;

Procedure TFHook.WndProc(var Message:TMessage);
begin
inherited WndProc(Message);
if Message.Msg=HkUnit.MHM then
begin
Sign(TMD(Message.LParam));
end;
end;

procedure TFHook.BTEClick(Sender: TObject);
begin
Close;
end;

procedure TFHook.LBLClick(Sender: TObject);
begin
ShellExecute(Handle,'open',PChar(LBL.Caption),nil,nil,1);
End;
End.

Haut de Page ^

HkUnit.pas

Unit
HkUnit;

Interface

Uses
Windows;

Type
TMD=(ML=1,MT=2,MR=3,MB=4);

var
MHM:Cardinal;

Procedure RHKM;
Procedure UHKM;

Implementation

Procedure RHKM;External 'MHkDll.DLL';
procedure UHKM;External 'MHkDll.DLL';

Initialization

MHM:=RegisterWindowMessage('MouseHookMessage');
End.

Haut de Page ^

MHKDll.dpr

Library
MHkDll;

Uses
Forms,
Windows,
Messages,
HkUnit In 'HkUnit.pas';

{$J+}
Const
HK:HHook=0;
{$J-}

{$R *.res}

Function HkPrc(nCode:Integer;MsgID:WParam;Data:LParam):LResult;Stdcall;
Var
PT:TPoint;
NTF:Boolean;
MD:TMD;
Begin
PT:=PMouseHookStruct(Data)^.pt;
NTF:=False;
If (PT.X=0) Then
Begin
Windows.SetCursorPos(-2+Screen.Width,PT.Y);
NTF:=True;
MD:=MR;
End;
If(PT.X=-1+Screen.Width)Then
Begin
Windows.SetCursorPos(1,PT.Y);
NTF:=True;
MD:=ML;
End;
If(PT.Y=0)Then
Begin
Windows.SetCursorPos(PT.X,-2+Screen.Height);
NTF:=True;
MD:=MB;
End;
If (PT.Y=-1+Screen.Height)Then
Begin
Windows.SetCursorPos(PT.X,1);
NTF:=True;
MD:=MT;
End;
If NTF Then
Begin
PostMessage(FindWindow('TFHook',Nil),MHM,MsgID,Integer(MD));
End;
Result:=CallNextHookEx(Hk,nCode,MsgID,Data);
End;

Procedure RHKM;Stdcall;
Begin
If Hk=0 Then Hk:=SetWindowsHookEx(WH_MOUSE,@HkPrc,HInstance,0);
End;

Procedure UHKM;Stdcall;
Begin
UnhookWindowsHookEx(Hk);
Hk:=0;
End;

Exports
RHKM,UHKM;

Begin
End.

Haut de Page ^