Форум программистов [Powered by Invision Power Board]

Код

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    FHookStarted : Boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
 var
   JHook   : THandle;

 function JournalProc(Code, wParam: Integer; var EventStrut: TEventMsg): Integer; stdcall;
 var
   Char1: PChar;
   r : TRect;
   p1, p2 : TPoint;

 begin
   Result := CallNextHookEx(JHook, Code, wParam, Longint(@EventStrut));
   if Code < 0 then Exit;

   if Code = HC_SYSMODALON then Exit;
   if Code = HC_ACTION
   then
     if (EventStrut.message = WM_MOUSEMOVE)
     then
       begin
         R := Form1.ClientRect;
         p1 := Form1.ClientToScreen(r.TopLeft);
         p2 := Form1.ClientToScreen(r.BottomRight);
         r.TopLeft     := p1;
         r.BottomRight := p2;
         p1.X := EventStrut.paramL;
         p1.Y := EventStrut.paramH;

         if not PtInRect(r, p1)
         then
           Begin
             // здесь проверяем погашен ли хинт и если нет, то гасим
             // можно заоодно и хук здесь снять, чтоб не обрабатывать неклиентские
             //перемещения мыши
           end;
       end;
 end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  if FHookStarted then
   begin
     ShowMessage('Mouse is already being Journaled, can not restart');
     Exit;
   end;

   JHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, hInstance, 0);

   if JHook > 0 then
   begin
     FHookStarted := True;
   end
   else
     ShowMessage('No Journal Hook availible');
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   FHookStarted := False;
   UnhookWindowsHookEx(JHook);
   JHook := 0;
end;

end.